51Testing软件测试论坛
标题:
VBS读取图片像素 WIA 组件
[打印本页]
作者:
wuxue107
时间:
2013-6-27 22:50
标题:
VBS读取图片像素 WIA 组件
在浏览自己系统里带有的COM组件时,看到了WIA.ImageFile.1 这个网上查了下,了解到这个组件可以对图片做些处理。具体能做些图片格式转换,像素处理,剪切之类的工作。这个组件Win7应该是自带的。
我用他写了个宏,将图片转换为Excel单元格拼接的马赛克图片。下面是代码。图片最好256色的。[attach]85950[/attach]
Public Const scrHeight = 435
Public Const scrWidth = 124
Public Const RC = 8
Public objBMPData, objScreen, Screen
Public bitRowCount, bitColCount, allLine
Public bits()
Sub LoadingPicture()
'' 初始化显示屏幕
Call ReadBMPData
Call SetConfig
Call ClearScreen
Call RefreshScreen
End Sub
Sub ReadBMPData()
Dim file
Set dlgOpen = Application.FileDialog(3)
If dlgOpen.Show = -1 Then
file = dlgOpen.SelectedItems(1)
Else
End
End If
Set pic = CreateObject("WIA.ImageFile.1")
pic.LoadFile file
bitColCount = pic.Width
bitRowCount = pic.Height
bitDepth = pic.PixelDepth
Set cl = pic.ARGBData
ReDim bits(bitRowCount, bitColCount)
Index = 1
For i = 0 To bitRowCount - 1
For j = 0 To bitColCount - 1
bits(i, j) = cl.Item(Index)
Index = Index + 1
Next
Next
End Sub
Sub SetConfig()
Set Screen = Sheets("屏幕")
Set objScreen = Screen.Range("A2").Resize(bitRowCount, bitColCount)
Screen.Cells.ColumnWidth = scrWidth / bitColCount
Screen.Range("2:50000").RowHeight = scrWidth * RC / bitColCount
End Sub
Sub RefreshScreen()
Application.ScreenUpdating = False
For i = 0 To bitRowCount - 1
For j = 0 To bitColCount - 1
objScreen.Cells(i + 1, j + 1).Interior.Color = bits(i, j)
Next
Next
Application.ScreenUpdating = True
End Sub
Sub ClearScreen()
Screen.Cells.Clear
End Sub
复制代码
作者:
lsekfe
时间:
2013-6-28 09:59
支持下~
欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/)
Powered by Discuz! X3.2