(六)TMainForm的(抓圖)Action 事件
1)全屏抓圖
[Capture Desktop] Action 事件
PRocedure TMainForm.cptDesktopExecute(Sender: TObject);
begin
inc(CaptureNum,1);
application.Minimize ; //窗體最小化
Delay(500); //最小化後延時，為了全屏抓圖不把自身抓進圖中
FileName:='Capture'+IntToStr(CaptureNum)+'.bmp';
FileName:=DefaultDirectory+FileName;
CreateMDIChild(FileName,true);
StatusBar.SimpleText := FileName;
with ActiveMDIChild as TMDIChild do begin
Image1.Picture.Bitmap := CaptureScreen; //抓圖
HorzScrollBar.Range := Image1.Picture.Width;
VertScrollBar.Range := Image1.Picture.Height;
end;
Child.Image1.Hint := 'Height:'+intToStr(child.Image1.Picture.Height)+'pixels'
+ ' Width:'+intToStr(child.Image1.Picture.Width)+'pixels';
application.Restore ;
end;
2)區域抓圖
抓取區域圖片，即要用到一個新的Form1，參見《Delphi圖像截取編程示例(6)》 .
在Main單元implementation的uses中添加Capture1。
在Main單元添加私有過程CaptureArea :
procedure TMainForm.CaptureArea;
begin
with TForm1.Create(Application) do
try
if ShowModal=mrOK then
with fRect do begin
if (Right>Left)and(Bottom>Top) then begin
Delay(400);
ABitmap:=TBitmap.Create;
ABitmap.Assign(CaptureScreenRect(fRect));
Child.Image1.Picture.Bitmap:=ABitmap;
Child.ClientWidth := Child.Image1.Picture.Width ;
Child.ClientHeight:= Child.Image1.Picture.Height;
Child.HorzScrollBar.Range:=Child.Image1.Picture.Width ;
Child.VertScrollBar.Range:=Child.Image1.Picture.Height;
ABitmap.Free ;
end else begin
MessageDlg('選擇圖片區域錯誤，請重新選擇！',mtInformation,[mbOK],0);
Child.Close ;
Form1.Free ;
exit;
end;
end;
finally
Free;
end;
end;
[Capture Area]區域抓圖的Action 事件
procedure TMainForm.cptAreaExecute(Sender: TObject);
begin
Inc(CaptureNum,1);
Application.Minimize ;
Delay(500);
FileName:='Capture'+IntToStr(CaptureNum)+'.bmp';
FileName:=DefaultDirectory+FileName;
{ Create MDI Child Window }
CreateMDIChild(FileName,true);
StatusBar.SimpleText := FileName;
{ Capture Area of screen }
CaptureArea;
Child.Image1.Hint := 'Height:'+intToStr(child.Image1.Picture.Height)+'pixels'
+ ' Width:'+intToStr(child.Image1.Picture.Width)+'pixels';
application.Restore ;
end;