?? main.pas

?? 從網頁上下載圖片的程序
?? PAS
?? 第 1 頁 / 共 2 頁
字號:
上一頁 12
    edit1.Enabled := True;
    Edit2.Enabled := True;
  end
  else
  begin
    Edit1.Enabled := False;
    Edit2.Enabled := False;
  end;
end;

procedure TMainForm.Edit1Change(Sender: TObject);
begin
  if StrToInt(Edit1.Text) > StrToInt(Edit2.Text) then
  begin
    MessageBox(0, '最小的文件大小不能夠比最大的大', '錯誤', MB_OK +
      MB_ICONSTOP);
    Edit1.Text := '0';
  end;
end;

procedure TMainForm.Edit2Change(Sender: TObject);
begin
  if StrToInt(Edit1.Text) > StrToInt(Edit2.Text) then
  begin
    MessageBox(0, '最小的文件大小不能夠比最大的大', '錯誤', MB_OK +
      MB_ICONSTOP);
    Edit2.Text := IntToStr(StrToInt(Edit1.Text) + 10);
  end;
end;

procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if (key in ['0'..'9'] = false) and (word(key) <> vk_back) and (key <> #13)
    then
  begin
    {---   鍵入內容控制          ---}
    key := #0;
  end;
end;

procedure TMainForm.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if (key in ['0'..'9'] = false) and (word(key) <> vk_back) and (key <> #13)
    then
  begin
    {---   鍵入內容控制          ---}
    key := #0;
  end;
end;

procedure TMainForm.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
    Button4.Click;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  I: Integer;
begin
  for i := 0 to CheckListBox1.Count - 1 do
  begin
    if CheckListBox1.Checked[i] = True then
      if CheckListBox1.Items.Count <> 0 then
        {---   判斷是否圖片的數目為零  ---}
      begin
        if UBBLabel.Checked then
          Memo1.Lines.Add('[IMG]' + CheckListBox1.Items.Strings[i] + '[/IMG]')
        else
          Memo1.Lines.Add(CheckListBox1.Items.Strings[i])
      end;
  end;
end;

procedure TMainForm.WebBrowser1DownloadBegin(Sender: TObject);
begin
  Button1.Enabled := False;
  StatusBar1.SimpleText := '正在下載該頁面，請耐心等待……';
end;

procedure TMainForm.WebBrowser1DownloadComplete(Sender: TObject);

begin
  Button1.Enabled := True;
  StatusBar1.SimpleText := '下載該頁面完成，請單擊分析取得頁面的圖片';
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  WebBrowser1 := nil;
end;

procedure TMainForm.Button4Click(Sender: TObject);
var
  i, j, AddressNum: integer;
  Addressreg: TRegIniFile;
  CanSave: boolean;
  AddressList: TStringLIst;
begin
  WebBrowser1.Navigate(Combobox1.Text);
  Addressreg := TRegIniFile.Create('');
  CanSave := True;
  with Addressreg do
  try
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      openkey('software\網頁圖片地址拷貝器\', true);
      AddressNum := ReadInteger('GetPicAddress', 'AddressNum', 0);
      for i := 0 to AddressNum do
      begin
        if Trim(Combobox1.text) = ReadString('GetPicAddress', IntToStr(I), '')
          then
          CanSave := False;
        if AddressNum < 1 then
          CanSave := True;
      end;
      if (AddressNum < 10) and CanSave and (Trim(Combobox1.text) <> '') then
      begin
        {---   少于10條記錄允許保存  ---}
        writestring('GetPicAddress', IntToStr(AddressNum + 1),
          Trim(Combobox1.text));
        WriteInteger('GetPicAddress', 'AddressNum', AddressNum + 1);
        free;
      end;
      if (AddressNum >= 10) and CanSave and (Trim(Combobox1.text) <> '') then
      begin
        {---   多于10條記錄刪除最后的一個  ---}
        AddressList := TstringList.Create;
        for j := 1 to 10 do
          AddressList.Add(ReadString('GetPicAddress', IntToStr(j), ''));
        {---   取得當前注冊表中所有的鍵值  ---}
        for j := 0 to 8 do
          AddressList.Strings[j] := AddressList.Strings[j + 1];
        AddressList.Strings[9] := Trim(Combobox1.text);
        for j := 1 to 10 do
        begin
          writestring('GetPicAddress', IntToStr(j), AddressList.Strings[j - 1]);
          WriteInteger('GetPicAddress', 'AddressNum', j);
        end;
        free;
      end;
    end;
  except
    begin
      MessageBox(0, '寫入注冊表出現異常錯誤！放棄保存', '嚴重錯誤', MB_OK +
        MB_ICONSTOP);
      free;
    end;
  end;
  combobox1.OnDropDown(self);
end;

procedure TMainForm.PageControl1Change(Sender: TObject);
begin
  if PageControl1.TabIndex = 2 then
  begin
   MessageBox(0, '    網頁圖片轉貼器' + #13#10#13#10 + 
     '    我是一個懶人，還有一點時間就離開學校了，于是經常上網看一些圖片，發'
     + #13#10 + 
     '現有的時候從一個論壇轉到另外一個論壇很麻煩，總是要手動的找到該圖片的地' 
     + #13#10 + 
     '址，然后一個一個鏈接貼過去。因此萌發念頭，寫了這個小程序。代碼很簡單，' 
     + #13#10 + '功能我個人認為還是很實用的。' + #13#10#13#10 + 
     '    把一個網站的地址粘貼到地址欄中，然后分析出來想要的圖片文件，得到想' 
     + #13#10 + '要的地址。然后就可以取得該圖片的地址。' + #13#10#13#10 + 
     '    該程序對于喜歡轉貼大量圖片的人來說應該是一個比較好的助手。剛寫出來，' 
     + #13#10 + 
     '很多的地方很不完善，希望大家多提寶貴意見條件有限，只是在windows2000 ＋ ' 
     + #13#10 + 'IE5 下通過，有問題可以給我發信聯系。歡迎提出，多謝！' + 
     #13#10#13#10 + '    wzhiwei99@163.com' + #13#10#13#10 + 
     '    版本修正發布一般在 http://www.yaguo.com/~cm991' + #13#10#13#10 + 
     '    也可以在smth.org找到我，cm991@smth.org' + #13#10#13#10 + 
     '    版本歷史：ver 0.0.0.1 2003.6.23' + #13#10 + 
     '     1 、初步設想開發，實現基本功能' + #13#10#13#10#13#10 + 
     '    ver 0.0.0.2 2003.6.24' + #13#10 + '    1 、實現了圖片的批量保存功能' 
     + #13#10 + '    2 、圖片地址添加有重復修正' + #13#10 + 
     '    3 、已用地址顯示重復問題和保存問題' + #13#10 + 
     '    4 、對于iFrame、Frame 的網頁支持取圖', '網頁圖片轉貼器……', MB_OK + 
     MB_ICONINFORMATION);
     
    PageControl1.TabIndex := 0;
  end;
end;

procedure TMainForm.ComboBox1DropDown(Sender: TObject);
var
  Addressreg: TRegIniFile;
  I: integer;
begin
  combobox1.Clear;
  Addressreg := TRegIniFile.Create('');
  with Addressreg do
  begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if keyexists('software\網頁圖片地址拷貝器\GetPicAddress') then
      begin
        openkey('software\網頁圖片地址拷貝器', false);
        for i := 1 to ReadInteger('GetPicAddress', 'AddressNum', 1) do
        begin
          combobox1.Items.Add(ReadString('GetPicAddress', IntToStr(0 + I), ''));
        end;
        closekey;
      end;
    except
      begin
        MessageBox(0, '讀取注冊表出現異常錯誤，使用系統默認連接', '嚴重錯誤',
          MB_OK + MB_ICONSTOP);
      end;
      free;
    end;
  end;

end;

procedure TMainForm.Panel6Click(Sender: TObject);
begin
  //showmessage(WebBrowser1.LocationURL);
end;

procedure TMainForm.Button5Click(Sender: TObject);
var
  I, j: Integer;
  dir: widestring;
  tmp: TStringList;
  SaveFileName: string;
begin
  tmp := TStringList.Create;
  tmp.Delimiter := '/';
  {---   為取得頁面的最后一個路徑名的文件名稱  ---}
  if SelectDir.ShowModal = mrOk then
    {---   調出路徑選擇對話框 uses Qdialogs  ---}
  begin
    dir := SelectDir.Label3.Caption;
    for i := 0 to CheckListBox1.Count - 1 do
    begin
      if CheckListBox1.Checked[i] = True then
      begin
        tmp.DelimitedText := CheckListBox1.Items.Strings[i];
        for j := 0 to tmp.Count - 1 do
          SaveFileName := tmp.Strings[j];
        {---   得到文件名            ---}
        StatusBar1.SimpleText := '正在保存所選中的文件，請稍候……';
        if not DownloadFile(CheckListBox1.Items.Strings[i], dir + '\' +
          SaveFileName) then
          MessageBox(0, Pchar('下載' + CheckListBox1.Items.Strings[i] +
            '不成功'),
            '網頁圖片轉貼器……', MB_OK + MB_ICONSTOP);

      end;
    end;
  end;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
  I, j: Integer;
  tmp: TStringList;
begin

  {---   Uses Clipbrd          ---}
  tmp := TStringList.Create;
  tmp.Delimiter := '/';
  ClipBoard.Open;
  for i := 0 to combobox1.Items.Count - 1 do
  begin
    if combobox1.Items.Strings[i] = Clipboard.AsText then
    begin
      ClipBoard.Close;
      exit;
    end;
  end;
  try
    if ClipBoard.HasFormat(CF_TEXT) and CheckBox2.Checked then
    begin
      tmp.DelimitedText := Clipboard.AsText;
      if tmp.Strings[0] = 'http:' then
        {---   如果監視到剪貼板的內容為網址的話。那么就下載該頁面  ---}
      begin
        Combobox1.Text := Clipboard.AsText;
        Button4.Click;
      end;
    end;
  finally
    ClipBoard.Close;
  end;

end;

procedure TMainForm.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
  cancel := true;
  {---   取消新的窗口打開      ---}
end;

end.
上一頁 12
?? 文件大小 242 K
?? 上傳用戶 whyzhao
?? 所屬分類 Delphi控件源碼
??? 相關標簽

#頁 #程序
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? main.pas

?? 快捷鍵說明
