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文件
'没有添加引用Microsoft Windows Image Acquisition Library v2.0的话
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}"
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"