指定屏幕区域截图

演示效果
 
添加控件: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