[Capture Windows or Controls]窗体或控件抓图的Action 事件 procedure TMainForm.cptWindowsExecute(Sender: TObject); var p:TPoint; Handles:HWnd; begin Inc(CaptureNum,1); Application.Minimize ; Delay(500); FileName:=''''Capture''''+IntTOStr(CaptureNum); FileName:=DefaultDirectory+FileName; with TForm2.Create(Application) do try if ShowModal=mrOK then begin CreateMDIChild(FileName,true); StatusBar.SimpleText := FileName; Delay(500); ABitmap:=TBitmap.Create ; GetCursorPos(P); Handles:=WindowFromPoint(P); ABitmap:=CaptureWindowImage(Handles); 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; Child.Image1.Hint := ''''Height:''''+intToStr(child.Image1.Picture.Height)+''''pixels'''' + '''' Width:''''+intToStr(child.Image1.Picture.Width)+''''pixels''''; ABitmap.Free ; end; finally Free; Application.Restore ; end; end;
4)抓取 ICON 图片 抓取 ICON 图片,即要用到一个新的Form3,参见《Delphi图象截取编程示例(8)》 在Main单元implementation的uses中添加Capture3。 在Main单元添加私有过程CaptureICON : procedure TMainForm.CaptureICON; // [二十] begin with TForm3.Create(Application) do try if ShowModal = mrOK then with fRect do begin if (Right>Left)and(Bottom>Top) then begin Delay(300); ABitmap:=TBitmap.Create ; ABitmap.Assign(CaptureScreenRect(fRect)); Child.Image1.Picture.Bitmap:=ABitmap; 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 ; Form3.Free ; exit; end; end; finally Free; end; end;