51Testing软件测试论坛

标题: VBS读取图片像素 WIA 组件 [打印本页]

作者: wuxue107    时间: 2013-6-27 22:50
标题: VBS读取图片像素 WIA 组件
在浏览自己系统里带有的COM组件时,看到了WIA.ImageFile.1 这个网上查了下,了解到这个组件可以对图片做些处理。具体能做些图片格式转换,像素处理,剪切之类的工作。这个组件Win7应该是自带的。

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

  1. Public Const scrHeight = 435
  2. Public Const scrWidth = 124
  3. Public Const RC = 8
  4. Public objBMPData, objScreen, Screen
  5. Public bitRowCount, bitColCount, allLine
  6. Public bits()

  7. Sub LoadingPicture()
  8. '' 初始化显示屏幕
  9. Call ReadBMPData
  10. Call SetConfig
  11. Call ClearScreen
  12. Call RefreshScreen
  13. End Sub


  14. Sub ReadBMPData()
  15.     Dim file
  16.     Set dlgOpen = Application.FileDialog(3)
  17.     If dlgOpen.Show = -1 Then
  18.         file = dlgOpen.SelectedItems(1)
  19.     Else
  20.         End
  21.     End If
  22.    
  23.     Set pic = CreateObject("WIA.ImageFile.1")
  24.     pic.LoadFile file
  25.     bitColCount = pic.Width
  26.     bitRowCount = pic.Height
  27.     bitDepth = pic.PixelDepth
  28.     Set cl = pic.ARGBData
  29.     ReDim bits(bitRowCount, bitColCount)
  30.     Index = 1
  31.     For i = 0 To bitRowCount - 1
  32.         For j = 0 To bitColCount - 1
  33.             bits(i, j) = cl.Item(Index)
  34.             Index = Index + 1
  35.         Next
  36.     Next
  37. End Sub

  38. Sub SetConfig()
  39.     Set Screen = Sheets("屏幕")
  40.     Set objScreen = Screen.Range("A2").Resize(bitRowCount, bitColCount)
  41.     Screen.Cells.ColumnWidth = scrWidth / bitColCount
  42.     Screen.Range("2:50000").RowHeight = scrWidth * RC / bitColCount
  43. End Sub

  44. Sub RefreshScreen()
  45.     Application.ScreenUpdating = False
  46.     For i = 0 To bitRowCount - 1
  47.         For j = 0 To bitColCount - 1
  48.             objScreen.Cells(i + 1, j + 1).Interior.Color = bits(i, j)
  49.         Next
  50.     Next
  51.     Application.ScreenUpdating = True
  52. End Sub

  53. Sub ClearScreen()
  54.     Screen.Cells.Clear
  55. End Sub
复制代码

作者: lsekfe    时间: 2013-6-28 09:59
支持下~




欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/) Powered by Discuz! X3.2