演示效果
添加控件:Form1,Form2,Button1,Image1 说明:关键函数GetPic(Source:TRect) 代码文件:
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, jpeg;type TForm1 = class(TForm) Image1: TImage; Button1: TButton; procedure GetPic(Source:Trect); procedure Button1Click(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1;implementationuses Unit2;{$R *.dfm}procedure Tform1.GetPic(Source:Trect);var Dest:TRect; {粘贴到Image1上的位置} ScreenCanvas:TCanvas; {屏幕的画布}begin Dest.Left:=0; Dest.Top:=0; Dest.Right:=Image1.Width; Dest.Bottom:=Image1.Height; ScreenCanvas:=tcanvas.Create; try ScreenCanvas.Handle:=GetDC(0); {关键句} Image1.Canvas.CopyRect(Dest,ScreenCanvas,Source); finally ScreenCanvas.Free; {TCanvas类要释放，防止内存泄露} end;end;procedure TForm1.Button1Click(Sender: TObject);var Rect:TRect;begin Rect.Left:=Form2.Left; Rect.Top:=Form2.Top; Rect.Right:=Form2.Left + Form2.Width; Rect.Bottom:=Form2.Top + Form2.Height; {调整Image1的大小使之与所截区域相等，使图像不会变形} Image1.Width:=Rect.Right - Rect.Left; Image1.Height:=Rect.Bottom - Rect.Top; GetPic(Rect);end;procedure TForm1.FormShow(Sender: TObject);begin Button1.Caption:='截图'; Form2.Width:=50; Form2.Height:=50; Form2.Color:=clRed; Form2.AlphaBlend:=True; Form2.AlphaBlendValue:=100; Form2.FormStyle:=fsStayOnTop; Form2.Show;end;end.unit Unit2;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;type TForm2 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end;var Form2: TForm2; f: Boolean; x1,y1: Integer;implementationuses Unit1;{$R *.dfm}{Unit2就是演示中的红色方块，用来确定截取的区域，加上了拖动}procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin x1 := X; y1 := y; f := True;end;procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin if not f then Exit; Left := Left + X - x1; Top := Top + Y - y1;end;procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin f := False; Form1.Button1.Click;end;end.窗体文件:object Form1: TForm1 Left = 242 Top = 145 Width = 258 Height = 114 AlphaBlendValue = 100 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object Image1: TImage Left = 8 Top = 8 Width = 105 Height = 57 end object Button1: TButton Left = 136 Top = 32 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click endendobject Form2: TForm2 Left = 378 Top = 163 BorderStyle = bsNone Caption = 'Form2' ClientHeight = 44 ClientWidth = 108 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnMouseDown = FormMouseDown OnMouseMove = FormMouseMove OnMouseUp = FormMouseUp PixelsPerInch = 96 TextHeight = 13end