网页截取图片

程序：http://files.cnblogs.com/xe2011/EXE_iWeb2014-4-9-185315.7z

源码：http://files.cnblogs.com/xe2011/Pascal_iWeb2014-4-9-185315.7z

function CaptureScreenRect(ARect: TRect): TBitmap;
var
  ScreenDC: HDC; // 设备描述表的句柄
begin
  result := TBitmap.Create;
  with result, ARect do
  begin
    Width := Right - left;
    Height := Bottom - Top;
    ScreenDC := GetDC(0); // 获取一个窗口的设备描述表的句柄，0参数返回屏幕窗口设备描述表的句柄
    try
      // BOOL BitBlt(hdcDest,nXDest,nYDest,nWidth,nHeight,hdcSrc,nXSrc,nYSrc,dwRop)
      // 把位图从源设备描述表hdcSrc复制到目标设备描述表hdcDest，
      // 光栅操作码dwRop指定了 源图的组合方式
      BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, left, Top, SRCCOPY);
    finally
      ReleaseDC(0, ScreenDC);
    end;
  end;
end;

使用

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  r: TRect;
  bmp, bmp1: TBitmap;
  jpg: TJPEGImage;
  fileName, path: string;
begin
  PlaySound('PolaroidShutter', 0, snd_ASync or snd_Resource);
  sleep(300);
  form2.Show;
  form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
  form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);

  form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
  form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);

  //
  GetWindowRect(form2.Panel1.Handle, r);

  bmp := CaptureScreenRect(r);
  jpg := TJPEGImage.Create;
  jpg.Assign(bmp);

  // path
  // D:AdministratorDesktop  1.jpg
  // ;

  path := ExtractFilePath(Application.ExeName) + '截图';
  if not DirectoryExists(path) then
    CreateDir(path);

  fileName := format('%s%s.jpg', [path, FormatDateTime('yyyymmddHHmmss', now)]);
  jpg.SaveToFile(fileName);

  form2.Hide;

  // bmp.SaveToFile('D:AdministratorDesktop1.bmp');
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, Buttons, ComCtrls, ToolWin, ExtCtrls,
  Inifiles, Menus, ImgList, ShellAPi, MMSystem;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Panel1: TPanel;
    SpeedButton2: TSpeedButton;
    ComboBox1: TComboBox;
    ProgressBar1: TProgressBar;
    Button1: TSpeedButton;
    TrayIcon1: TTrayIcon;
    btn_Back: TSpeedButton;
    btn_Forward: TSpeedButton;
    ImageList1: TImageList;
    Button2: TButton;
    SpeedButton1: TSpeedButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton2Click(Sender: TObject);
    procedure WebBrowser1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure WebBrowser1ProgressChange(ASender: TObject;
      Progress, ProgressMax: Integer);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Label1Click(Sender: TObject);
    procedure TrayIcon1Click(Sender: TObject);
    procedure btn_BackClick(Sender: TObject);
    procedure btn_ForwardClick(Sender: TObject);
    procedure WebBrowser1CommandStateChange(ASender: TObject; Command: Integer;
      Enable: WordBool);
    procedure Button2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    procedure ReadConfig;
    procedure WriteConfig;
    procedure WMMOVE(var Msg: TMessage);
    message WM_MOVE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R sound.res}

uses Jpeg, Unit2;

function CaptureScreenRect(ARect: TRect): TBitmap;
var
  ScreenDC: HDC; // 设备描述表的句柄
begin
  result := TBitmap.Create;
  with result, ARect do
  begin
    Width := Right - left;
    Height := Bottom - Top;
    ScreenDC := GetDC(0); // 获取一个窗口的设备描述表的句柄，0参数返回屏幕窗口设备描述表的句柄
    try
      // BOOL BitBlt(hdcDest,nXDest,nYDest,nWidth,nHeight,hdcSrc,nXSrc,nYSrc,dwRop)
      // 把位图从源设备描述表hdcSrc复制到目标设备描述表hdcDest，
      // 光栅操作码dwRop指定了 源图的组合方式
      BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, left, Top, SRCCOPY);
    finally
      ReleaseDC(0, ScreenDC);
    end;
  end;
end;

var
  iniPath: string; // ini路径
  IniFile: TInifile;
  fName, IniAbsFileName: string; // ini的文件名
  // WriteString

procedure ComboBoxToINI(const AINIFile, ASection: string; ComboBox: TComboBox);
var
  INI: TInifile;
  I: Integer;
begin
  INI := TInifile.Create(AINIFile);
  try
    INI.EraseSection(ASection);
    INI.WriteInteger(ASection, 'Count', ComboBox.Items.Count);
    for I := 0 to ComboBox.Items.Count - 1 do
    begin
      INI.WriteString(ASection, 'Item' + IntToStr(I), ComboBox.Items[I]);
    end;
  finally
    INI.Free;
  end;
end;

// ReadString

procedure INIToComboBox(const AINIFile, ASection: string; ComboBox: TComboBox);
var
  INI: TInifile;
  I, Count: Integer;
begin
  INI := TInifile.Create(AINIFile);
  try
    Count := INI.ReadInteger(ASection, 'Count', 0);
    for I := 0 to Count - 1 do
    begin
      ComboBox.Items.Add(INI.ReadString(ASection, 'Item' + IntToStr(I), '0'));
    end;
  finally
    INI.Free;
  end;
end;

procedure TForm1.ReadConfig;
begin
  IniFile := TInifile.Create(IniAbsFileName);

  INIToComboBox(IniAbsFileName, '网址', ComboBox1);
  ComboBox1.ItemIndex := IniFile.ReadInteger('网址', '最后选中', 0);

  left := IniFile.ReadInteger('窗体', 'Left', left);
  Top := IniFile.ReadInteger('窗体', 'Top', Top);
  Width := IniFile.ReadInteger('窗体', 'Width', Width);
  Height := IniFile.ReadInteger('窗体', 'Height', Height);

end;

procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;
  Command: Integer; Enable: WordBool);
begin
  // case Command of
  // CSC_NAVIGATEBACK:
  // btn_Back.Enabled := Enable; // “后退”按钮
  // CSC_NAVIGATEFORWARD:
  // btn_Forward.Enabled := Enable; // “前进”按钮
  // // CSC_UPDATECOMMANDS: ToolButton_Stop.Enabled := TWebBrowser(ASender).Busy;  //“停止”按钮
  // end;
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  ComboBox1.Text := WebBrowser1.LocationURL;

end;

procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Caption := WebBrowser1.LocationName;
end;

procedure TForm1.WebBrowser1ProgressChange(ASender: TObject;
  Progress, ProgressMax: Integer);
begin

  ProgressBar1.Hint := '正在努力加载 ' + WebBrowser1.LocationName;
  ProgressBar1.Max := ProgressMax;
  if Progress = -1 then
    ProgressBar1.Visible := False
  else
  begin
    ProgressBar1.Position := Progress;
    ProgressBar1.Visible := True;
  end;
  if ProgressBar1.Position = ProgressMax then
    ProgressBar1.Visible := False;
end;

procedure TForm1.WriteConfig;
begin
  IniFile := TInifile.Create(IniAbsFileName);
  ComboBoxToINI(IniAbsFileName, '网址', ComboBox1);
  IniFile.WriteInteger('网址', '最后选中', ComboBox1.ItemIndex);

  if Form1.WindowState <> wsMinimized then
  BEGIN
    IniFile.WriteInteger('窗体', 'Left', left);
    IniFile.WriteInteger('窗体', 'Top', Top);
    IniFile.WriteInteger('窗体', 'Width', Width);
    IniFile.WriteInteger('窗体', 'Height', Height);

  END;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate(ComboBox1.Text);
  if ComboBox1.Items.IndexOf(ComboBox1.Text) = -1 then
    ComboBox1.Items.Add(ComboBox1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WebBrowser1.Refresh;
end;

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  WriteConfig;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Width := 800;
  // Height := 600;
  WebBrowser1.Navigate(ComboBox1.Text);
  // ComboBox1.Items.Clear;
  IniAbsFileName := Application.ExeName + '.ini';
  // ComboBox1.Items[0]:='http://127.0.0.1:88';
  ReadConfig;
  Application.HintHidePause := 100000;
end;






procedure TForm1.Label1Click(Sender: TObject);
var
  frm: TForm1;
begin
  frm := Form1.Create(Self);
  frm.Position := poDefaultPosOnly;
  frm.left := frm.left + 10;
  frm.Top := frm.Top + 10;
  frm.Show;

end;

procedure TForm1.N1Click(Sender: TObject);
begin
  form2.Show;
  form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
  form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);

  form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
  form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);

end;

procedure TForm1.N2Click(Sender: TObject);
var
  s: string;
begin
  s := ExtractFilePath(Application.ExeName) + '截图';
  if DirectoryExists(s) then
    ShellExecute(0, nil, 'explorer.exe', PCHar(s), nil, SW_SHOWNORMAL);
end;

function BmpToJpg(bmp: TBitmap): TJPEGImage;
var
  jpg: TJPEGImage;
begin
  bmp := TBitmap.Create;
  jpg := TJPEGImage.Create;
  try
    jpg.Assign(bmp);
    result := jpg;
  finally
    jpg.Free;
  end;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  r: TRect;
  bmp, bmp1: TBitmap;
  jpg: TJPEGImage;
  fileName, path: string;
begin
  PlaySound('PolaroidShutter', 0, snd_ASync or snd_Resource);
  sleep(300);
  form2.Show;
  form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
  form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);

  form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
  form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);

  //
  GetWindowRect(form2.Panel1.Handle, r);

  bmp := CaptureScreenRect(r);
  jpg := TJPEGImage.Create;
  jpg.Assign(bmp);

  // path
  // D:AdministratorDesktop  1.jpg
  // ;

  path := ExtractFilePath(Application.ExeName) + '截图';
  if not DirectoryExists(path) then
    CreateDir(path);

  fileName := format('%s%s.jpg', [path, FormatDateTime('yyyymmddHHmmss', now)]);
  jpg.SaveToFile(fileName);

  form2.Hide;

  // bmp.SaveToFile('D:AdministratorDesktop1.bmp');
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  ComboBox1.DeleteSelected;
  ComboBox1.ItemIndex := 0;
end;

procedure TForm1.btn_BackClick(Sender: TObject);
begin
  try
    WebBrowser1.GoBack;
  except

  end;
end;

procedure TForm1.btn_ForwardClick(Sender: TObject);
begin
  try
    WebBrowser1.GoForward;
  except

  end;

end;


procedure TForm1.FormResize(Sender: TObject);
begin
//  IniFile := TInifile.Create(Application.ExeName + '.ini');
//  IniFile.WriteInteger('窗体2', 'Left1', form2.Left - form1.Left);
//  IniFile.WriteInteger('窗体2', 'Top1', form2.Top - form1.Top);





end;

procedure TForm1.WMMOVE(var Msg: TMessage);
begin
  inherited;
  try
    form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
    form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);

    form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
    form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);
  except

  end;
end;

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
  Visible := not Visible;
end;

end.