VB、VBA、VBS简易的图像处理 Windows Image Acquisition (WIA) 的用法

WIA在处理图像上还是提供了不少简易的方式方法，先记在这里，以备不时之需。

一、旋转翻转过滤器：旋转图片

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" 

二、裁剪滤镜：裁剪图片

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" 

三、缩放滤镜：调整图像的大小

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" 

四、图章过滤器：一个图片上盖上另一个图章

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" 

五、EXIF过滤器：写一个新的标题标签图像（文字水印）

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  

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" 

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

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" 

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

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" 

八、从图片格式转换：创建一个压缩的JPEG文件

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("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"