利用VB捕捉并保存屏幕图像

合集下载

BMP图像格式详解及VB函数截图保存

BMP图像格式详解及VB函数截图保存

BMP图像格式详解及VB截图保存方法2012-03-06 13:14BMP是一种与硬件设备无关的图像文件格式,使用非常广。

它采用位映射存储格式,除了图像深度可选以外,不采用其他任何压缩,因此,BMP文件所占用的空间很大。

BMP文件的图像深度可选lbit、4bit、8bit及24bit。

BMP文件存储数据时,图像的扫描方式是按从左到右、从下到上的顺序。

由于BMP文件格式是Windows环境中交换与图有关的数据的一种标准,因此在Windows环境中运行的图形图像软件都支持BMP图像格式。

文件结构:典型的BMP图像文件由四部分组成:1:位图文件头数据结构,它包含BMP图像文件的类型、显示内容等信息;2:位图信息数据结构,它包含有BMP图像的宽、高、压缩方法,以及定义颜色等信息;3:调色板,这个部分是可选的,有些位图需要调色板,有些位图,比如真彩色图(24位的BMP)就不需要调色板;4:位图数据,这部分的内容根据BMP位图使用的位数不同而不同,在24位图中直接使用RGB,而其他的小于24位的使用调色板中颜色索引值。

位图的类型:位图一共有两种类型,即:设备相关位图(DDB)和设备无关位图(DIB)。

DDB位图在早期的Windows系统(Windows 3.0以前)中是很普遍的,事实上它也是唯一的。

然而,随着显示器制造技术的进步,以及显示设备的多样化,DDB位图的一些固有的问题开始浮现出来了。

比如,它不能够存储(或者说获取)创建这张图片的原始设备的分辨率,这样,应用程序就不能快速的判断客户机的显示设备是否适合显示这张图片。

为了解决这一难题,微软创建了DIB位图格式。

设备无关位图 (Device-Independent Bitmap)DIB位图包含下列的颜色和尺寸信息:*原始设备(即创建图片的设备)的颜色格式。

*原始设备的分辨率。

*原始设备的调色板*一个位数组,由红、绿、蓝(RGB)三个值代表一个像素。

*一个数组压缩标志,用于表明数据的压缩方案(如果需要的话)。

vb 视频捕捉

vb 视频捕捉

索 引 , 为 一1表 明 未 成 功 连 接 。 值
El e s
行视 频 播 放 。视频 捕 捉控 件 的一 些 主要 方 法 和属性
如 表 1和 表 2所 示 。
C p n P e iw a w d .rve I
Endi f
若 成 功连 接 , 置预 览方 式 设
Ca w d1Rae 设 置 每 秒 捕 捉 帧 数 p n t=1 . 5
Na me 为 FlNa i e me 所 在 的 动 态 链 接 库 名 称 , g ・ r a u
视 频 处 理 分 为 缩 放 、 节 、 结 、 存 。缩 放 ( 调 冻 保 放 大 和 缩 小 ) 功 能 通 过 改 变 S t d o ie方 法 的 两 个 eVie Sz
参 数 ( 度 和 高 度 ) 以任 意 改 变 视 频 图像 的 尺 寸 宽 可
, 1视频 源号赋初值 1 _:
[】卢 选 民 , .分 步 式 智 能 监 控 系 统 视 频 多 画 面 显 示 的 设 2 等 计 与 实 现 .计 算 机 应 用 研 究 .2 0 ( . 0 0, 3) 作者 简介 : 杨 建 平 ( 9 5 。 师 。 要 从 事 自 动 控 制 及 通 信 工 程 1 6 -) 讲 主 等方 面的教学研 究与科研开发 工作。
单 帧捕捉 , 当前 图像送 到剪贴板 把
设 置为覆盖窗 口
频 信 号 , 而 实 现 监 视 各 报 警 点 的 现 场 情 况 。 利 用 从
VB . 60作 为 编 程 语 言 , 通 过 运 用 VB 的 控 件 和 调 用
设置为预览窗 口 设置存储路径
设置捕捉时 间长 度 设置 图像来源
的 功 台 。 W id ws的 AP ( p iain P o r mmig 邑 no I Ap l t rg a c o n

VBA在图像处理与特征提取中的实用技巧

VBA在图像处理与特征提取中的实用技巧

VBA在图像处理与特征提取中的实用技巧在图像处理与特征提取领域,VBA(Visual Basic for Applications)是一种强大的编程语言,可用于自动化处理、操作和分析图像。

VBA具有丰富的功能和灵活性,能够帮助用户快速、高效地完成各种图像处理任务。

一、图像处理技巧1. 图像读取与保存:使用VBA可以轻松地读取和保存各种图像格式,如JPEG、PNG、BMP等。

通过使用合适的图像处理库,如Microsoft Office Image Filter,可以将图像加载到Excel或其他文档中,并在其中进行进一步操作和分析。

2. 图像缩放与裁剪:通过VBA,可以实现图像的缩放和裁剪功能。

通过调整图像的大小和分辨率,可以适应不同的需求。

例如,可以将大尺寸的图像缩小为适合网页显示的尺寸,或者裁剪图像以突出感兴趣的区域。

3. 图像滤波与增强:使用VBA可以应用各种图像滤波和增强算法,如均值滤波、中值滤波、高斯滤波等。

这些算法可以去除噪声、平滑图像、增强边缘等,从而改善图像质量。

4. 图像旋转与翻转:通过VBA编程,可以实现图像的旋转和翻转操作。

这对于需要纠正图像方向或者改变图像视角的任务非常有用。

例如,可以将倾斜的图像旋转为垂直或水平方向,或者将图像水平或垂直翻转。

5. 图像分割与目标提取:通过VBA,可以实现图像的分割与目标提取。

这对于分割图像中的不同目标区域,或者提取感兴趣的目标对象非常有用。

例如,可以使用阈值方法对图像进行分割,或者使用边界检测算法提取目标轮廓。

二、特征提取技巧1. 特征提取算法实现:VBA可以用于实现各种常用的特征提取算法,如灰度共生矩阵(GLCM)、局部二值模式(LBP)、方向梯度直方图(HOG)等。

这些算法可以从图像中提取出不同的特征,用于图像分类、识别等任务。

2. 特征选择与降维:VBA也可以用于特征选择和降维。

通过计算特征的相关性、信息熵等指标,可以选择最具有代表性的特征子集。

自动截屏并保存为图片的VB代码

自动截屏并保存为图片的VB代码

自动定时截屏'每隔一定时间,自动截取桌面图像保存到指定的文件夹中'图片文件名为:P-00001.Bmp、P-00002.Bmp 等'例子需控件:Timer1、Command1、Picture1,都采用默认设置'标有'***** 符号的语句可适当修改,以满足个人的特殊要求Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As RasterOpConstants) As LongPrivate Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As LongDim ctCi As LongPrivate Sub Form_Load()Timer1.Enabled = FalseTimer1.Interval = 1000 '*****每隔1000 毫秒(1秒)保存一次Picture1.AutoRedraw = True: Picture1.ScaleMode = vbPixelsPicture1.Move 0, 0, Screen.Width, Screen.HeightPicture1.Visible = FalseMe.Caption = "自动定时截屏"Command1.Caption = "开始截屏"End SubPrivate Sub Command1_Click()Timer1.Enabled = Not Timer1.EnabledIf Timer1.Enabled Then Command1.Caption = "暂停截屏" Else Command1.Caption = "开始截屏" End SubPrivate Sub Timer1_Timer()Dim nDC As Long, dl As Long, nPath As String, nName As StringnPath = "D:\MyPic" '*****保存的目的文件夹If Dir(nPath, 23) = "" Then MkDir nPathnDC = GetWindowDC(0)'dl 返回非零表示成功,零表示失败dl = BitBlt(Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleWidth, nDC, 0, 0, vbSrcCopy) ctCi = ctCi + 1nName = ctCidl = 5 - Len(nName)If dl > 0 Then nName = String(dl, "0") & nNameSavePicture Picture1.Image, nPath & "\P-" & nName & ".bmp" '***** P- 表示文件前缀End Sub。

VB程序VB代码:摄像头视频图像的监控、截图、录像(改进)

VB程序VB代码:摄像头视频图像的监控、截图、录像(改进)

VB程序VB代码:摄像头视频图像的监控、截图、录像(改进)本程序是“实现USB摄像头视频图像的监控、截图、录像”的改进。

可实现对摄像头视频的监控、截图、录像,可以分别保存为图片文件和视频(压缩)文件。

保存的视频文件可以用媒体播放机(Windows Media Player)、暴风影音等软件进行播放,轻松实现家庭录像制作。

利用电脑配备的 USB 摄像头进行视频控制,要用到两个 API 函数:capCreateCaptureWindow 和 SendMessage。

其中,capCreateCaptureWindow 的作用是创建一个视频窗口,摄像头捕捉到的视频图像在此窗口内显示,函数返回值就是代表此窗口的句柄。

视频窗口创建后,剩下的事情就是用 SendMessage 向该窗口发送各种消息,实现对摄像头的控制。

本程序特点主要有:1.实现对摄像头视频图像的监控、截图,视频录像并保存为磁盘文件。

2.可控制多个视频摄像头。

例如,如果一台电脑配置了两个摄像头,启动本程序两次,单击按钮“源”,在弹出的“视频源”对话框中选择不同的捕获源,两个窗口就能同时显示不同摄像头获得的图像。

如下图所示:3.在“视频源”对话框中,还可以设置视频的亮度、对比度等许多参数:4.录像时,如果采用默认的 AVI 文件格式,得到的视频文件会很大。

单击按钮“压”,在弹出的“视频压缩”对话框中选择压缩方式“MPEG-4”,这样得到的视频文件会比默认方式小 10 倍以上。

5.本程序的视频窗口有自动大小和全屏功能。

在全屏状态时,工具栏会自动隐藏。

将鼠标移动到屏幕顶部,工具栏又会自动显示出来。

遗憾的是,由于水平有限,本程序无法判断是否使用了压缩记录方式,压缩后的文件其扩展名仍然是 AVI。

当然,这并不影响播放,录像完成后也可以手动将扩展名修改为 mpg。

其次,录像状态下改变视频窗口大小,有时会出现莫名其妙的错误。

这个错误时有时无,毫无规律,因此本程序不得不关闭了录像状态下视频窗口自动大小的功能。

VB6.0中存取数据库中图片的方法

VB6.0中存取数据库中图片的方法
③在ADoDc控件的“属性页”中选取“记录源”选项卡,然后
阶№妯^“虹‰k()
0n
Error
从“命令类型”下拉列表中选取“2一adcmdr圳e”选项,接着从“表
或存储过程名称”下拉列表中选取数据表“存取相片”。
④双击工具箱中的口(PichlMBox),则在表单窗体中出现Pic- tu陀控件,将该控件命名为PictuMl,PictIlrel的Datnsour∞属性设
本文链接:/Periodical_dnkfyyy200207026.aspx
0;P啪istSecIld竹in如=Fal能;
Dahs0IIm“^doder’
na曲eId=“相片”
1数据库的创建
数据库采用微软的Acce8s97,首先新建一张表.取名为“存取 相片”,潦加三个字段,分别是:姓名,文本型;编号,文本型;相片, OIE对象。设计好之后存盘命名为Piclure
mdb。 souIce^s sllb
SH代Pictm卅川0de
EⅡdIf
EndWith
End sIlb
3解决的方法 新增一个“通用模块”(方法是选取vB菜单的“工程-+添加模
块”),然后在该模块中输入以下程序代码:
Addpic—chck事件程序利用“载人图片”对话框来选取图象文 件,并且将新的图片写入到数据库中。
以上代码在vB6.0/windows98/w‰NT环境中已调试通
co衄衄Di出og控件,将该控件命名为com脚nDial嘴1。co衄on_
Dialog控件的用途是选取图象文件。 表单窗体中各控件的名称和有关属性如表1所示,控件的其 它属性取默认值或自行设定,表单窗体的菜单也可以根据需要自 行设置。
Pictu托=【mdPicm陀(.FileN蛐e) Adodel.Recm硼5m..FikN唧c

VB中用数据库存取图片的实现

VB中用数据库存取图片的实现

i t hu k n C n s:l g e h\Ch n S z n L ng u k ie
it rg n n F a me t=l g n h Mo h n S z n [ g dC u k ie1 Pcue o ( 个 i rB x 名称为 pcue ) 1 T x o t i r1 , 个 et x t B ( 称 为 ttlpt) 1 C mm n il ( 称 为 c liP t , 名 xfeah , 个 o o Dao 名 i g mdFl a 7个 C r— e h) o n mad utn名 称 分 别 为 c B o s、md aec Ex 、md i t m Pe 、 nB t ( o md rw ec Sv 、md i c Fr 、 d rv t sc c N x 和 c d at , md et m L s)整体界 面如下图所示 :
主 界 面 示 意 图
二 、 程 思路 编
W i md F lPah t c l ie t h

Fie = ”P Fls J l r J G i l PGI t p l BMP t e . Bi ma s . ”

利 用 A cs 创建 一个 数据库命 名为 iae 在 i g 数据 库 中创建 ces m g , mae 个数 据表 i gs r,在 iaet e数据表 中创 建 s 和 pc m e maet e o m gs r o mo ii g 两 n 个 字段 ,其 中 s o r 字段类型 为 自动编号 ,im g 字段类 型为 O E对 n p i ae c L 象。 在程序 中点击 c d rw e 钮打开 C mm n il , m Bos按 o o Dao 选择要插入 的图 g 片 , 中后该 图片的路径 在 t feah中显示 , 选 x i pt tl 点击 保存按 钮后 图片被 保存进 i g. b 同时在 pc r1中显示图片 。 mae md , it e u 保存多个图片后可利用

VBA中图像提取与处理的实用方法

VBA中图像提取与处理的实用方法

VBA中图像提取与处理的实用方法在VBA中,图像处理是一项非常有用的技巧。

通过使用VBA的图像处理功能,可以提取和处理图像,使其更加适合我们的需求。

本文将介绍一些在VBA中实用的图像提取与处理方法。

一、图像提取1. 提取图像文件:在VBA中,可以使用FileSystemObject对象来访问文件系统。

通过FileSystemObject的方法和属性,可以提取图像文件的路径和名称。

例如,可以使用以下代码提取图像文件的路径和名称:```vbaDim fso As ObjectDim file As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Set file = fso.GetFile("C:\path\to\image.jpg")Dim imagePath As StringimagePath = file.PathDim imageName As StringimageName = ```2. 从工作表提取图像:如果图像位于Excel工作簿中的工作表中,可以使用Shapes属性来访问并提取图像。

以下是一个示例代码,演示了如何从工作表中提取图像并保存到指定路径:```vbaSub ExtractImageFromWorksheet()Dim ws As WorksheetDim shp As ShapeSet ws = ThisWorkbook.Sheets("Sheet1")For Each shp In ws.ShapesIf shp.Type = msoPicture Then' 提取并保存图像shp.CopyPictureWith New Chart.ChartArea.Clear.Paste.Export "C:\path\to\image.jpg"End WithEnd IfNext shp```二、图像处理1. 缩放图像:在VBA中,可以使用Shape对象的Width和Height属性来改变图像的大小。

关于VB 与Access 中图片的存取问题

关于VB 与Access 中图片的存取问题

关于VB 与Access 中图片的存取问题作者:钱晓燕来源:《中国信息技术教育》2014年第22期摘要:在数据库应用系统中,经常需要对图片进行处理,包括图片在数据库中的直接存储和只将图片地址存储于数据库中两种存储方式。

本文主要论述了图片的存储方式、读取方式,它们各自的优缺点以及怎样存取才能达到效率最高。

关键词:移植性数据负担 OlE 对象图片地址中图分类号:G718 ; ; ; 文献标识码:A 文章编号:1674-2117(2014)22-00-01在教学中,我们常常会用VB及Access做些小的数据库应用系统,如学籍管理系统、考试系统、图书管理系统等,在这些数据库应用系统中,经常需要对图片进行处理。

图片在数据库中应该如何存取、怎样存取才能达到效率最高,是我们最常碰到又急需解决的问题。

1 图片在数据库中的存储以考试管理系统为例来说,在考试报名界面上必须有考试照片,而这照片必须存入后台数据库中。

图书管理系统新书入库时需将新书封面图片存入数据库等。

一般来说,图片在数据库中的存储有两种方式:直接将图片存储在数据库中和在数据库中存储图片地址。

1.1 直接将图片存储在数据库这种存储方式采用的是数据流技术。

数据库设计时,存储图片的字段数据类型定义为“OLE对象”。

要插入图片直接双击该字段即可。

若要在程序中写入数据库,实现代码如下:SUB ;SFILE()DIM ;STR ;As ADODB.STREAMDIM ;REAS ADODB.RECORDSETDIM ;STR ;AS STRINGSET ;STM = NEW ADODB.STREAMSTM.TYPE= ADTYPEBINARYSTM.OPENSTM.LOADFROMFILE APP.PATH+”\ABC.JPG”SET ;RE= NEW ADODB.RECORDESETRE.OPEN”SELECT * ;FROM ;IMG” ,STM,1,3RE.ADDNEWRE.FIELDS(“PHOTO”)=STM.READRE.UPDATERE.CLOSESTM.CLOSEEND SUB从代码看图片操作与其他字段写入数据库基本一样,只不过使用的是流对象。

用VB6屏幕截图

用VB6屏幕截图

用VB6.0实现,本人vb比较菜,所以最好是完整代码,也希望能附上注释,在这里多谢了~问题补充:借助外部工具比较简单,我想用代码实现,希望高手帮一下,非常感谢!!辛语辛辰,savepicture可以保存图片,不过我想保存时主窗体中的一部分,并且上面可能有控件,不知道还有什么方法吗?最佳答案Dim t As BooleanDim f As BooleanPrivate Sub Form_Load()Pic.Height = 100Pic.Width = 100Pic.AutoRedraw = TrueEnd SubPrivate Sub Pic0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If t = False ThenPic.Left = XPic.Top = YEnd IfIf Button = 1 And f = False Thent = TruePic.Width = X - Pic.LeftPic.Height = Y - Pic.TopPic.PaintPicture Pic0.Picture, 0, 0, , , Pic.Left, Pic.Top, Pic.Width, Pic.Height End IfEnd SubPrivate Sub Pic0_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 1 Then f = TruePic2.Picture = Pic.ImageIf Button = 2 Thent = Falsef = FalsePic.Width = 100Pic.Height = 100End IfEnd Sub注释不用了吧,用SavePicture 语句保存图片说详细点,它截取的是背景vb 屏幕区域截图悬赏分:0 |解决时间:2008-3-8 19:24 |提问者:開始習慣孤單例如我要截下屏幕上728,292,766,305处的图并保存,怎样写代码代码越短越好最佳答案Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As LongPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Const Srccopy = &HCC0020Private Sub Picture1_Click()StretchBlt Picture1.hdc, 0, 0, 766 - 728, 305 - 292, GetDC(0), 728, 292, 766 - 728, 305 - 292,Srccopy'自己写保存图片的过程吧~End SubPictureBox的ScaleMode要设置为pixel.你试试这个行不~PS 这个问题我好像见过?_?通过VB的BitBlt API来实现窗口局部区域截图悬赏分:150 |解决时间:2010-10-21 22:52 |提问者:诚信欢迎你我想将这个代码写成一个函数形式,保存为DLL文件自己用SavePicture方法可以保存图片但是,保存为DLL的时候报错说未定义什么我想各位帮忙想想通过什么方法能保存为图片问题补充:此问题通过交换方法已经解决了,3楼给的方法就是我说的那方法不过用到了插件故无法生成DLL吧,不过还是非常感谢最佳答案这个问题我以前也弄过,后来卡在你这个问题同样的地方没弄下去,现在看到你的问题,很有感触,准备再弄一下看看,没想到成功了哈,下面是代码,实现了后台截图并且保存,可以用到一些游戏脚本里面哈。

在VB中存取数据库中的图片

在VB中存取数据库中的图片

在VB中存取数据库中的图片一、数据库的设计数据库可以采用微软的Access97或者SQL Server来进行,首先新建一张表,取名为Table,添加三个字段,分别是:姓名Char型(SQL Server中)文本型(Access中);编号Char型(SQL Server中)文本型(Access中);照片image型(SQL Server中)OLE对象(Access中),设计好后存盘。

为了可以进行远程调用,我们采用ODBC的方法进行,双击打开控制面板里的ODBC数据源,点“系统DSN”选项卡,按“添加”按钮选择对应的数据源驱动程序Access的*.mdb或者SQL Server,依照添加向导加添加数据源,下面就可以开始程序的编写了。

二、程序的编写运行VB,新建一个工程。

本程序采用ADO控件和动态链接库访问数据库,需要加入ADO的运行库,单击“工程\引用”菜单,出现引用对话框,选择Microsoft ActiveX Data Objects2.0 Library并确定。

添加一个Form,四个Label控件,两个TextBox控件,一个PictureBox控件,一个ADODC 控件,三个CommandButton控件,一个CommandDialog控件,如果ADODC和CommandDialog控件没有出现在工具框上,请单击菜单“工程\部件”。

点“控件”选项卡,在其中选中Microsoft ADO Data Control 6.0(OLEDB)和Microsoft Common Dialog Control 6.0两项按“确定”按钮。

下面是以上各个控件的一些属性:Form1.MaxButton=FalseLabel1.Caption=姓名:Label2.Caption=编号:= ResNameLabel3.BackColor= &H80000009&Label3.BorderStyle=1-Fixed SingleLabel3.DataField=姓名Label3.DataSource= AdoCtr= ResNumbLabel4.BackColor= &H80000009&Label4.BorderStyle=1-Fixed SingleLabel4.DataField=编号Label4.DataSource= AdoCtr= Names= Numb= CDlg=AdoCtr=PreViewCommonButton1.Caption=预览=SaveCommonButton2.Caption=保存= UpdateCommonButton3.Caption=更新= PicBoxPictureBox1.AutoSize=FalsePictureBox1.AutoRedraw=FalsePictureBox1.DataField=照片PictureBox1.DataSource=AdpCtr下面是程序代码:′此工程需有Microsoft ActiveX Data Object 2.1 Library(msado15.dll)Dim Constr As String ′ODBC路径Dim FileName As String ′图片文件名Const BLOCKSIZE = 4096 ′每次读写块的大小Dim ADOCon As New ADODB.Connection ′ADODB Connection对象Dim ADORst As New ADODB.Recordset ′ADODB Recordset 对象Dim ADOFld As ADODB.Field ′ADODB Field 对象------------------------Private Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)Dim byteData() As Byte ′定义数据块数组Dim NumBlocks As Long ′定义数据块个数Dim FileLength As Long ′标识文件长度Dim LeftOver As Long′定义剩余字节长度Dim SourceFile As Long ′定义自由文件号Dim i As Long ′定义循环变量SourceFile = FreeFile ′提供一个尚未使用的文件号Open DiskFile For Binary Access Read As SourceFile ′打开文件FileLength = LOF(SourceFile) ′得到文件长度If FileLength = 0 Then ′判断文件是否存在Close SourceFileMsgBox DiskFile &〃无内容或不存在!〃ElseNumBlocks = FileLength \ BLOCKSIZE ′得到数据块的个数LeftOver = FileLength Mod BLOCKSIZE ′得到剩余字节数Fld.Value = NullReDim byteData(BLOCKSIZE) ′重新定义数据块的大小For i = 1 To NumBlocksGet SourceFile, , byteData() ′读到内存块中Fld.AppendChunk byteData() ′写入FLDNext iReDim byteData(LeftOver) ′重新定义数据块的大小Get SourceFile, , byteData() ′读到内存块中Fld.AppendChunk byteData() ′写入FLDClose SourceFile ′关闭源文件End IfEnd Sub----------------------Private Sub Form_Load()Constr = 〃DSN=image〃′定义ODBC连接ADOCon.Open Constr ′创建一个连接ADORst.Open 〃table〃, ADOCon, adOpenDynamic, adLockOptimistic ′打开一个ADO动态集表名为tableSet AdoCtr.Recordset = ADORst ′将动态集赋给ADO控件End Sub----------------------Private Sub Form_Unload(Cancel As Integer)′记得关闭打开的数据集,释放资源ADORst.CloseADOCon.CloseSet ADORst = NothingSet ADOCon = NothingEnd Sub----------------------Private Sub PreView_Click()′显示打开文件的公用对话框,选择需要加入数据库的图片CDlg.Filter = 〃位图(*.bmp)|*.bmp〃CDlg.ShowOpenFileName = CDlg.FileNamePicBox.Picture = LoadPicture(FileName) ′预览图片End Sub----------------------Private Sub Save_Click()ADORst.AddNew ′新增纪录ADORst(〃姓名〃).Value = Names.Text ′给动态集的第一个字段赋值ADORst(〃编号〃).Value = Numb.Text ′给动态集的第二个字段赋值Set ADOFld = ADORst(〃照片〃) ′给ADODB.Field对象赋值Call SaveToDB(ADOFld, FileName)′调用子程序,给第三个字段(image)赋值ADORst.UpdateEnd Sub----------------------Private Sub Update_Click()′重新打开纪录集,刷新纪录ADORst.CloseADOCon.CloseSet ADORst = NothingSet ADOCon = NothingADOCon.Open ConstrADORst.Open 〃table〃, ADOCon, adOpenDynamic, adLockOptimistic Set AdoCtr.Recordset = ADORstEnd Sub。

简谈VB中用数据库存取图片的简便方法

简谈VB中用数据库存取图片的简便方法

简谈VB中用数据库存取图片的简便方法摘要:VB数据库中图像数据的存取对初学者来说是个难点,文章总结了绑定图片控件、存储图片文件路径、利用PropertyBag对象与Byte数组中转三种较为简便的方法以供初学者参考。

关键词:VB;Data控件;数据库;图片;存取;路径;PropertyBag;Byte 数组图像数据的存取对初学者来说是个难点,而当前的VB教学因课时较短,所选教材或讲授过程对数据库一章要么忽略要么只是简单地介绍,很少涉及到图像的存取问题,而专业数据库开发书籍中的大量源代码又让初学者看得头疼,所以本文总结了3种相对简便的方法以供参考。

为顺利运行程序,以下每种方法中,图片文件夹和数据库文件、VB程序文件同时存储在同一目录下。

1绑定图片控件实现思路:用VB自带VisData建立数据库,把图片存储在数据库表的Binary 字段中,通过常用工具箱中Data控件与Image控件绑定,添加CommonDialog 部件用以选择图片文件,在Image的DblClick事件中打开通用对话框,用LoadPicture函数把选定的图片载入Image,用Data控件的四个箭头浏览记录。

1.1建立图片文件夹建立图片文件夹bmp,把准备好的图片(本例选用bmp、jpg、gif格式)放入其中,以备程序运行时添加和修改用。

1.2建立数据库启动外接程序下的可视化数据管理器VisData,建立stu数据库,新建xs表,包含学号、姓名、照片(类型Binary)3个字段。

因Binary型字段在表中无法直接操作,所以生成表后并不需添加记录,等程序运行时添加即可。

1.3界面设计在窗体上添加2个标签、2个文本框,2个命令按钮,1个Data控件,1个图像框,1个CommonDialog控件;设置图像框的BodyStyle属性为1,Stretch 属性设置为True;设置Data控件DataBaseName属性为stu.mdb,RecordSource 属性为xs,设置Textl、Text2的DataSource属性Datal,Textl的DataField属性为姓名,Text2的DataField属性为学号:标签与命令按钮属性设置如图1所示。

VBA调用API实现屏幕截图和图像处理的实例

VBA调用API实现屏幕截图和图像处理的实例

VBA调用API实现屏幕截图和图像处理的实例在Excel中使用Visual Basic for Applications(VBA)编程语言,可以实现许多功能,包括屏幕截图和图像处理。

通过调用应用程序编程接口(API),我们可以实现更高级的图像处理任务,以及捕捉屏幕上的特定区域。

本文将介绍如何使用VBA调用API实现屏幕截图和图像处理的实例。

第一部分:调用API实现屏幕截图在VBA中,我们可以使用API函数来捕捉屏幕上的特定区域,并保存为图像文件。

以下是实现这一功能的步骤:1. 在VBA编辑器中,在代码窗口中插入一个新的模块,以便编写我们的代码。

2. 在模块中添加以下代码,以声明我们将要使用的API函数:```vbaDeclare PtrSafe Function BitBlt Lib "gdi32" _(ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByValnWidth As Long, ByVal nHeight As Long, _ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As LongDeclare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtrDeclare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As LongDeclare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtrDeclare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtrDeclare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtrDeclare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtrDeclare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As LongPtrDeclare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long```3. 添加以下代码,在一个按钮的点击事件中触发屏幕截图:```vbaSub CaptureScreen()Dim hWnd As LongPtrDim hDC As LongPtrDim hWinDC As LongPtrDim hBitmap As LongPtrDim lWidth As LongDim lHeight As LonghWnd = GetDesktopWindow()hDC = GetDC(hWnd)lWidth = GetSystemMetrics(0)lHeight = GetSystemMetrics(1)hWinDC = CreateCompatibleDC(0)hBitmap = CreateCompatibleBitmap(hDC, lWidth, lHeight)SelectObject hWinDC, hBitmapBitBlt hWinDC, 0, 0, lWidth, lHeight, hDC, 0, 0, SRCCOPYDeleteDC hWinDCReleaseDC hWnd, hDCSavePicture hBitmap, "C:\Screenshot.jpg"DeleteObject hBitmapMsgBox "截图已保存在C盘根目录下的Screenshot.jpg文件中。

VB程序VB代码:摄像头视频图像的监控、截图、录像(改进)

VB程序VB代码:摄像头视频图像的监控、截图、录像(改进)

VB程序VB代码:摄像头视频图像的监控、截图、录像(改进)本程序是“实现USB摄像头视频图像的监控、截图、录像”的改进。

可实现对摄像头视频的监控、截图、录像,可以分别保存为图片文件和视频(压缩)文件。

保存的视频文件可以用媒体播放机(Windows Media Player)、暴风影音等软件进行播放,轻松实现家庭录像制作。

利用电脑配备的 USB 摄像头进行视频控制,要用到两个 API 函数:capCreateCaptureWindow 和 SendMessage。

其中,capCreateCaptureWindow 的作用是创建一个视频窗口,摄像头捕捉到的视频图像在此窗口内显示,函数返回值就是代表此窗口的句柄。

视频窗口创建后,剩下的事情就是用 SendMessage 向该窗口发送各种消息,实现对摄像头的控制。

本程序特点主要有:1.实现对摄像头视频图像的监控、截图,视频录像并保存为磁盘文件。

2.可控制多个视频摄像头。

例如,如果一台电脑配置了两个摄像头,启动本程序两次,单击按钮“源”,在弹出的“视频源”对话框中选择不同的捕获源,两个窗口就能同时显示不同摄像头获得的图像。

如下图所示:3.在“视频源”对话框中,还可以设置视频的亮度、对比度等许多参数:4.录像时,如果采用默认的 AVI 文件格式,得到的视频文件会很大。

单击按钮“压”,在弹出的“视频压缩”对话框中选择压缩方式“MPEG-4”,这样得到的视频文件会比默认方式小 10 倍以上。

5.本程序的视频窗口有自动大小和全屏功能。

在全屏状态时,工具栏会自动隐藏。

将鼠标移动到屏幕顶部,工具栏又会自动显示出来。

遗憾的是,由于水平有限,本程序无法判断是否使用了压缩记录方式,压缩后的文件其扩展名仍然是 AVI。

当然,这并不影响播放,录像完成后也可以手动将扩展名修改为 mpg。

其次,录像状态下改变视频窗口大小,有时会出现莫名其妙的错误。

这个错误时有时无,毫无规律,因此本程序不得不关闭了录像状态下视频窗口自动大小的功能。

VB用Picture控件绘制图形并保存

VB用Picture控件绘制图形并保存

Co4;bmp"
'设置或返回对话框的默认文件扩展名
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then Exit Sub
Rem 由绝对路径变相对路径 CurPath = App.Path AbsPath = CommonDialog1.FileName RPath = Replace(AbsPath, CurPath, vbNullString)
CommonDialog1.InitDir = App.Path CommonDialog1.FileName = "abcp"
'设置默认路径
CommonDialog1.DialogTitle = "请选择的模板文件名"
CommonDialog1.Filter = "位图文件(*.bmp)|*.bmp"
y = Sin(x * 3.1415926 / 180) Picture1.PSet (x, y) Next
Picture1.CurrentX = 10 Picture1.CurrentY = 0 Picture1.Font = "黑体" Picture1.FontSize = 20 Picture1.ForeColor = 16777215 Picture1.Print "ABCDF中国"
End Sub Rem 绘曲线图 Private Sub Command1_Click()
Dim x As Integer Dim y As Single
Picture1.AutoRedraw = True Picture1.Cls Picture1.Scale (0, 1.2)-(360, -1.2) Picture1.Line (0, 0)-(360, 0) For x = 0 To 360

VBA与屏幕自动截图的应用方法

VBA与屏幕自动截图的应用方法

VBA与屏幕自动截图的应用方法随着信息技术的迅猛发展,图像和截图在我们的日常工作中起着越来越重要的作用。

对于需要频繁进行截图的用户来说,手动截图往往效率低下且不够准确。

在这种情况下,利用VBA (Visual Basic for Applications)编程语言来实现自动截图的方法就变得非常有吸引力。

VBA是一种宏语言,它可以与Microsoft Office软件整合,包括Excel、Word和PowerPoint等常用软件。

通过使用VBA,我们可以编写自定义的宏来实现各种自动化任务。

在本文中,将介绍如何利用VBA在Microsoft Office软件中实现自动截图的方法。

在开始介绍具体的应用方法之前,我们需要明确所需软件和工具。

首先,我们需要安装Microsoft Office软件,包括Excel、Word和PowerPoint。

其次,我们需要了解VBA编程语言的基础知识,以便能够编写自定义的宏。

为了实现自动截图的功能,我们可以利用VBA中的一些内置的对象和方法。

以下是具体步骤:1. 打开所需的Office软件(例如Excel)。

在工具栏中选择“开发工具”,然后选择“Visual Basic”选项。

这将打开VBA编辑器。

2. 在VBA编辑器中,我们可以创建一个新的宏(或者在已有的宏中添加代码)。

通过点击“新建”按钮,然后将下列代码粘贴到新的代码模块中:```Sub Screenshot()Dim ScreenshotPath As StringDim ScreenshotName As StringScreenshotPath = "C:\Screenshots\" '指定截图的保存路径ScreenshotName = "Screenshot" '指定截图的名称SendKeys "%{PRTSC}" '按下“Alt + Print Screen”快捷键Application.Wait (Now + TimeValue("00:00:01")) '等待1秒钟以确保截图已保存到剪贴板With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '打开Paint应用程序.invokeverb "Paste" '将剪贴板中的内容粘贴到Paint中Application.Wait (Now + TimeValue("00:00:01")) '等待1秒钟以确保截图已粘贴到Paint中.invokeverb "SaveAs", ScreenshotPath & ScreenshotName & ".png" '保存截图为PNG格式.invokeverb "FileExit" '关闭Paint应用程序End WithEnd Sub```在上述代码中,我们首先指定了截图保存的路径和名称。

vb savepicture 的用法

vb savepicture 的用法

vb savepicture 的用法
在VB中,SavePicture函数用于将图像保存到文件中。

它的语法为:
SavePicture ( 图像, 文件名 )
其中,图像是需要保存的图像对象,可以是Picture控件、Image控件或Picture对象;文件名是保存的文件路径和名称。

示例代码如下:
```
Private Sub btnSave_Click()
Dim img As Picture
Set img = picImage.Picture ' picImage是一个Picture控件,用于显示图像
SavePicture img, "C:\images\image.jpg" ' 将图像保存为image.jpg文件
End Sub
```
在上面的示例中,点击按钮btnSave时,将picImage控件中的图像保存为C:\images\image.jpg文件。

注意事项:
1. 图像对象必须是合法的图像,否则可能会抛出异常。

2. 保存的文件路径必须是有效的,否则可能会抛出异常。

3. 保存的文件类型由文件名的扩展名决定,必须为支持的图像格式,如.jpg、.png等。

在VB.NET中进行抓屏

在VB.NET中进行抓屏

在中进行抓屏Public Class Form1Inherits System.Windows.Forms.Form#Region " Windows 窗体设计器生成的代码 "Public Sub New()MyBase.New()’该调用是 Windows 窗体设计器所必需的。

InitializeComponent()’在 InitializeComponent() 调用之后添加任何初始化End Sub’窗体重写处置以清理组件列表。

Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)If disposing ThenIf Not (components Is Nothing) Thencomponents.Dispose()End IfEnd IfMyBase.Dispose(disposing)End Sub’Windows 窗体设计器所必需的Private components As ponentModel.IContainer ’注意:以下过程是 Windows 窗体设计器所必需的’可以使用 Windows 窗体设计器修改此过程。

’不要使用代码编辑器修改它。

Friend WithEvents Button1 As System.Windows.Forms.ButtonFriend WithEvents Timer1 As System.Windows.Forms.TimerFriend WithEvents PictureBox1 As System.Windows.Forms.PictureBoxFriend WithEvents Button2 As System.Windows.Forms.Button<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()ponents = New ponentModel.Container Me.Button1 = New System.Windows.Forms.ButtonMe.Timer1 = New System.Windows.Forms.Timer(ponents)Me.PictureBox1 = New System.Windows.Forms.PictureBox Me.Button2 = New System.Windows.Forms.ButtonMe.SuspendLayout()’’Button1’Me.Button1.ForeColor = System.Drawing.Color.BlackMe.Button1.Location = New System.Drawing.Point(8, 312) = "Button1"Me.Button1.Size = New System.Drawing.Size(112, 32)Me.Button1.TabIndex = 0Me.Button1.Text = "抓屏"’’PictureBox1’Me.PictureBox1.Location = New System.Drawing.Point(8, 8) = "PictureBox1"Me.PictureBox1.Size = New System.Drawing.Size(392, 288) Me.PictureBox1.TabIndex = 4Me.PictureBox1.TabStop = False’’Button2’Me.Button2.ForeColor = System.Drawing.Color.BlackMe.Button2.Location = New System.Drawing.Point(264, 312) = "Button2"Me.Button2.Size = New System.Drawing.Size(112, 32)Me.Button2.TabIndex = 5Me.Button2.Text = "保存"’’Form1’Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)Me.BackColor = System.Drawing.Color.FromArgb(CType(192, Byte), CType(192, Byte), CType(255, Byte))Me.ClientSize = New System.Drawing.Size(408, 358)Me.Controls.Add(Me.Button2)Me.Controls.Add(Me.PictureBox1)Me.Controls.Add(Me.Button1)Me.ForeColor = System.Drawing.Color.FromArgb(CType(192, Byte), CType(255, Byte), CType(255, Byte)) = "Form1"Me.Text = "wgscd"Me.ResumeLayout(False)End Sub#End Region’中进行图象捕获,需要先引用一些API,以下是声明:Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Integer) As IntegerPrivate Declare Function CreateCompatibleBitmap Lib"GDI32" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As IntegerPrivate Declare Function SelectObject Lib "GDI32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer Private Declare Function BitBlt Lib "GDI32" (ByVal srchDC As Integer, ByVal srcX As Integer, ByVal srcY As Integer, ByVal srcW As Integer, ByVal srcH As Integer, ByVal desthDC As Integer, ByVal destX As Integer, ByVal destY As Integer, ByVal op As Integer) As IntegerPrivate Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Integer) As IntegerPrivate Declare Function DeleteObject Lib "GDI32" (ByVal hObj As Integer) As IntegerDeclare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As IntegerConst SRCCOPY As Integer = &HCC0020’将以下代码添加到Button1_Click事件中:Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim hDC, hMDC As IntegerDim hBMP, hBMPOld As IntegerDim sw, sh As IntegerhDC = GetDC(0)hMDC = CreateCompatibleDC(hDC)sw = Screen.PrimaryScreen.Bounds.Widthsh = Screen.PrimaryScreen.Bounds.HeighthBMP = CreateCompatibleBitmap(hDC, sw, sh)hBMPOld = SelectObject(hMDC, hBMP)BitBlt(hMDC, 0, 0, sw, sh, hDC, 0, 0, SRCCOPY)hBMP = SelectObject(hMDC, hBMPOld)PictureBox1.Image = Image.FromHbitmap(New IntPtr(hBMP))DeleteDC(hDC)DeleteDC(hMDC)DeleteObject(hBMP)Me.Button2.Enabled = TrueEnd SubPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Button2.Enabled = FalseEnd SubDim ofd As New SaveFileDialogPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click ofd.Filter = "jpg file|*.jpg|bmp file|*.bmp"Dim bmp As Bitmap = Me.PictureBox1.ImageIf ofd.ShowDialog = DialogResult.OK Thenbmp.Save(ofd.FileName)End IfEnd SubEnd Class。

使用VB将屏幕窗口中的内容保存下来

使用VB将屏幕窗口中的内容保存下来

使用VB将屏幕窗口中的内容保存下来
王有芹;盛强
【期刊名称】《甘肃科技》
【年(卷),期】1999(015)003
【摘要】@@ 在图形用户界面GUI环境中.图形是最基本的元素.在该环境中.向用户提供的大部分有趣的可视图像是对位图图形的运用.
【总页数】3页(P43-45)
【作者】王有芹;盛强
【作者单位】兰州市公安局城关分局计通科;兰州市公安局城关分局计通科
【正文语种】中文
【中图分类】TP316
【相关文献】
1.VB中使用API函数操作屏幕分辨率和色彩度 [J], 陆晓君
2.VB屏幕特技Paint Picture方法的使用技巧 [J], 黎明
3.使用VB6.0打造个性屏幕保护程序 [J], 柴华;孙纳新;田颖川
4.多屏幕多任务窗口中央空调监控系统控制方法 [J], 邱育群
5.在小屏幕和大屏幕之间——用优质内容筑起纪录片多平台转换的桥梁 [J], 郑伟因版权原因,仅展示原文概要,查看原文内容请购买。

相关主题
  1. 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。

利用VB捕捉并保存屏幕图像大家知道在VB下利用API函数Bitblt可以将屏幕或者窗口上的图象拷贝到VB 中的PictureBox对象中,但是如果简单的利用PictureBox的SavePicture函数来保存图象,会发现什么也保存不了。

这篇文章就是介绍如何捕获并利用Windows下的OLE API函数保存图象。

首先来看源程序,首先建立一个新的工程文件,然后在Form1中加入5个CommandButton对象和一个PictureBox对象,然后在Form1中加入以下代码:Option ExplicitOption Base 0Private Type PALETTEENTRYpeRed As BytepeGreen As BytepeBlue As BytepeFlags As ByteEnd TypePrivate Type LOGPALETTEpalVersion As IntegerpalNumEntries As IntegerpalPalEntry(255) As PALETTEENTRYEnd TypePrivate Type GUIDData1 As LongData2 As IntegerData3 As IntegerData4(7) As ByteEnd TypePrivate Const RASTERCAPS As Long = 38Private Const RC_PALETTE As Long = &H100Private Const SIZEPALETTE As Long = 104Private Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypePrivate Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, _ByVal nWidth As Long, ByVal nHeight As Long) As LongPrivate Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal _iCapabilitiy As Long) As LongPrivate Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, _ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries _As PALETTEENTRY) As LongPrivate Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) _As LongPrivate Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject _As Long) As LongPrivate Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long, ByVal XDest As _Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop _As Long) As LongPrivate Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function GetForegroundWindow Lib "USER32" () As Long Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette _As Long, ByVal bForceBackground As Long) As LongPrivate Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As LongPrivate Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As _RECT) As LongPrivate Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As _Long) As LongPrivate Declare Function GetDesktopWindow Lib "USER32" () As LongPrivate Type PicBmpSize As LongType As LonghBmp As LonghPal As LongReserved As LongEnd TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As _PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long'捕捉整个屏幕Private Sub Command1_Click()Set Picture1.Picture = CaptureScreen()End Sub'在两秒钟后捕捉当前的活动窗口Private Sub Command2_Click()MsgBox "当你关闭这个对话框两秒钟之后程序会捕捉处于活动状态的窗口."'等待两秒钟Dim EndTime As DateEndTime = DateAdd("s", 2, Now)Do Until Now > EndTimeDoEventsLoopSet Picture1.Picture = CaptureActiveWindow()Me.SetFocusEnd SubPrivate Sub Command3_Click()Set Picture1.Picture = NothingEnd SubPublic Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As PictureDim r As LongDim Pic As PicBmpDim IPic As IPictureDim IID_IDispatch As GUID'填充IDispatch界面With IID_IDispatch.Data1 = &H20400.Data4(0) = &HC0.Data4(7) = &H46End With'填充PicWith Pic.Size = Len(Pic) ' Pic结构长度.Type = vbPicTypeBitmap ' 图象类型.hBmp = hBmp ' 位图句柄.hPal = hPal ' 调色板句柄End With'建立Picture图象r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)'返回Picture对象Set CreateBitmapPicture = IPicEnd FunctionPublic Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal _LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc _As Long) As PictureDim hDCMemory As LongDim hBmp As LongDim hBmpPrev As LongDim r As LongDim hDCSrc As LongDim hPal As LongDim hPalPrev As LongDim RasterCapsScrn As LongDim HasPaletteScrn As LongDim PaletteSizeScrn As LongDim LogPal As LOGPALETTEIf Client ThenhDCSrc = GetDC(hWndSrc)ElsehDCSrc = GetWindowDC(hWndSrc)End IfhDCMemory = CreateCompatibleDC(hDCSrc)hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)hBmpPrev = SelectObject(hDCMemory, hBmp)'获得屏幕属性RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)HasPaletteScrn = RasterCapsScrn And RC_PALETTEPaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)'如果屏幕对象有调色板则获得屏幕调色板If HasPaletteScrn And (PaletteSizeScrn = 256) Then'建立屏幕调色板的拷贝LogPal.palVersion = &H300LogPal.palNumEntries = 256r = GetSystemPaletteEntries(hDCSrc, 0, 256,LogPal.palPalEntry(0))hPal = CreatePalette(LogPal)'将新建立的调色板选如建立的内存绘图句柄中hPalPrev = SelectPalette(hDCMemory, hPal, 0)r = RealizePalette(hDCMemory)End If'拷贝图象r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)hBmp = SelectObject(hDCMemory, hBmpPrev)If HasPaletteScrn And (PaletteSizeScrn = 256) ThenhPal = SelectPalette(hDCMemory, hPalPrev, 0)End If'释放资源r = DeleteDC(hDCMemory)r = ReleaseDC(hWndSrc, hDCSrc)Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)End Function'capturescreen函数捕捉整个屏幕图象Public Function CaptureScreen() As PictureDim hWndScreen As Long'获得桌面的窗口句柄hWndScreen = GetDesktopWindow()Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width _\ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY) End FunctionPublic Function CaptureActiveWindow() As PictureDim hWndActive As LongDim r As LongDim RectActive As RECThWndActive = GetForegroundWindow()r = GetWindowRect(hWndActive, RectActive)Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, _ RectActive.Right - RectActive.Left, RectActive.Bottom - RectActive.Top)End FunctionPublic Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture) Const vbHiMetric As Integer = 8Dim PicRatio As DoubleDim PrnWidth As DoubleDim PrnHeight As DoubleDim PrnRatio As DoubleDim PrnPicWidth As DoubleDim PrnPicHeight As DoubleIf Pic.Height >= Pic.Width ThenPrn.Orientation = vbPRORPortraitElsePrn.Orientation = vbPRORLandscapeEnd IfPicRatio = Pic.Width / Pic.HeightPrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric) PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric) PrnRatio = PrnWidth / PrnHeightIf PicRatio >= PrnRatio ThenPrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode)ElsePrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode)End IfPrn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeightEnd SubPrivate Sub Command4_Click()CommonDialog1.DefaultExt = ".BMP"CommonDialog1.Filter = "Bitmap Image (*.bmp)|*.bmp"CommonDialog1.ShowSaveIf CommonDialog1.FileName <> "" ThenSavePicture Picture1.Picture, CommonDialog1.FileName End IfEnd SubPrivate Sub Command5_Click()PrintPictureToFitPage Printer, Picture1.PicturePrinter.EndDocEnd SubPrivate Sub Form_Load()Command1.Caption = "捕捉整个屏幕"Command2.Caption = "两秒钟后捕捉活动窗口"Command3.Caption = "清除图象"Command4.Caption = "保存图象"Command5.Caption = "打印图象"End Sub运行程序,点击command1或者Command2就可以捕捉成个屏幕或者窗口到Picture1中,然后点击Command4或者Command5就可以保存或打印图象。

相关文档
最新文档