说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

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

HTML文档下载 WORD文档下载 PDF文档下载
利用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;

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下运行通过。

数据分析中的10个注意点,让你更了解用户体验、行为及需求 压不垮就奋行!Dropbox Datastore API给初创NimbusBase带来的启示 史上14大最具创新意义的科技发明 亚马逊应用商店:给应用开发者一个国际舞台 白帽黑客英年早逝:R.I.P,Barnaby Jack 苹果发布支持iTunes Radio服务的iTunes 11.1测试版 诺基亚将发布Treasure Tag配件 让你再也不怕丢东西 从三大互联网巨头布局,看移动时代的商业逻辑 亚马逊应用商店:一个开发者走向世界的机会? 企业级App探索:开发者们的正途在哪里? 如何有效地在海外市场推广产品? 网站转化率统计分析及优化方案 从资深设计师那我们能学到什么? 原作者使用Go开发memcached替代版,现已扎寨谷歌多个项目 像证券一样交易云资源,Zimory一年内收入翻两番并获德国证交所青睐 移动SDK崛起:未来会不会整合成一大坨? 关于 VS2010 异常捕获 在线编程教育平台Treehouse推免费iPad应用 微软发布Windows 8.1企业预览版 功能更强劲 如何管理和优化日益增长的代码复杂度? SDCC 2013大会讲师名单议题更新 8月1日前3.8折优惠截止 IBM Rational首席技术官:DevOps是一门哲学 Mozilla联手黑莓推进Web安全技术,推出开源测试平台Minion 苹果如何培养SOHO一族高效工作 再造Ruby:CryENGINE 3.5游戏引擎特性详解 Eclipse基金会涉足物联网,M2M标准是否已获东风? SDN部署前必须考虑的7个事项 【云先锋 40】初创公司DataStax:专注于Cassandra,三年融资8370万美元 内容创作工具的革新:Facebook前CTO推文字处理应用Quip 微软为Android手机推出Office 仅面向Office 365用户开放使用 编程、创业、开源感悟——SDCC 2013讲师云风专访 请问:为什么编译无错,但生成。EXE文件时却有错,我是在卸载中文VC后安装英文版的 高手们,有一事不明! 郁闷~~ 调用VCDLL的参数传递问题 各位好心的大哥帮帮我,救救我~~~~~~我在线等待~~~~~~~~~ 六七十年代发生的几件很牛B的事情【转载】 求一存储过程写法 select ....union windows xp上oracle 816的数据库服务进程不能启动 image字段的处理? 今天我开始上班了 数据判断加分 关于注册用户问题 请教关于时间类型的问题 如何获取一个字符串中中文字符的个数?100分 如何用api获取cpu的processorId? 如何获取一个字符串中中文字符的个数?100分 神啊,救救我吧! 能把bcb6的程序转换成bcb5的吗? 如何获取服务器时间? 万分紧急,请大哥们帮小弟!!!!!!!!我在线等待高手相救 请教关于连接数据库的问题 如何把当前时间组合成一个字符串? 如何使SOAP客户端的web引用的url变成程序中设置(就是不写死了),又不需要重新编译客户端程序的! 我在运行某些程序的时候,为什么会出现office2000的安装进程,还要叫我放入off2000的安装盘??? 请问Oracle触发器里能执行Grant语句吗?? 关于DBGRID字段显示问题 连接时出现这样的提示,可能的问题在那里? 碰到一个几乎让我晕倒的问题!! 紧急提问:我的小型机死机了,怎么样关闭安全的关闭数据库,在重新启动小型机?在线... access有没有光盘路径的设置? 如何让DBGrid控件显示指定的数据 谁有photoshop7.0的注册码?在线等待,立即给分 如何在vfp中实现将表保存在硬盘上(用命令) 关于水晶报表的问题.很急.... 学unix下的c++编程看什么书好? 问个简单问题,在vb.net中无法新建web应用程序 求救.我做的一个网站,打开时会自动跳出一个别的网站.怎么办啊? 高分请教,在线等待,急 java发布时jdbc driver类找不到? vc中资源编辑器得问题:请教 一个堆栈的问题! 光盘路径的问题 我的编译好的程序,在没有bcb环境中不能运行, 如何响应表单中文本框的回车事件?(急急急!) 请教weblogic的环境变量怎么配置? 安装SP4后,ASP不能用,怎么解决? 在程序一开始出现splash screen的时候载入一些数据(大量的),象是photoshop那种.该怎么做啊? ASP建站 有关View Frustum检测的困惑 面点王大调查,除了深圳还有那个城市有面点王,生意怎么样? it is not really funny to be like that 湖南话“恩过杂任 哦高过另 叫不同咯”(按读音打的,是什么意思呀?) 湖南话发音标准 请教一道sat2数学题首先想问一下,sat2数学都是单选还是多选这道题我算出来两个答案,A和B,假如是单选的话,不知道有一个为什么错了, 要开学了,作业还没做完怎么办?`` 产生时空扭曲需要多大的能量,地球上可以实现吗? 能量扭曲时间吗?能量(质量)可以扭曲空间,而空间和时间本质上是统一的,那么它如何扭曲时间呢?和空间完全相同吗? (地球上)我们在的地方,是不是发生着空间扭曲啊?扭曲程度多大?(地球上)我们在的地方,(每个人都生活在空间扭曲的空间?)是不是发生着空间扭曲啊?扭曲程度多大?q 是不是空间扭曲造 时空扭曲是什么?会在地球上发生吗,会被吸进去吗?我听同学说只要一个地方没有大型的生物纯在,时空扭曲之门就会被打开,会被吸进去不会再出来,是真的还是假的?还是时空扭曲只是在中子星 纳镁合成液是什么?有没有化学名称?纳镁合成液是什么?有没有化学名称? 图形咋写 国家德比主裁抢梅西C罗风头 皇马三后农产品供应有保障 物价未来总体走势温李娜三大转变打造最佳赛季 全年胜率高维特尔提前加冕总冠军 F1历史仅次舒国务院取消有限责任公司注册资本3万元全国65个城市代表在南宁探讨机关党建濒临灭绝的北沙牛有望在浙江宁波保种、媒体称转基因食品是各国大趋势 引力大网传“五台山僧人群殴女游客”视频被证巴武装分子向以色列发射火箭弹 其中一鄱阳湖江豚死亡原因公布:确系被螺旋桨焦作 绿色升级环境开路人民日报海外版读者有奖调查问卷也门撤离行动彰显中国实力中巴两国“你中有我、我中有你”(望海责编:杨子岩邮箱:guojihwb@路网工程项目稳步推进喀纳斯激情戏春雪漳州PX工厂发生爆炸逾21万人次悼南京大屠杀遇难同胞北京今年重点治理交通“栓塞”(聚焦京东城百米长卷展美育
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘