unit1.pas

罗小平<<delphi精要>>一书源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    BitBtn1: TButton;
    Panel1: TPanel;
    Button1: TButton;
    SpeedButton1: TSpeedButton;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Timer1: TTimer;
    Edit1: TEdit;
    Memo1: TMemo;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Canvs: TCanvas;
    procedure SaveToFile;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SaveToFile;
var
  sourceRect, destRect: TRect;
begin
  with Canvs do
  begin
    destRect := Rect(0, 0, ClipRect.Right - ClipRect.Left, ClipRect.Bottom - ClipRect.Top);
    sourceRect := destRect;
    Image1.Canvas.CopyRect(destRect, Canvs, sourceRect);
    Image1.Picture.SaveToFile('F:\aa.bmp');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Canvs := TCanvas.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Canvs.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  CurrPoint: TPoint;
  FindHandle: HWND;
  H: HDC;
  FindRect: TRect;
begin
  CurrPoint := ScreenToClient(Mouse.CursorPos);
  FindHandle := ChildWindowFromPoint(Handle, CurrPoint);
  if FindHandle <> 0 then
  begin
    Windows.GetClientRect(FindHandle, FindRect);
    Canvs.Lock;
    H := GetDCEx(FindHandle, 0, DCX_CACHE or DCX_CLIPSIBLINGS);
    SetViewportOrgEx(H, FindRect.Left, FindRect.Top, nil);
    Canvs.Handle := H;
    Canvs.DrawFocusRect(Rect(0, 0, FindRect.Right, FindRect.Bottom));    
    Canvs.Unlock;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  SaveToFile;
end;

end.