(高分) 如何把BMP文件的图像数据读出到一个按图像象素为大小的二维数组中？

Question

如题，如何从硬盘读取一BMP文件，并把图像的颜色数据按 图像的象素值为大小的二维数组中？比方：图像为（X=200px ,Y=100px）,
      把图像的各个象素的颜色值读出到数组 mapData(X,Y)中，该如何写？各路大侠帮手啊！
分不够再加！

Answer 1

这种方法简单，但速度慢Private Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
dim rr() as long , bb() as long , gg() As Long
ReDim rr(pic1.ScaleWidth, pic1.ScaleHeight)
ReDim gg(pic1.ScaleWidth, pic1.ScaleHeight)
ReDim bb(pic1.ScaleWidth, pic1.ScaleHeight)
pic1.ScaleMode = 3
For i = 0 To pic1.ScaleWidth
For j = 0 To pic1.ScaleHeight
c = GetPixel(pic1.hdc, i, j)
rr(i, j) = Abs(c And &HFF)
gg(i, j) = Abs(c And 65280) / 256
bb(i, j) = Abs(c And &HFF0000) / 65536
Next j
next i

Answer 2

参考以下这个，应该可以http://www.aivisoft.net/Source/index.htm
SpyScreen.zip——简单的屏幕传输代码。
本代码演示了如何在网络上不保存文件到硬盘而传送图像。
代码思路是，通过TCP协议握手，将图像保存到一个数组并按照R、G、B三个通道分层，用zlib库压缩到ZipStream数组，对此数组进行Base64编码方便网络传输，然后通过TCP协议实现了网络图像传送，传送到对方之后进行Base64解码和zlib的解压，实现了图像的复原。
主要技术点：
1.自定义协议握手
2.将图像保存到数组(cDIB.MapArray/UnMapArray)
3.利用Zip编码进行图像压缩(cDIB.SaveStream/LoadStream)
4.利用Base64编码实现网络传送(FrmMain.InitBase64/CompBase64/UnCompBase64)

Answer 3

用dib处理
模块中Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public WorkFilterG As Boolean
Public Const SRCCOPY = &HCC0020
Public Enum iFilterG '自定义的枚举常量
igray = 1
inegative = 2
End Enum
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0&
Private Const LR_LOADFROMFILE = &H10
Private Const IMAGE_BITMAP = 0&Private iDATA() As Byte            '保留位图信息
Private bDATA() As Byte            '备份位图信息
Private cdata() As Byte
Private edata() As Byte
Private PicInfo As BITMAP         '定义位图信息结构
Private DIBInfo As BITMAPINFO     'Device Ind. Bitmap info structure
Private mProgress As Long         '% 操作进程
Private Speed(0 To 765) As Long   '处理参数
Private dred(0 To 255), dgreen(0 To 255), dblue(0 To 255), dgray(0 To 255) As Long
Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End TypeType BITMAPINFOHEADER              '40 bytes
   biSize As Long                  'BITMAPINFOHEADER结构的大小
   biWidth As Long
   biHeight As Long
   biPlanes As Integer             '设备的为平面数，现在都是1
   biBitCount As Integer           '图像的颜色位图
   biCompression As Long           '压缩方式
   biSizeImage As Long             '实际的位图数据所占字节
   biXPelsPerMeter As Long         '目标设备的水平分辨率
   biYPelsPerMeter As Long         '目标设备的垂直分辨率
   biClrUsed As Long               '使用的颜色数
   biClrImportant As Long          '重要的颜色数。如果该项为0，表示所有颜色都是重要的
End Type
  
Type RGBQUAD                        ' 只有bibitcount为1，2，4时才有调色板
   rgbBlue As Byte                  '蓝色分量
   rgbGreen As Byte                 '绿色分量
   rgbRed As Byte                   '红色分量
   rgbReserved As Byte              '保留值
End TypeType BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End TypePublic Sub FilterG(ByVal Filtro As iFilterG, ByVal pic As Long, ByVal factor As Long, ByRef pprogress As Long)
  Dim hdcNew As Long
  Dim oldhand As Long
  Dim ret As Long
  Dim BytesPerScanLine As Long    '一个扫描行的长度
  Dim PadBytesPerScanLine As Long
    
  If WorkFilterG = True Then Exit Sub
  WorkFilterG = True
  On Error GoTo FilterError:
'get data buffer
  Call GetObject(pic, Len(PicInfo), PicInfo)         '取得对指定对象进行说明的一个结构，hobject为位图，刷子等的句柄，
                                                      'count欲取回的字节数。通常是由lpObject定义的那个结构的长度
  hdcNew = CreateCompatibleDC(0&)                    '创建一个与屏幕兼容的设备场景
  oldhand = SelectObject(hdcNew, pic)
  With DIBInfo.bmiHeader
    .biSize = 40                                       'bmp3.0
    .biWidth = PicInfo.bmWidth
    .biHeight = -PicInfo.bmHeight     '从下往上扫描
    .biPlanes = 1
    .biBitCount = 32                 '32位位图，默认情况下Windows不会处理最高8位，可以将它作为自己的Alpha通道
    .biCompression = BI_RGB          '无压缩
    BytesPerScanLine = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)  '一个扫描行的长度，是4的倍数。
    PadBytesPerScanLine = _
    BytesPerScanLine - (((.biWidth * .biBitCount) + 7) \ 8)
    .biSizeImage = BytesPerScanLine * Abs(.biHeight)
  End With  'redimension  (BGR+pad,x,y)
  ReDim iDATA(1 To 4, 1 To PicInfo.bmWidth, 1 To PicInfo.bmHeight) As Byte
  ReDim bDATA(1 To 4, 1 To PicInfo.bmWidth, 1 To PicInfo.bmHeight) As Byte  'get bytes
  ret = GetDIBits(hdcNew, pic, 0, PicInfo.bmHeight, iDATA(1, 1, 1), DIBInfo, DIB_RGB_COLORS)
               '将来自一幅位图的二进制位复制到一幅与设备无关的位图里
              ' 该函数利用申请到的内存，由GDI位图得到DIB位图数据，可以对DIB的格式进行控制，通过该函数，
                '可以制定颜色的位数，而且可以指定是否进行压缩。如果采用了压缩方式，则必须调用该函数两次，
                '一次为了得到所需内存，另外一次为了得到位图数据
                '定义了与设备有关位图hBitmap的配置信息的一个设备场景的句柄
                'hbmp 源位图的句柄
                'uStartScan为欲复制到dib中的第一条扫描线的位置
                'cScanLines欲复制的扫描先的数量
                'ipvbits 指向一个缓冲区的指针
                '指向BITMAPINF，对DIB的格式及颜色进行说明的一个结构。
                '颜色表包含了RGB颜色
                'idata(1,x,y)表示b的颜色
                
  ret = GetDIBits(hdcNew, pic, 0, PicInfo.bmHeight, bDATA(1, 1, 1), DIBInfo, DIB_RGB_COLORS)Select Case Filtro
Case igray:        Call gray(pprogress)
Case inegative:    Call negative(pprogress)
End Select         '将数组传递给设备
  ret = SetDIBits(hdcNew, pic, 0, PicInfo.bmHeight, iDATA(1, 1, 1), DIBInfo, DIB_RGB_COLORS)
               '将来自与设备无关位图的二进制位复制到一幅与设备有关的位图里  
  
  SelectObject hdcNew, oldhand
  DeleteDC hdcNew  ReDim iDATA(1 To 4, 1 To 2, 1 To 2) As Byte
  ReDim bDATA(1 To 4, 1 To 2, 1 To 2) As Byte
  WorkFilterG = False
  Exit Sub
FilterError:
  MsgBox "Filter Error"
  WorkFilterG = False
End Sub
Private Sub gray(ByRef pprogress As Long)
  Dim x As Long, y As Long
  mProgress = 0
  For y = 1 To PicInfo.bmHeight
    For x = 1 To PicInfo.bmWidth
      B = iDATA(1, x, y)
      G = iDATA(2, x, y)
      R = iDATA(3, x, y)      
      rgb1 = (R + G + B) / 3
      iDATA(1, x, y) = rgb1
      iDATA(2, x, y) = rgb1
      iDATA(3, x, y) = rgb1
     Next x
    mProgress = (y * 100) \ PicInfo.bmHeight
    pprogress = mProgress
    DoEvents
  Next y
  pprogress = 100
  DoEvents
End Sub
Private Sub negative(ByRef pprogress As Long)
  Dim x As Long, y As Long
  mProgress = 0
  For y = 1 To PicInfo.bmHeight
    For x = 1 To PicInfo.bmWidth
       iDATA(1, x, y) = 255 - iDATA(1, x, y)
       iDATA(2, x, y) = 255 - iDATA(2, x, y)
       iDATA(3, x, y) = 255 - iDATA(3, x, y)
    Next x
    mProgress = (y * 100) \ PicInfo.bmHeight
    pprogress = mProgress
    DoEvents
  Next y
  pprogress = 100
  DoEvents
End Sub窗体中Dim mProgress As Long
Private Sub gray_Click()
Screen.MousePointer = 11
Timer1.Enabled = True
  Call BitBlt(Picture2.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, SRCCOPY)
  Call FilterG(igray, Picture1.Image, 0, mProgress)
  Picture1.Refresh
  Screen.MousePointer = 1End SubPrivate Sub negative_Click()
On Error Resume Next
Screen.MousePointer = 11
Timer1.Enabled = True
  Call BitBlt(Picture2.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, SRCCOPY)
  Call FilterG(inegative, Picture1.Image, 0, mProgress)
  Picture1.Refresh
  Screen.MousePointer = 1
End Sub

Answer 4

还有一中方法
Option ExplicitPrivate Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As LongConst IMAGE_BITMAP As Long = 0
Const LR_LOADFROMFILE As Long = &H10
Const LR_CREATEDIBSECTION As Long = &H2000
Const LR_DEFAULTCOLOR As Long = &H0
Const LR_COLOR As Long = &H2Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As LongPrivate Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End TypeDim BitmapImage As Long
Dim bm As BITMAP
Dim hbm As LongDim OriginalBits() As ByteDim BitmapWidth As Long
Dim BitmapHeight As Long
Public Function GenerateDC(FileName As String, ByRef BitmapHandle As Long) As Long
Dim DC As Long
Dim hBitmap As Long'创建一个与特定设备场景一致的内存设备场景
DC = CreateCompatibleDC(0)If DC < 1 Then
    GenerateDC = 0
    '引发错误
    Exit Function
End If'载入图片
hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)If hBitmap = 0 Then '载入图片出错
    DeleteDC DC
    GenerateDC = 0
    Err.Raise vbObjectError + 2
    Exit Function
End If
'把位图选入设备场景
SelectObject DC, hBitmap
'返回到设备场景
BitmapHandle = hBitmap
GenerateDC = DC
End Function
'删除一般设备场景，释放相关窗口资源
Private Function DeleteGeneratedDC(DC As Long) As LongIf DC > 0 Then
    DeleteGeneratedDC = DeleteDC(DC)
Else
    DeleteGeneratedDC = 0
End IfEnd FunctionPrivate Sub Form_Load()'载入图片
BitmapImage = GenerateDC("D:\VB archives\光盘转栽\图象处理\bitmap.bmp", hbm)'获取位图结构体
GetObjectAPI hbm, Len(bm), bm'重新初始化字节数组
ReDim OriginalBits(1 To bm.bmWidthBytes, 1 To bm.bmHeight)BitmapWidth = bm.bmWidth
BitmapHeight = bm.bmHeight'将来自位图的二进制位复制到一个缓冲区
GetBitmapBits hbm, bm.bmWidthBytes * bm.bmHeight, OriginalBits(1, 1)
   
'绘制位图
BitBlt Me.hdc, 0, 0, BitmapWidth, BitmapWidth, BitmapImage, 0, 0, vbSrcCopy
End Sub
Private Sub Form_Unload(Cancel As Integer)
  DeleteGeneratedDC BitmapImage
  DeleteObject hbm
End SubPrivate Sub cmdblue_Click()
Dim BitmapWidthBytes As Long
Dim ByteArray() As Byte
Dim I As Long, J As LongReDim ByteArray(1 To bm.bmWidthBytes, 1 To bm.bmHeight)For I = 1 To bm.bmWidthBytes Step 3
    For J = 1 To bm.bmHeight
        
        ByteArray(I, J) = OriginalBits(I, J)
        ByteArray(I + 1, J) = 0
        ByteArray(I + 2, J) = 0
    Next J
Next ISetBitmapBits hbm, bm.bmWidthBytes * bm.bmHeight, ByteArray(1, 1)BitBlt Me.hdc, 0, 0, BitmapWidth, BitmapHeight, BitmapImage, 0, 0, vbSrcCopy
Me.Refresh
End Sub

Answer 5

先谢谢楼上诸位的回答，再说一下我的目的，不要使用picturebox,直接从硬盘中读取位图，
把位图的颜色数据按图片的像素大小为数组保存，如20*20px的位图，保存到一个二维数组中Data(20,20)。哪个大侠能给出代码，我对图像处理是无知啊。

Answer 6

颜色代码是什么值无所谓，不用处理成RBG值。

Answer 7

//再说一下我的目的，不要使用picturebox,直接从硬盘中读取位图，
把位图的颜色数据按图片的像素大小为数组保存，如20*20px的位图，保存到一个二维数组中Data(20,20)。看下面的代码：
Option ExplicitPrivate Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End TypePrivate Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
    (ByVal hInst As Long, ByVal lpsz As String, _
    ByVal iType As Long, _
    ByVal cx As Long, ByVal cy As Long, _
    ByVal fOptions As Long) As LongPrivate Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As LongPrivate Sub Command1_Click()
    Dim hBitmap As Long
    hBitmap = LoadImage(App.hInstance, "e:\mc\test.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
    If hBitmap = 0 Then
        MsgBox "载入位图时发生错误"
        Exit Sub
    End If
    Dim pixels() As Long
    Dim bmp As BITMAP
    GetObjectAPI hBitmap, Len(bmp), bmp
    Dim w As Long
    Dim h As Long
    w = bmp.bmWidth
    h = bmp.bmHeight
    Debug.Print "位图大小为" + CStr(w) + "*" + CStr(h) + "像素"
    ReDim pixels(1 To w, 1 To h)
    GetBitmapBits hBitmap, w * h, pixels(1, 1)
    Debug.Print "读取图象数据完毕"
    
End Sub

Answer 8

Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs
Private Type BITMAPINFOHEADER '40 bytes
        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 Type
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice 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 Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Dim iBitmap As Long, iDC As Long
Private Sub Form_Paint()
    '-> Compile this code for better performance
    Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = 100
        .biHeight = 100
    End With
    ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
    iDC = CreateCompatibleDC(0)
    iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
    SelectObject iDC, iBitmap
    BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, GetDC(0), 0, 0, vbSrcCopy
    GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    For Cnt = LBound(bBytes) To UBound(bBytes)
        If bBytes(Cnt) < 50 Then
            bBytes(Cnt) = 0
        Else
            bBytes(Cnt) = bBytes(Cnt) - 50
        End If
    Next Cnt
    SetDIBitsToDevice Me.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    DeleteDC iDC
    DeleteObject iBitmap
End Sub

Answer 9

//LGYAN(紫衣随想) 
我是想读到二维数据撒！:(

Answer 10

//rainstormmaster(暴风雨 v2.0)运行了一下你的代码，得到了数据
不过看不懂数组里的颜色值哦，是以什么形式存放的啊！//＝＝＝＝＝＝＝＝＝＝
我自己昨天写了一个代码，是通过open file 来读的，读出来后直接以10进制保存的RGB值。
不过我觉得效率太低了。
你这个代码数组是以什么形式保存的值啊？
解决马上结分！

Answer 11

//rainstormmaster(暴风雨 v2.0)数组有问题，
我逐行打印出一个40*10的数组，后7行竟然全部为 0 
WHY？？？？肯定不是像素的颜色值！！

Answer 12

我也发现有问题了，问题主要在于没有根据图象的颜色位数进行处理，你自己处理一下
另外，这有一篇文章你可以看看：
http://www.rookscape.com/vbgaming/tutAY.php