VBA中使用WIA处理本地图像

shenjianrong163 · 发表于 2021-1-2 14:04

   一、WIA简介
   （一）关于WIA
   WIA是Windows Image Acquisition 的简称，它是 Windows Millennium Edition (Windows Me) 或者更高版本的 Windows 系统中提供的数字图像获取服务，同时它也能用于管理数字图像设备。
WIA 接口既是应用程序接口（WIA API），又是设备驱动程序接口（WIA DDI），下面要讲述的都是有关 WIA API 的内容。
通过 WIA API，应用程序可以：
   1.运行在强壮稳定的环境中；
   2.最大可能地减少协同配合问题；
   3.枚举可用的图像获取设备；
   4.同时连接多个设备；
   5.用标准的、可扩展的方式查询设备属性；
   6.用标准的、高性能的传送机制获取数据；
   7.在数据传送过程中维持图像属性；
   8.获取大量的设备事件通知消息。
   （二）WIA 架构
   WIA 是使用进程外（Out of process）服务实现的 COM 组件，和大多数进程外服务程序不同的是，WIA 通过提供自己的数据传送机制（IWiaDataTransfer 接口），避免了图像数据传送过程中的性能损失。高性能的 IWiaDataTransfer 接口使用共享内存来传送数据给客户程序。
   二、在VBA中使用WIA获取数据 (利用Filter处理图片)
   WIA Automation Layer不仅能从设备中捕获照片，还能进行简单的处理。当WIA Automation Layer从设备中捕获照片，保存为一个ImageFile对象，我们可以通过访问该ImageFile对象来访问照片的属性。然而，为了保护原来的照片，不能直接通过修改该ImageFile对象的方法修改图片。代替的方法是，使用ImageProcess和一个或多个Filter对象创建一个副本，修改图片。

   以下是可用的FilterID

   RotateFlip
   以 90 度增量旋转，以及水平或垂直翻转。
   RotationAngle  - 如果希望旋转，可将 RotationAngle 属性设置为 90、180 或 270，否则设置为 0 [默认值]
   FlipHorizontal - 如果希望水平翻转图像，可将 FlipHorizontal 属性设置为 True，否则设置为 False [默认值]
   FlipVertical - 如果希望垂直翻转图像，可将 FlipVertical 属性设置为 True，否则设置为 False [默认值]
   FrameIndex    - 如果希望修改除 ActiveFrame 之外的帧，可将 FrameIndex 属性设置为帧的索引，否则设置为 0 [默认值]

   Crop
   以指定的左?右?上?下边距裁剪图像?
   Left    - 如果希望沿左侧裁剪，可将 Left 属性设置为左边距(单位为像素)，否则设置为 0 [默认值]
   Top       - 如果希望沿顶部裁剪，可将 Top 属性设置为上边距(单位为像素)，否则设置为 0 [默认值]
   Right    - 如果希望沿右侧裁剪，可将 Right 属性设置为右边距(单位为像素)，否则设置为 0 [默认值]
   Bottom    - 如果希望沿底部裁剪，可将 Bottom 属性设置为下边距(单位为像素)，否则设置为 0 [默认值]
   FrameIndex - 如果希望修改除 ActiveFrame 之外的帧，可将 FrameIndex 属性设置为帧的索引，否则设置为 0 [默认值]

   Scale
   将图像缩放到指定的最大宽度和最大高度，如有必要，保留纵横比。
   MaximumWidth       - 将 MaximumWidth 属性设置为希望将图像缩放到的宽度(单位为像素)。
   MaximumHeight    - 将 MaximumHeight 属性设置为希望将图像缩放到的高度(单位为像素)。
   PreserveAspectRatio - 如果希望保持图像当前的纵横比，可将 PreserveAspectRatio 属性设置为 True [默认值]，否则设置为 False，图像将被拉伸到MaximumWidth 和 MaximumHeight
   FrameIndex       - 如果希望修改除 ActiveFrame 之外的帧，可将 FrameIndex 属性设置为帧的索引，否则设置为 0 [默认值]

   Stamp
   在指定的 Left 和 Top 坐标处标记指定的 ImageFile。
   ImageFile  - 将 ImageFile 属性设置为希望标记的 ImageFile 对象
   Left    - 将 Left 属性设置为希望将 ImageFile 标记到的从左侧开始的偏移(单位为像素)[默认值为 0]
   Top       - 将 Top 属性设置为希望将 ImageFile 标记到的从顶部开始的偏移(单位为像素)[默认值为 0]
   FrameIndex - 如果希望修改除 ActiveFrame 之外的帧，可将 FrameIndex 属性设置为帧的索引，否则设置为0[默认值]

   exif
   添加/删除指定的 Exif 属性。
   Remove    - 如果希望删除指定的 Exif 属性，可将 Remove 属性设置为 True，否则设置为 False [默认值]以添加指定的 exif 属性
   ID       - 将 ID 属性设置为希望添加或删除的 PropertyID
   Type    - 设置 Type 属性以指示希望添加的 Exif 属性的 WiaImagePropertyType(对于删除则忽略)
   Value    - 将 Value 属性设置为希望添加的 Exif 属性的值(对于删除则忽略)
   FrameIndex - 如果希望修改除 ActiveFrame 之外的帧，可将 FrameIndex 属性设置为帧的索引，否则设置为0[默认值]

   Frame
   Remove    - 如果希望删除指定的 FrameIndex，可将 Remove 属性设置为 True，否则设置为 False [默认值]以在指定的 FrameIndex 之前插入 ImageFile
   ImageFile  - 将 ImageFile 属性设置为希望添加其 ActiveFrame 的 ImageFile 对象(对于删除则忽略)
   FrameIndex - 对于删除，将 FrameIndex 属性设置为希望删除的帧的索引，对于添加，将 FrameIndex 设置为要在其之前插入ImageFile 的帧的索引，否则设置为 0 [默认值]
   以从指定的 ImageFile 追加帧

   ARGB
   ARGBData - 将 ARGBData 属性设置为表示指定 FrameIndex 的ARGB 数据的 Longs 的矢量(宽度和高度必须匹配)
   FrameIndex - 将 FrameIndex 属性设置为希望修改其 ARGB 数据的帧的索引，否则设置为0[默认值]以修改ActiveFrame

   Convert
   将得到的 ImageFile 转换为指定的类型。
   FormatID - 将 FormatID 属性设置为所需支持的光栅图像格式，当前可选择的格式有 wiaFormatBMP、wiaFormatPNG、wiaFormatGIF、wiaFormatJPEG 或 wiaFormatTIFF
   Quality    - 对于 JPEG 文件，可将 Quality 属性设置为从 1 到100 [默认值]之间的任何值，以指定 JPEG 压缩的质量
   Compression - 对于 TIFF 文件，可将 Compression 属性设置为 CCITT3、CCITT4、RLE 或 Uncompressed 以指定压缩方案，否则可设置为 LZW [默认值]

shenjianrong163 · 发表于 2021-1-2 14:17

三、WIA处理图片
（一）旋转翻转过滤器：旋转图片

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("RotateFlip").FilterID
IP.Filters(1).Properties("RotationAngle") = 90
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\Bliss90.bmp"
End Sub

复制代码

（二）裁剪滤镜：裁剪图片

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Crop").FilterID
IP.Filters(1).Properties("Left") = Img.Width \ 4
IP.Filters(1).Properties("Top") = Img.Height \ 4
IP.Filters(1).Properties("Right") = Img.Width \ 4
IP.Filters(1).Properties("Bottom") = Img.Height \ 4
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissCrop.bmp"
End Sub

复制代码

（三）缩放滤镜：缩放图片大小

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = 100
IP.Filters(1).Properties("MaximumHeight") = 100
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissThumb.bmp"
End Sub

复制代码

（四）邮票过滤器：邮票在另一个图片一个图片

Sub test()
Dim Thumb 'As ImageFile
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Set Img = CreateObject("WIA.ImageFile")
Set Thumb = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
Thumb.LoadFile "C:\WINDOWS\Web\Wallpaper\BlissThumb.bmp"
IP.Filters.Add IP.FilterInfos("Stamp").FilterID
Set IP.Filters(1).Properties("ImageFile") = Thumb
IP.Filters(1).Properties("Left") = Img.Width - Thumb.Width
IP.Filters(1).Properties("Top") = Img.Height - Thumb.Height
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissStamp.bmp"
End Sub

复制代码

（五）EXIF过滤器：写一个新的标题标签图像

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Dim v 'As Vector
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Set v = CreateObject("WIA.Vector")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Autumn.jpg"
IP.Filters.Add IP.FilterInfos("Exif").FilterID
IP.Filters(1).Properties("ID") = 40091
IP.Filters(1).Properties("Type") = VectorOfBytesImagePropertyType '此处的VectorOfBytesImagePropertyType值应改为：1101
v.SetFromString "This Title tag written by Windows Image Acquisition Library v2.0"
IP.Filters(1).Properties("Value") = v
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\AutumnExif.jpg"
End Sub

复制代码

（六）帧过滤器：创建一个多页TIFF三种图片

Sub test()
Dim Img 'As ImageFile
Dim Page2 'As ImageFile
Dim Page3 'As ImageFile
Dim IP 'As ImageProcess
Dim v 'As Vector
Set Img = CreateObject("WIA.ImageFile")
Set Page2 = CreateObject("WIA.ImageFile")
Set Page3 = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
Page2.LoadFile "C:\WINDOWS\Web\Wallpaper\Azul.jpg"
Page3.LoadFile "C:\WINDOWS\Web\Wallpaper\Autumn.jpg"
IP.Filters.Add IP.FilterInfos("Frame").FilterID
Set IP.Filters(IP.Filters.Count).Properties("ImageFile") = Page2
IP.Filters.Add IP.FilterInfos("Frame").FilterID
Set IP.Filters(IP.Filters.Count).Properties("ImageFile") = Page3
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(IP.Filters.Count).Properties("FormatID") = wiaFormatTIFF
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\Bliss.tif"
Img.ActiveFrame = Img.FrameCount
Set v = Img.ARGBData
Set Img = v.ImageFile(Img.Width, Img.Height)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\Autumn.bmp"
End Sub

复制代码

（七）ARGB过滤器：创建一个修改版本的图片

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Dim v 'As Vector
Dim i 'As Long
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
Set v = Img.ARGBData
For i = 1 To v.Count Step 21
v(i) = &HFFFF00FF 'opaque pink (A=255,R=255,G=0,B=255)
Next
IP.Filters.Add IP.FilterInfos("ARGB").FilterID
Set IP.Filters(1).Properties("ARGBData") = v
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissARGB.bmp"
End Sub

复制代码

（八）从另一个文件转换过滤器：创建一个压缩的JPEG文件

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "C:\WINDOWS\Web\Wallpaper\Bliss.bmp"
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(1).Properties("FormatID").Value = wiaFormatJPEG
IP.Filters(1).Properties("Quality").Value = 5
Set Img = IP.Apply(Img)
Img.SaveFile "C:\WINDOWS\Web\Wallpaper\BlissCompressed.jpg"
End Sub

复制代码

（九）从另一个文件转换过滤器：转化图片格式

Sub test()
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Const wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile "test.bmp"
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(1).Properties("FormatID").Value = wiaFormatJPEG
Set Img = IP.Apply(Img)
Img.SaveFile "test.jpg"
End Sub

复制代码

（十）VBA中也有Vector
1.下面的示例演示了如何创建一个Vector对象并初始化为包含ASCII字符串"This is a test"的字节型Vector。

Sub test()
Dim v 'As Vector
Dim i 'As Integer
Set v = CreateObject("WIA.Vector")
v.SetFromString "This is a test", True, False
For i = 1 To v.Count
MsgBox Chr(v(i))
Next
End Sub

复制代码

2.Vector更强大的地方在于可以用来创建图片，只可惜功能太简单了。

Sub test()
Dim Img 'As ImageFile
Dim v 'As Vector
Set v = CreateObject("WIA.Vector")
For i = 1 To 100 * 100
v.Add &HFF0000FF
Next
Set Img = v.ImageFile(100, 100)
Img.SaveFile "Blue." & Img.FileExtension
End Sub

复制代码

   Vector中的一个元素代表一个像素点，示例中的Vector对象有100*100个元素（像素点），每个像素的ARGB值都是FF0000FF（完全不透明的蓝色）。如果你足够强大，你完全可以用Vector来画一幅蒙娜丽莎。

   3.VBA可以通过调用WIA.Vector对象画图，使用该对象的Add方法可以把vb中的颜色逐个坐标画到位图中。
   下面这段代码，是打印方程X(n+1)=cot(X(n)),x(1)=1迭代20次后的图像（坐标有调整，每个小格并不代表单位1）

Sub test()
Debug.Print "计算X(n+1)=cot(X(n)),x(1)=1 迭代20次"
'沙盘
Dim v(300, 300)
'初始值
Dim F
F = 1
'迭代前的初始点
Dim TX, TY
For TX = -3 To 3
For TY = -3 To 3
v(50 + TX, 150 + TY) = 1
Next
Next
Debug.Print "初始值 " & F
'迭代公式20次
Dim Counter
For Counter = 1 To 20
F = Cos(F) / Sin(F)
Debug.Print "第 " & Counter & " 次迭代，值为 " & F
'沙盘描点
For TX = -3 To 3
For TY = -3 To 3
v(50 + Counter * 10 + TX, 150 + Val(F) * 3 + TY) = 1
Next
Next
Next
Debug.Print "计算完毕"
'创建WIA对象
Set Ve = CreateObject("WIA.Vector")
'绘制图像
Dim X, Y, i, J
For Y = 1 To 300
For X = 1 To 300
'描点
If v(X, Y) = 1 Then
Ve.Add vbRed
'横纵轴
ElseIf X = 50 Or Y = 150 Then
Ve.Add vbBlue
'横纵坐标辅助线
ElseIf X Mod 10 = 0 Or Y Mod 10 = 0 Then
Ve.Add vbBlack
'留白
Else
Ve.Add vbWhite
End If
Next
Next
Ve.ImageFile(300, 300).SaveFile ThisWorkbook.Path & "\result.bmp"
MsgBox "成功生成图片!"
End Sub

复制代码

（十一）用WIA获取图片分辨率

Sub test()
Dim Img 'As ImageFile
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile "test.jpg"
MsgBox "图片宽度：" & Img.Width & "图片高度：" & Img.Height
End Sub

复制代码

四、后话
WIA 是 Windows ME 及其以后的操作系统中提供的，Windows 98/2000 均不支持 WIA，因此需要在较新版本的 MSDN Library 中才有 WIA 文档。WIA 1.0 在 MSDN 的文档地址是：http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wia/wia/overviews/startpage.asp，或者按目录：MSDN Library -> 图形和多媒体 -> Windows 图像获取 -> WIA 1.0。

shenjianrong163 · 发表于 2021-1-2 17:31

以下是打印方程X(n+1)=cot(X(n)),x(1)=1迭代20次后的图像：

gwjkkkkk · 发表于 2021-1-2 17:42

谢谢楼主分享，非常感谢！

shenjianrong163 · 发表于 2021-1-2 17:47

根据WIA，做了一个常用图片（jpg|jpge|bmp|png|gif|tif）处理的软件：VBA批量调整本地图片
http://club.excelhome.net/thread-1569955-1-1.html
(出处: ExcelHome技术论坛)

gwjkkkkk · 发表于 2021-1-2 18:11

谢谢楼主分享。。。

gaozengxun · 发表于 2021-1-2 21:10

好东西，好好学习学习。

joforn · 发表于 2021-1-2 21:54

从你介绍的功能来看，这个好像就只是Gdip++二次的封装，在C++中可以直接引用Gdip++，VS中也已经有现成的封装，而且VB中也可以直接调用Gidp++中的函数自己处理，为什么要去引用一个第三方的WIA.ImageFile？如果是VBA的话，我相信直接用自己的代码要远比引用其它的库要好很多。第一、如果这个类只支持32位的话，那么到了64位的Office中直接就用不了。第二、如果是自己一个人用用还没所谓，但如果是要发布的VBA程序，那么至少要三个文件，而且还要在客户端去注册，并且并不是所有的客户机都有权限注册Dll文件的。

aecn · 发表于 2021-1-2 22:05

谢谢楼主分享，收藏学习

shenjianrong163 · 发表于 2021-1-3 09:52

joforn 发表于 2021-1-2 21:54
从你介绍的功能来看，这个好像就只是Gdip++二次的封装，在C++中可以直接引用Gdip++，VS中也已经有现成的封 ...

谢谢joforn版主的指导，只因对其它知识的了解不足，又不愿意采用将图片先导入Excel处理后再导出的方法，固而查阅了WIA这方面的知识。希望joforn版主以后多多指导，谢谢！

		自动登录	找回密码
密码			免费注册

[分享] VBA中使用WIA处理本地图像

评分

评分