利用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
end;
procedure CaptureControl;
var
Form1: TForm1;
tmpBitmap:TBitmap;
iBitmapValide:Boolean;
implementation
{$R *.DFM}
procedure CaptureControl;
var
iTempWnd,iMeHwnd,iDC:LongWord;
tyRect :TRect;
tpRect : TPoint;
iWidth,iHeight:integer;
begin
//获得光标位置
GetCursorPos(tpRect);
//获得光标所在位置的窗口句柄
iMeHwnd:=WindowFromPoint(tpRect);
//获得窗口的矩形区域
GetWindowRect(iMeHwnd,tyRect);
//获得桌面窗口的句柄
iTempWnd:=GetDesktopWindow;
iDC:=GetDC(iTempWnd);
iWidth:=tyRect.Right-tyRect.Left;
iHeight:=tyRect.Bottom-tyRect.Top;
//建立位图
tmpBitmap:=TBitmap.Create;
iBitmapValide:=True;
t
mpBitmap.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: