网页截取图片

 

 

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

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

 

 

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

使用

 1 procedure TForm1.SpeedButton1Click(Sender: TObject);
 2 var
 3   r: TRect;
 4   bmp, bmp1: TBitmap;
 5   jpg: TJPEGImage;
 6   fileName, path: string;
 7 begin
 8   PlaySound('PolaroidShutter', 0, snd_ASync or snd_Resource);
 9   sleep(300);
10   form2.Show;
11   form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
12   form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);
13 
14   form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
15   form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);
16 
17   //
18   GetWindowRect(form2.Panel1.Handle, r);
19 
20   bmp := CaptureScreenRect(r);
21   jpg := TJPEGImage.Create;
22   jpg.Assign(bmp);
23 
24   // path
25   // D:\Administrator\Desktop\  1.jpg
26   // ;
27 
28   path := ExtractFilePath(Application.ExeName) + '截图\';
29   if not DirectoryExists(path) then
30     CreateDir(path);
31 
32   fileName := format('%s%s.jpg', [path, FormatDateTime('yyyymmddHHmmss', now)]);
33   jpg.SaveToFile(fileName);
34 
35   form2.Hide;
36 
37   // bmp.SaveToFile('D:\Administrator\Desktop\1.bmp');
38 end;
USE

 

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls, OleCtrls, SHDocVw, Buttons, ComCtrls, ToolWin, ExtCtrls,
  8   Inifiles, Menus, ImgList, ShellAPi, MMSystem;
  9 
 10 type
 11   TForm1 = class(TForm)
 12     WebBrowser1: TWebBrowser;
 13     Panel1: TPanel;
 14     SpeedButton2: TSpeedButton;
 15     ComboBox1: TComboBox;
 16     ProgressBar1: TProgressBar;
 17     Button1: TSpeedButton;
 18     TrayIcon1: TTrayIcon;
 19     btn_Back: TSpeedButton;
 20     btn_Forward: TSpeedButton;
 21     ImageList1: TImageList;
 22     Button2: TButton;
 23     SpeedButton1: TSpeedButton;
 24     PopupMenu1: TPopupMenu;
 25     N1: TMenuItem;
 26     N2: TMenuItem;
 27     Timer1: TTimer;
 28     procedure Button1Click(Sender: TObject);
 29     procedure FormCreate(Sender: TObject);
 30     procedure FormClose(Sender: TObject; var Action: TCloseAction);
 31     procedure SpeedButton2Click(Sender: TObject);
 32     procedure WebBrowser1NavigateComplete2(ASender: TObject;
 33       const pDisp: IDispatch; var URL: OleVariant);
 34     procedure WebBrowser1ProgressChange(ASender: TObject;
 35       Progress, ProgressMax: Integer);
 36     procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
 37     procedure WebBrowser1DocumentComplete(ASender: TObject;
 38       const pDisp: IDispatch; var URL: OleVariant);
 39     procedure Label1Click(Sender: TObject);
 40     procedure TrayIcon1Click(Sender: TObject);
 41     procedure btn_BackClick(Sender: TObject);
 42     procedure btn_ForwardClick(Sender: TObject);
 43     procedure WebBrowser1CommandStateChange(ASender: TObject; Command: Integer;
 44       Enable: WordBool);
 45     procedure Button2Click(Sender: TObject);
 46     procedure SpeedButton1Click(Sender: TObject);
 47     procedure N1Click(Sender: TObject);
 48     procedure N2Click(Sender: TObject);
 49     procedure FormResize(Sender: TObject);
 50   private
 51     procedure ReadConfig;
 52     procedure WriteConfig;
 53     procedure WMMOVE(var Msg: TMessage);
 54     message WM_MOVE;
 55   public
 56     { Public declarations }
 57   end;
 58 
 59 var
 60   Form1: TForm1;
 61 
 62 implementation
 63 
 64 {$R *.dfm}
 65 {$R sound.res}
 66 
 67 uses Jpeg, Unit2;
 68 
 69 function CaptureScreenRect(ARect: TRect): TBitmap;
 70 var
 71   ScreenDC: HDC; // 设备描述表的句柄
 72 begin
 73   result := TBitmap.Create;
 74   with result, ARect do
 75   begin
 76     Width := Right - left;
 77     Height := Bottom - Top;
 78     ScreenDC := GetDC(0); // 获取一个窗口的设备描述表的句柄，0参数返回屏幕窗口设备描述表的句柄
 79     try
 80       // BOOL BitBlt(hdcDest,nXDest,nYDest,nWidth,nHeight,hdcSrc,nXSrc,nYSrc,dwRop)
 81       // 把位图从源设备描述表hdcSrc复制到目标设备描述表hdcDest，
 82       // 光栅操作码dwRop指定了 源图的组合方式
 83       BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, left, Top, SRCCOPY);
 84     finally
 85       ReleaseDC(0, ScreenDC);
 86     end;
 87   end;
 88 end;
 89 
 90 var
 91   iniPath: string; // ini路径
 92   IniFile: TInifile;
 93   fName, IniAbsFileName: string; // ini的文件名
 94   // WriteString
 95 
 96 procedure ComboBoxToINI(const AINIFile, ASection: string; ComboBox: TComboBox);
 97 var
 98   INI: TInifile;
 99   I: Integer;
100 begin
101   INI := TInifile.Create(AINIFile);
102   try
103     INI.EraseSection(ASection);
104     INI.WriteInteger(ASection, 'Count', ComboBox.Items.Count);
105     for I := 0 to ComboBox.Items.Count - 1 do
106     begin
107       INI.WriteString(ASection, 'Item' + IntToStr(I), ComboBox.Items[I]);
108     end;
109   finally
110     INI.Free;
111   end;
112 end;
113 
114 // ReadString
115 
116 procedure INIToComboBox(const AINIFile, ASection: string; ComboBox: TComboBox);
117 var
118   INI: TInifile;
119   I, Count: Integer;
120 begin
121   INI := TInifile.Create(AINIFile);
122   try
123     Count := INI.ReadInteger(ASection, 'Count', 0);
124     for I := 0 to Count - 1 do
125     begin
126       ComboBox.Items.Add(INI.ReadString(ASection, 'Item' + IntToStr(I), '0'));
127     end;
128   finally
129     INI.Free;
130   end;
131 end;
132 
133 procedure TForm1.ReadConfig;
134 begin
135   IniFile := TInifile.Create(IniAbsFileName);
136 
137   INIToComboBox(IniAbsFileName, '网址', ComboBox1);
138   ComboBox1.ItemIndex := IniFile.ReadInteger('网址', '最后选中', 0);
139 
140   left := IniFile.ReadInteger('窗体', 'Left', left);
141   Top := IniFile.ReadInteger('窗体', 'Top', Top);
142   Width := IniFile.ReadInteger('窗体', 'Width', Width);
143   Height := IniFile.ReadInteger('窗体', 'Height', Height);
144 
145 end;
146 
147 procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;
148   Command: Integer; Enable: WordBool);
149 begin
150   // case Command of
151   // CSC_NAVIGATEBACK:
152   // btn_Back.Enabled := Enable; // “后退”按钮
153   // CSC_NAVIGATEFORWARD:
154   // btn_Forward.Enabled := Enable; // “前进”按钮
155   // // CSC_UPDATECOMMANDS: ToolButton_Stop.Enabled := TWebBrowser(ASender).Busy;  //“停止”按钮
156   // end;
157 end;
158 
159 procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
160   const pDisp: IDispatch; var URL: OleVariant);
161 begin
162   ComboBox1.Text := WebBrowser1.LocationURL;
163 
164 end;
165 
166 procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;
167   const pDisp: IDispatch; var URL: OleVariant);
168 begin
169   Caption := WebBrowser1.LocationName;
170 end;
171 
172 procedure TForm1.WebBrowser1ProgressChange(ASender: TObject;
173   Progress, ProgressMax: Integer);
174 begin
175 
176   ProgressBar1.Hint := '正在努力加载 ' + WebBrowser1.LocationName;
177   ProgressBar1.Max := ProgressMax;
178   if Progress = -1 then
179     ProgressBar1.Visible := False
180   else
181   begin
182     ProgressBar1.Position := Progress;
183     ProgressBar1.Visible := True;
184   end;
185   if ProgressBar1.Position = ProgressMax then
186     ProgressBar1.Visible := False;
187 end;
188 
189 procedure TForm1.WriteConfig;
190 begin
191   IniFile := TInifile.Create(IniAbsFileName);
192   ComboBoxToINI(IniAbsFileName, '网址', ComboBox1);
193   IniFile.WriteInteger('网址', '最后选中', ComboBox1.ItemIndex);
194 
195   if Form1.WindowState <> wsMinimized then
196   BEGIN
197     IniFile.WriteInteger('窗体', 'Left', left);
198     IniFile.WriteInteger('窗体', 'Top', Top);
199     IniFile.WriteInteger('窗体', 'Width', Width);
200     IniFile.WriteInteger('窗体', 'Height', Height);
201 
202   END;
203 end;
204 
205 procedure TForm1.Button1Click(Sender: TObject);
206 begin
207   WebBrowser1.Navigate(ComboBox1.Text);
208   if ComboBox1.Items.IndexOf(ComboBox1.Text) = -1 then
209     ComboBox1.Items.Add(ComboBox1.Text);
210 end;
211 
212 procedure TForm1.Button2Click(Sender: TObject);
213 begin
214   WebBrowser1.Refresh;
215 end;
216 
217 procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
218 begin
219   if Key = #13 then
220     Button1.Click;
221 end;
222 
223 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
224 begin
225   WriteConfig;
226 end;
227 
228 procedure TForm1.FormCreate(Sender: TObject);
229 begin
230   // Width := 800;
231   // Height := 600;
232   WebBrowser1.Navigate(ComboBox1.Text);
233   // ComboBox1.Items.Clear;
234   IniAbsFileName := Application.ExeName + '.ini';
235   // ComboBox1.Items[0]:='http://127.0.0.1:88';
236   ReadConfig;
237   Application.HintHidePause := 100000;
238 end;
239 
240 
241 
242 
243 
244 
245 procedure TForm1.Label1Click(Sender: TObject);
246 var
247   frm: TForm1;
248 begin
249   frm := Form1.Create(Self);
250   frm.Position := poDefaultPosOnly;
251   frm.left := frm.left + 10;
252   frm.Top := frm.Top + 10;
253   frm.Show;
254 
255 end;
256 
257 procedure TForm1.N1Click(Sender: TObject);
258 begin
259   form2.Show;
260   form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
261   form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);
262 
263   form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
264   form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);
265 
266 end;
267 
268 procedure TForm1.N2Click(Sender: TObject);
269 var
270   s: string;
271 begin
272   s := ExtractFilePath(Application.ExeName) + '截图\';
273   if DirectoryExists(s) then
274     ShellExecute(0, nil, 'explorer.exe', PCHar(s), nil, SW_SHOWNORMAL);
275 end;
276 
277 function BmpToJpg(bmp: TBitmap): TJPEGImage;
278 var
279   jpg: TJPEGImage;
280 begin
281   bmp := TBitmap.Create;
282   jpg := TJPEGImage.Create;
283   try
284     jpg.Assign(bmp);
285     result := jpg;
286   finally
287     jpg.Free;
288   end;
289 
290 end;
291 
292 procedure TForm1.SpeedButton1Click(Sender: TObject);
293 var
294   r: TRect;
295   bmp, bmp1: TBitmap;
296   jpg: TJPEGImage;
297   fileName, path: string;
298 begin
299   PlaySound('PolaroidShutter', 0, snd_ASync or snd_Resource);
300   sleep(300);
301   form2.Show;
302   form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
303   form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);
304 
305   form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
306   form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);
307 
308   //
309   GetWindowRect(form2.Panel1.Handle, r);
310 
311   bmp := CaptureScreenRect(r);
312   jpg := TJPEGImage.Create;
313   jpg.Assign(bmp);
314 
315   // path
316   // D:\Administrator\Desktop\  1.jpg
317   // ;
318 
319   path := ExtractFilePath(Application.ExeName) + '截图\';
320   if not DirectoryExists(path) then
321     CreateDir(path);
322 
323   fileName := format('%s%s.jpg', [path, FormatDateTime('yyyymmddHHmmss', now)]);
324   jpg.SaveToFile(fileName);
325 
326   form2.Hide;
327 
328   // bmp.SaveToFile('D:\Administrator\Desktop\1.bmp');
329 end;
330 
331 procedure TForm1.SpeedButton2Click(Sender: TObject);
332 begin
333   ComboBox1.DeleteSelected;
334   ComboBox1.ItemIndex := 0;
335 end;
336 
337 procedure TForm1.btn_BackClick(Sender: TObject);
338 begin
339   try
340     WebBrowser1.GoBack;
341   except
342 
343   end;
344 end;
345 
346 procedure TForm1.btn_ForwardClick(Sender: TObject);
347 begin
348   try
349     WebBrowser1.GoForward;
350   except
351 
352   end;
353 
354 end;
355 
356 
357 procedure TForm1.FormResize(Sender: TObject);
358 begin
359 //  IniFile := TInifile.Create(Application.ExeName + '.ini');
360 //  IniFile.WriteInteger('窗体2', 'Left1', form2.Left - form1.Left);
361 //  IniFile.WriteInteger('窗体2', 'Top1', form2.Top - form1.Top);
362 
363 
364 
365 
366 
367 end;
368 
369 procedure TForm1.WMMOVE(var Msg: TMessage);
370 begin
371   inherited;
372   try
373     form2.Width := IniFile.ReadInteger('窗体2', 'Width', 0);
374     form2.Height := IniFile.ReadInteger('窗体2', 'Height', 0);
375 
376     form2.left := Form1.left + IniFile.ReadInteger('窗体2', 'Left1', 0);
377     form2.Top := Form1.Top + IniFile.ReadInteger('窗体2', 'Top1', 0);
378   except
379 
380   end;
381 end;
382 
383 procedure TForm1.TrayIcon1Click(Sender: TObject);
384 begin
385   Visible := not Visible;
386 end;
387 
388 end.
FullSOURCE

 

posted @ 2014-04-09 18:57  XE2011  阅读(525)  评论(0)  编辑  收藏  举报