指定屏幕区域截图

演示效果
 
添加控件:Form1,Form2,Button1,Image1
说明:关键函数GetPic(Source:TRect)

代码文件:

 
   


unit Unit1;



interface



uses

  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;



implementation



uses 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;



interface



uses

  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;



implementation



uses 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

  end

end


 
   


object 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 = 13

end