mymrr1.pas

实现屏幕截屏,可以任意实现截屏功能

unit Mymrr1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, ClipBrd;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label2: TLabel;
    spdButCopyToClipboard: TSpeedButton;
    spdButExit: TSpeedButton;
    Label1: TLabel;
    
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure spdButExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure spdButCopyToClipboardClick(Sender: TObject);
  private
    { Private declarations }
    DesktopHWnd: HWnd;
    DesktopDC: HDc;
    MyRec,DesktopRect: TRect;
    XSrc,YSrc : integer;
    MouseCaptured  : boolean;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (not MouseCaptured) and (Button = mbLeft)then begin
     label2.caption := 'Down';
     label1.visible := False;
     spdButExit.visible := False;
     spdButCopyToClipboard.visible := False;
     MouseCaptured := True;
     SetCapture(Handle);
     DesktopHWnd := GetDesktopWindow;
     DesktopDC   := GetDC(DesktopHWnd);
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if MouseCaptured then begin
     {label1.caption := IntToStr(x)+','+IntToStr(y);}
     BitBlt(Image1.Canvas.Handle,  0,0,Image1.Width,Image1.Height,
             DesktopDC, X+Form1.Left, Y+Form1.Top, SRCCOPY);
     Image1.Refresh;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if MouseCaptured and (Button = mbLeft) then begin
     label2.caption := 'Up';
     label1.visible := True;
     spdButExit.visible := True;
     spdButCopyToClipboard.visible := True;
     MouseCaptured := False;
     ReleaseCapture;
     ReleaseDC(DesktopHWnd, DesktopDC);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MouseCaptured := False;
  Form1.Visible := False;
  DesktopHWnd := GetDesktopWindow;
  DesktopDC   := GetDC(DesktopHWnd);
  BitBlt(Image1.Canvas.Handle,  0,0,Image1.Width,Image1.Height,
             DesktopDC, Form1.Left+10-(Width-ClientWidth), Form1.Top-4+(Height-ClientHeight), SRCCOPY);
  Image1.Refresh;
  ReleaseDC(DesktopHWnd, DesktopDC);
  Form1.Visible := True;
end;

procedure TForm1.spdButExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if MouseCaptured then begin
     MouseCaptured := False;
     ReleaseCapture;
     ReleaseDC(DesktopHWnd, DesktopDC);
  end;
end;

procedure TForm1.spdButCopyToClipboardClick(Sender: TObject);
begin
  Clipboard.Assign(Image1.Picture);
end;

end.