注冊 登錄
Office中國論壇/Access中國論壇 返回首頁

ganlinlao的個人空間 http://m.mzhfr.cn/?230471 [收藏] [復(fù)制] [分享] [RSS]

日志

VB、VBA、VBS簡易的圖像處理 Windows Image Acquisition (WIA) 的用法

熱度 1已有 6619 次閱讀2015-2-13 23:18 |個人分類:vb入門| WIA的用法, VB雜記

WIA在處理圖像上還是提供了不少簡易的方式方法,先記在這里,以備不時之需。
一、
旋轉(zhuǎn)翻轉(zhuǎn)過濾器:旋轉(zhuǎn)圖片
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"

三、縮放濾鏡調(diào)整圖像的大小
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"

六、幀過濾器創(chuàng)建一個多頁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過濾器:創(chuàng)建一個修改版本圖片
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"

八、從圖片格式轉(zhuǎn)換創(chuàng)建一個壓縮的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"

發(fā)表評論 評論 (1 個評論)

回復(fù) t小寶 2015-2-25 22:12
很好,我也記下下來備用

facelist doodle 涂鴉板

您需要登錄后才可以評論 登錄 | 注冊

QQ|站長郵箱|小黑屋|手機版|Office中國/Access中國 ( 粵ICP備10043721號-1 )  

GMT+8, 2025-7-13 08:42 , Processed in 0.065231 second(s), 18 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回頂部