Delphi图象截取编程示例(5)

3)抓取窗体或控件图片
   抓取窗体或控件图片，即要用到一个新的Form2，参见《Delphi图象截取编程示例(7)》
   在Main单元implementation的uses中添加Capture2。
  
[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;

[Capture ICON ] ICON 抓图的Action 事件
procedure TMainForm.cptIconExecute(Sender: TObject);
begin
  Application.Minimize ;
  Delay(400);
  Inc(CaptureNum,1);
  FileName:='Capture'+intToStr(CaptureNum);
  FileName:=DefaultDirectory+FileName;
  CreateMDIChild(FileName,true);
  StatusBar.SimpleText := FileName;
  CaptureICON;
  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';
  Application.Restore ;
end;

本文地址：http://com.8s8s.com/it/it4714.htm