软件测试论坛 › [QuickTest Professional] › VBS读取图片像素 WIA 组件

wuxue107 发表于 2013-6-27 22:50:00

VBS读取图片像素 WIA 组件

在浏览自己系统里带有的COM组件时，看到了WIA.ImageFile.1 这个网上查了下，了解到这个组件可以对图片做些处理。具体能做些图片格式转换，像素处理，剪切之类的工作。这个组件Win7应该是自带的。

我用他写了个宏，将图片转换为Excel单元格拼接的马赛克图片。下面是代码。图片最好256色的。

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:51

支持下~

查看完整版本: VBS读取图片像素 WIA 组件