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

【 tulaoshi.com - 编程语言 】

　　
　　   抓取窗体或控件图片，即要用到一个新的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;

　　
　　抓取 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 (RightLeft)and(BottomTop) 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;