利用Delphi的Tbitmap控件抓取屏幕图象

　相信绝大部分电脑爱好者都使用过不同种类的抓图软件抓取屏幕图形。在本文中，作者要向大家介绍的是利用Delphi的TBitmap控件进行屏幕上任意窗口图形的抓取。同时文章中还有如何利用Delphi的扩展消息处理功能为Delphi的窗口添加热键和在任务栏上添加图标的技巧。

　　程序的主要思路是：当按下为窗口建立的热键后，首先获得光标所在的窗口的矩形区域，然后建立一个TBitmap对象，将矩形区域复制到TBitmap对象中；最后利用TBitmap的图象保存Method将复制到TBitmap中的位图保存到磁盘中。

程序1是完整的源代码清单：

在运行程序前，首先要执行以下的步骤：

在Form1中加入一个TsavePictureDialog控件，将其Name设置为SavePic。

改变Form1的如下属性:
BorderStyle 改变为 bsNone；
FormStyle 改变为 fsStayOnTop；
Visable 改变为 False。

　　同时在Project1中的Application.Run语句前加入： Application.ShowMainForm := False；为了直观显示，还可以将Form1的Cursor属性设置为crHandPoint。

unit Unit1; 　

interface

uses
　Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
　StdCtrls, ExtCtrls, Menus, ExtDlgs, ClipBrd, ShellApi;

const
　WM_ICONMESSAGE=WM_USER+100;

type
　TForm1 = class(TForm)
　SavePic: TSavePictureDialog;
　procedure FormCreate(Sender: TObject);
　procedure FormClose(Sender: TObject; var Action: TCloseAction);
　procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
　Private
　　//热键消息处理函数
　　procedure WMHOTKEY(var Message:TMessage);message WM_HOTKEY;
　　//任务栏消息处理函数
　　procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;
　public
　　procedure CaptureControl;
end;

var
　Form1: TForm1;
　tmpBitmap:TBitmap;
　iBitmapValide:Boolean;

implementation

{$R *.DFM}

procedure TForm1.CaptureControl;
var
　iTempWnd, iMeHwnd, iDC:LongWord;
　tyRect :TRect;
　tpRect : TPoint;
　iWidth, iHeight:integer;
begin
　//获得光标位置
　GetCursorPos(tpRect);
　//获得光标所在位置的窗口句柄
　iMeHwnd:=WindowFromPoint(tpRect);
　//获得窗口的矩形区域
　etWindowRect(iMeHwnd, tyRect);
　//获得桌面窗口的句柄
　iTempWnd:=GetDesktopWindow;
　iDC:=GetDC(iTempWnd);
　iWidth:=tyRect.Right-tyRect.Left;
　iHeight:=tyRect.Bottom-tyRect.Top;
　//建立位图
　tmpBitmap:=TBitmap.Create;
　iBitmapValide:=True;
　tmpBitmap.Width := iWidth;
　tmpBitmap.Height := iHeight;
　//复制窗口矩形区域到位图中
　Bitblt(tmpBitmap.Canvas.Handle, 0, 0, iWidth, iHeight, iDC, tyRect.Left, tyRect.Top, SRCCOPY);
　ReleaseDC(iTempWnd, iDC);
　Form1.Visible := True;
　//使Form1覆盖光标所在的窗口矩形
　Form1.Left := tyRect.Left;
　Form1.Top := tyRect.Top;
　Form1.Width := iWidth;
　Form1.Height := iHeight;
　tyRect.Left:=0;
　tyRect.Right := iWidth;
　tyRect.Top:=0;
　tyRect.Bottom:=iHeight;
　//将位图绘制到Form1的Canvas中
　Form1.Canvas.Draw(0, 0, tmpBitmap);
　//围绕Form1画出3个相素的红色边框
　Frame3D(Form1.Canvas, tyRect, clRed, clRed, 3);
end;

//响应热键，进行抓图
procedure TForm1.WMHOTKEY(var Message:TMessage);
begin
　if iBitmapValide then
　begin
　　tmpBitmap.FreeImage;
　　tmpBitmap.Free;
　　iBitmapValide:=False;
　end;
　CaptureControl;
end;

procedure TForm1.WMBarIcon (var Message:TMessage);
begin
　if ((Message.LParam = WM_RBUTTONDOWN)or (Message.LParam = WM_LBUTTONDOWN)) 　then
　//在任务栏图标上按下鼠标键退出
　　close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
　lpData:PNotifyIconData;
begin
　//注册热键为Ctrl+Shift+A
　RegisterHotKey(Form1.handle, 0, MOD_SHIFT OR MOD_CONTROL, 65);
　//在任务栏上建立图标
　lpData := new(PNotifyIconDataA);
　lpData.cbSize := 88;
　lpData.Wnd := Form1.Handle;
　lpData.hIcon := Form1.Icon.Handle;
　lpData.uCallbackMessage := WM_ICONMESSAGE;
　lpData.uID :=0;
　lpData.szTip := '屏幕捕捉';
　lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
　Shell_NotifyIcon(NIM_ADD, lpData);
　dispose(lpData);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
　lpData:PNotifyIconData;
begin
　//退出时删除任务栏图标
　lpData := new(PNotifyIconDataA);
　lpData.cbSize := 88;
　lpData.Wnd := Form1.Handle;
　lpData.hIcon := Form1.Icon.Handle;
　lpData.uCallbackMessage := WM_ICONMESSAGE;
　lpData.uID :=0;
　lpData.szTip := '屏幕捕捉';
　lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
　Shell_NotifyIcon(NIM_DELETE, lpData);
　dispose(lpData);
　//退出时注销窗口热键
　UnRegisterHotKey(Form1.Handle, 0);
　if iBitmapValide then
　begin
　　tmpBitmap.FreeImage;
　　tmpBitmap.Free;
　　iBitmapValide:=False;
　end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
　//按下鼠标左键保存窗口图象
　if (Button=mbLeft)then
　　with SavePic do
　　begin
　　　DefaultExt := 'Bmp';
　　　Execute;
　　　if FileName<>'' then
　　　　tmpBitmap.SaveToFile(FileName);
　　end;
　//保存完图象后删除位图
　tmpBitmap.FreeImage;
　tmpBitmap.Free;
　iBitmapValide:=False;
　Form1.Visible := False;
end;

end.

　　按F9键运行程序，将光标移动到任意窗口上按下热键Ctrl+Shift+A，则光标所在窗口被捕捉下来（同时被捕捉区域被红色边框框住作为标识）。在框内按下鼠标左键就可以保存位图图像。这个程序也可以用来捕捉菜单。

　　同时程序也可以将图象发送到剪贴板中，只要将上面程序中Form1的OnMouseUp事件置换为下面的程序段就可以了（程序2）：
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
　MyFormat : Word;
　AData : THandle;
　APalette : HPALETTE;
begin
　if (Button=mbLeft)then
　//按下鼠标左键将tmpBitmap中的内容发送的剪贴板
　begin
　　tmpBitmap.SaveToClipBoardFormat(MyFormat, AData, APalette);
　　ClipBoard.SetAsHandle(MyFormat, AData);
　end;
　tmpBitmap.FreeImage;
　tmpBitmap.Free;
　iBitmapValide:=False;
　Form1.Visible := False;
end;

以上的程序在Windows95，Delphi4.0下运行通过。