请教大侠：如何利用VB进行如下图像处理？

Question

我想利用VB提取黑白的BMP格式图片中的各个像素，存储成矩阵来进行图像虑波处理。不知道如何操作？

Answer 1

建议你看一下BMP格式的文件结构。这个东西在网上Google一下就能找到。

Answer 2

BMP文件格式分析:
http://asp.6to23.com/iseesoft/devdoc/imgdoc/bmp_fileformat.htm

Answer 3

可以用个笨办法：
扫描：
Private Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long   '获得指定点的颜色 
  for i=1 to Picture1.Width
    for j=1 to Picture1.Height 
   if      GetPixel(i,j)=rgb(0,0,0) then '黑色
    elseif   GetPixel(i,j)=rgb(255,255,255) then     ’白色  
    endif   
  next j,i
 

Answer 4

[文件头定义]Public Type tpBitMapFileHeader
  bfType As Integer
  bfSize As Long
  bfReserved1 As Integer
  bfReserved2 As Integer
  bfOffBits As Long
End TypePublic Type tpBitMapInfoHeader
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Long
  biYPelsPerMeter As Long
  biClrUsed As Long
  biClrImportant As Long
End TypePublic Type tpBitMapHeader
  bhFileHeader As tpBitMapFileHeader
  bhInfoHeader As tpBitMapInfoHeader
End Type打开文件：Dim tOutHeader As tpBitMapHeader
Dim tOutBytes() As ByteDim tAddStart As Long
Dim tAddEnd As LongFN=FreeFile
Open pFileName For Binary As #FN
  Get #FN,1,tOutHeader '读文件头
  tAddStart=tOutHeader.bhFileHeader.bfOffBits '获得数据起始地址。
  tAddEnd=tOutHeader.bhFileHeader.bfSize
  ReDim tOutBytes(tAddEnd-tAddStart) '设定数组大小。这个环节建议编写一个函数验证
  Get #FN,tAddStart,tOutBytes() '读点阵数据
Close #FN之后可以根据图象学处理tOutBytes()里的点阵数据。显示tOutBytes()的点阵需要在以上基础添加如下程序：Public Type tpRGBQuad
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End TypeStretchDIBits FormShow.hDC, 0, 0, FormShow.ScaleWidth, FormShow.ScaleHeight, 0, 0, BitMapInfoHeader.biWidth, pubBitMapInfoHeader.biHeight, tPixels(0), pubBitMapInfo, 0, Public Type tpBitMapInfo
  bmiHeader As tpBitMapInfoHeader
  bmiColors As tpRGBQuad
End TypePublic Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As tpBitMapInfo, ByVal wUsage As Long, ByVal dwRop As Long) As LongPublic Const DIB_PAL_COLORS = 1Public Const DIB_RGB_COLORS = 0Public Const SRCCOPY = &HCC0020[显示到窗体]Dim tBitMapInfo As tpBitMapInfotBitMapInfo.bmiHeader=tOutHeader.bhInfoHeaderStretchDIBits Form_Test.hDC, 0, 0, Form_Test.ScaleWidth, Form_Test.ScaleHeight, 0, 0, tBitMapInfo.bmiHeader.biWidth, tBitMapInfo.bmiHeader.biHeight, tOutBytes(0), tBitMapInfo, 0, &HCC0020以上程序仅仅说明原理，但未必能运行。

Answer 5

下面是一段做亮度直方图的程序，是我以前编写的。我一时也记不得是怎么写的了，你回去自己修修用。或许会受到一些启发。[窗体]Dim tLev(0 To 255, 0 To 255) As LongPrivate Sub Command1_Click()
  Dim tPixs() As tpPixRGB24
  Dim tGMP() As Long
  Dim tGMPMV As Long
  Dim tGMP2D() As Long
  Dim tGMP2DMV As Long
  Dim tI As Long
  Dim tJ As Long
  Dim tC As Long
  Dim tOnTime As Double
  ReDim tGMP(0)
  ReDim tGMP2D(0, 0)
  ReDim tPixs(0)
  tOnTime = Timer
  BitMapBytesGetByFile "setup.bmp", tPixs()
  GraphMapGetByPixs tPixs(), tGMP(), tGMPMV
  
  Text1.Text = tGMP2DMV 'Abs(tOnTime - Timer) 'tGMPMV ' UBound(tPixs)
    
  For tI = 0 To 255
    Picture1.Line (tI, 100)-(tI, 100 - (tGMP(tI) * 100) \ tGMPMV), &HFFFFFF
  Next
  
End SubPrivate Sub Form_Load()
  Picture1.Height = 100
  Picture1.Width = 256
  Picture1.BorderStyle = 0
  Picture2(1).Height = 256
  Picture2(1).Width = 256
  Picture2(1).BorderStyle = 0End SubPrivate Sub Form_Unload(Cancel As Integer)
  End
End Sub[模块]Public Type tpBitMapFileHeader
  bfType As Integer
  bfSize As Long
  bfReserved1 As Integer
  bfReserved2 As Integer
  bfOffBits As Long
End TypePublic Type tpBitMapInfoHeader
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Long
  biYPelsPerMeter As Long
  biClrUsed As Long
  biClrImportant As Long
End TypePublic Type tpRGBQuad
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End TypePublic Type tpPixRGB24
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
End TypePublic Type tpBitMapHeader
  bhFileHeader As tpBitMapFileHeader
  bhInfoHeader As tpBitMapInfoHeader
End TypePublic Type tpLumStatsDate
  lsLumLevels(0 To 255) As Long
  lsLumMaxValue As Long
  lsLumScaling As Long
End TypeFunction BitMapBytesGetByFile(pFileName As String, pOutPixs() As tpPixRGB24) As tpPixRGB24()
  Dim tFileNumber As Integer
  Dim tMapSize As Long
  Dim tBitMapHeader As tpBitMapHeader
  
  tFileNumber = FreeFile
  Open pFileName For Binary As #tFileNumber
    Get #tFileNumber, 1, tBitMapHeader
    tMapSize = tBitMapHeader.bhInfoHeader.biHeight * tBitMapHeader.bhInfoHeader.biWidth
    ReDim pOutPixs(tMapSize)
    Get #tFileNumber, tBitMapHeader.bhFileHeader.bfOffBits + 1, pOutPixs()
  Close #tFileNumber
End Function
Function GraphMap2DRBGetByPixs(pPixs() As tpPixRGB24, pOutMap() As Long, pOutMaxValue As Long)
  Dim tLoopEnd As Long
  Dim tLoopStart As Long
  Dim tColorLevelX As Integer
  Dim tColorLevelY As Integer
  
  tLoopEnd = UBound(pPixs)
  ReDim pOutMap(255, 255) As Long
  pOutMaxValue = 0
  For tLoopStart = 0 To tLoopEnd
    tColorLevelX = CInt(pPixs(tLoopStart).rgbRed)
    tColorLevelY = CInt(pPixs(tLoopStart).rgbBlue)
    pOutMap(tColorLevelX, tColorLevelY) = pOutMap(tColorLevelX, tColorLevelY) + 1
    If pOutMaxValue < pOutMap(tColorLevelX, tColorLevelY) Then pOutMaxValue = pOutMap(tColorLevelX, tColorLevelY)
  Next
End Function
Function GraphMap2DRGGetByPixs(pPixs() As tpPixRGB24, pOutMap() As Long, pOutMaxValue As Long)
  Dim tLoopEnd As Long
  Dim tLoopStart As Long
  Dim tColorLevelX As Integer
  Dim tColorLevelY As Integer
  
  tLoopEnd = UBound(pPixs)
  ReDim pOutMap(255, 255) As Long
  pOutMaxValue = 0
  For tLoopStart = 0 To tLoopEnd
    tColorLevelX = CInt(pPixs(tLoopStart).rgbRed)
    tColorLevelY = CInt(pPixs(tLoopStart).rgbGreen)
    pOutMap(tColorLevelX, tColorLevelY) = pOutMap(tColorLevelX, tColorLevelY) + 1
    If pOutMaxValue < pOutMap(tColorLevelX, tColorLevelY) Then pOutMaxValue = pOutMap(tColorLevelX, tColorLevelY)
  Next
End FunctionFunction GraphMap2DBGGetByPixs(pPixs() As tpPixRGB24, pOutMap() As Long, pOutMaxValue As Long)
  Dim tLoopEnd As Long
  Dim tLoopStart As Long
  Dim tColorLevelX As Integer
  Dim tColorLevelY As Integer
  
  tLoopEnd = UBound(pPixs)
  ReDim pOutMap(255, 255) As Long
  pOutMaxValue = 0
  For tLoopStart = 0 To tLoopEnd
    tColorLevelX = CInt(pPixs(tLoopStart).rgbBlue)
    tColorLevelY = CInt(pPixs(tLoopStart).rgbGreen)
    pOutMap(tColorLevelX, tColorLevelY) = pOutMap(tColorLevelX, tColorLevelY) + 1
    If pOutMaxValue < pOutMap(tColorLevelX, tColorLevelY) Then pOutMaxValue = pOutMap(tColorLevelX, tColorLevelY)
  Next
End FunctionFunction GraphMapGetByPixs(pPixs() As tpPixRGB24, pOutMap() As Long, pOutMaxValue As Long)
  Dim tLoopEnd As Long
  Dim tLoopStart As Long
  Dim tColorLevel As Integer
  tLoopEnd = UBound(pPixs)
  ReDim pOutMap(255) As Long
  pOutMaxValue = 0
  For tLoopStart = 0 To tLoopEnd
    tColorLevel = (CInt(pPixs(tLoopStart).rgbBlue) + CInt(pPixs(tLoopStart).rgbGreen) + CInt(pPixs(tLoopStart).rgbRed)) \ 3
    pOutMap(tColorLevel) = pOutMap(tColorLevel) + 1
    If pOutMaxValue < pOutMap(tColorLevel) Then pOutMaxValue = pOutMap(tColorLevel)
  Next
End FunctionFunction GraphMap2D_RBGetByPixs(pPixs() As tpPixRGB24, pOutMap() As Long, pOutMaxValue As Long)
  Dim tLoopEnd As Long
  Dim tLoopStart As Long
  Dim tColorLevelX As Integer
  Dim tColorLevelY As Integer
  
  tLoopEnd = UBound(pPixs)
  ReDim pOutMap(255, 255) As Long
  pOutMaxValue = 0
  For tLoopStart = 0 To tLoopEnd
    tColorLevelX = CInt(pPixs(tLoopStart).rgbRed)
    tColorLevelY = CInt(pPixs(tLoopStart).rgbBlue)
    pOutMap(tColorLevelX, tColorLevelY) = 255
    If pOutMaxValue < pOutMap(tColorLevelX, tColorLevelY) Then pOutMaxValue = pOutMap(tColorLevelX, tColorLevelY)
  Next
End Function

Answer 6

http://www.dapha.net/down/show.asp?page=3&classid=1&Nclassid=110参考一下