如何使用系统级热键捕捉当前窗口保存为 png 图片

unit Unit1;

interface

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

type
  TForm1 
= class(TForm)
    
procedure FormCreate(Sender: TObject);
    
procedure FormDestroy(Sender: TObject);
  private
    
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
  public
  
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses pngimage; 
//png 支持

var
  HotKeyId: 
array[0..1of Integer; //热键列表

//捕捉当前窗口, 保存为 bmp 或 png
procedure GetPicture(png: Boolean = false);
var
  r: TRect;
  bmp: TBitmap;
begin
  GetWindowRect(GetForegroundWindow, r);
  bmp :
= TBitmap.Create;
  bmp.SetSize(r.Right 
- r.Left, r.Bottom - r.Top);
  BitBlt(bmp.Canvas.Handle, 
00, bmp.Width, bmp.Height, GetDC(0), r.Left, r.Top, SRCCOPY);
  
if png then
    TPngImage(bmp).SaveToFile(
'c:\temp\001.png')
  
else
    bmp.SaveToFile(
'c:\temp\001.bmp');
  bmp.Free;
end;

//注册系统热键 F8、F9
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  
for i := Low(HotKeyId) to High(HotKeyId) do
    HotKeyId[i] :
= GlobalAddAtom(PChar(IntToStr(i)));
  RegisterHotKey(Handle,HotKeyId[
0],0,VK_F8); //F8
  RegisterHotKey(Handle,HotKeyId[
1],0,VK_F9); //F9
end;

//处理系统热键
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  
if Msg.HotKey = HotKeyId[0then GetPicture;       //存 bmp
  
if Msg.HotKey = HotKeyId[1then GetPicture(true); //存 png
end;

//销毁系统热键
procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  
for i := Low(HotKeyId) to High(HotKeyId) do
  
begin
    UnRegisterHotKey(handle,HotKeyId[i]);
    GlobalDeleteAtom(HotKeyId[i]);
  
end;
end;

end.

posted on 2011-06-24 15:23  jxgxy  阅读(285)  评论(0编辑  收藏  举报

导航