vb DIB 的一个问题

Question

我现在要获得一个图片的像素，在网上找些资料后，写了下面的东西，但是得到的每个像素的值都是0，请大家看看这是为什么啊，谢谢了
Private Type BitMapInfoHeader '文件信息头--BITMAPINFOHEADER
   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 TypePrivate Type RGBQuad
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End TypePrivate Type BitMapInfo
        bmiHeader As BitMapInfoHeader
        bmiColors As RGBQuad
End TypePrivate 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 GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType 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 timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Const DIB_RGB_COLORS        As Long = &H0&
Private Const BI_RGB                As Long = &H0&
Private Const OBJ_BITMAP            As Long = &H7&
Private Const Bits As Long = 24 '颜色深度，这里把所有图像都按照32位来处理
Public Done As Boolean              '用于标记一个过程是否结束
Public TimeGet As Long              '用于记录输入过程处理所花费的时间
Public TimePut As Long              '用于记录输出过程处理所花费的时间
Public ColVal() As Byte                 '用于存放从DIB输入的像素值
Public ColOut() As Byte                 '用于存放向DIB输出的像素值
Public InPutHei As Long                 '用于记录输入图像的高度
Public InPutWid As Long                '用于记录输入图像的宽度
Public bi24BitInfo As BitMapInfo    '定义BMP信息
Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long)
Dim iBitmap As Long
Dim iDC As Long
Dim I As Long
Dim W As Long
Dim H As Long
On Error GoTo ErrLineDone = False
TimeGet = timeGetTime
InPutWid = XEnd - XBegin
InPutHei = YEnd - YBegin
W = InPutWid + 1
H = InPutHei + 1
I = (Bits \ 8) - 1ReDim ColVal(I, InPutWid, InPutHei)With bi24BitInfo.bmiHeader
   .biBitCount = 24
   .biCompression = BI_RGB
   .biPlanes = 1
   .biSize = Len(bi24BitInfo.bmiHeader)
   .biWidth = W
   .biHeight = H
End WithiBitmap = GetCurrentObject(IdSource, OBJ_BITMAP) 'OBJ_BITMAP
GetDIBits IdSource, iBitmap, 0&, bi24BitInfo.bmiHeader.biHeight, VarPtr(ColVal(0, 0, 0)), bi24BitInfo, DIB_RGB_COLORS
DeleteObject iBitmap
Done = True
TimeGet = timeGetTime - TimeGet
Exit Sub
ErrLine:
MsgBox "错误号：" & Err.Number & "：" & Err.Description
End SubPrivate Sub Command1_Click()With Picture1
   .ScaleMode = 3
   .BorderStyle = 0
   
End With
DibGet Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
For W = 0 To 100 Step 1
    For H = 0 To 100 Step 1
    List1.AddItem Str(ColVal(0, W, H)) + "==" + Str(ColVal(1, W, H)) + "==" + Str(ColVal(2, W, H))
    Next H
Next W
麻烦大家看看，谢谢！

Answer 1

Picture1.ScaleMode   =   3 
Picture1.BorderStyle   =   0
这两个属性放到外面去，（可以放在FORM LOAD或者直接在设计界面中设置号属性）DibGet Picture1.hdc, 0, 0, Picture1.ScaleWidth,   Picture1.ScaleHeight 参数改成
DibGet Picture1.hdc, 0, 0, Picture1.ScaleWidth-1,   Picture1.ScaleHeight-1
另外，函数调用也似乎抄错了：
GetDIBits IdSource, iBitmap, 0&, bi24BitInfo.bmiHeader.biHeight, VarPtr(ColVal(0,   0,   0)),   bi24BitInfo, DIB_RGB_COLORS 
改成：
GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&

Answer 2

给你完整点的：
Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long, Optional Enhance As Boolean = False)
Dim iBitmap As Long
Dim iDC As Long
Dim I As Long
Dim L As Long
Dim X As Long
Dim Y As Long
Dim W As Long
Dim H As Long
Dim Total As Long
Dim AlignedW As Long 'in bytes
'On Error GoTo ErrLine
Done = False
TimeProcess = timeGetTime
InPutWid = XEnd - XBegin
InPutHei = YEnd - YBegin
OutPutHei = InPutHei
OutPutWid = InPutWid
W = InPutWid + 1
H = InPutHei + 1
'AlignedW = ((W * 3& + 3&) And (Not 3&))
I = (Bits \ 8) - 1
ReDim ColVal(I, InPutWid, InPutHei)
With bi24BitInfo.bmiHeader
   .biBitCount = Bits
   .biCompression = 0&
   .biPlanes = 1
   .biSize = Len(bi24BitInfo.bmiHeader)
   .biWidth = W
   .biHeight = H
End With
iBitmap = GetCurrentObject(IdSource, 7&)
GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&
DeleteObject iBitmap
CopyData 1, 3, InPutWid, InPutHei
CopyData 1, 2, InPutWid, InPutHei
CanZoom = True
CanPut = True
Done = True
TimeProcess = timeGetTime - TimeProcess
Exit Sub
ErrLine:
MsgBox "错误号：" & Err.Number & "  " & Err.Description
End Sub调用：
DibGet Picture1.hdc, 0, 0, Picture1.Width - 1, Picture1.Height - 1 

Answer 3

CopyData 1, 3, InPutWid, InPutHei 
CopyData 1, 2, InPutWid, InPutHei 
 楼上的好像却少这两个函数代码啊。
另外，本来一直在用上面的函数处理图形象素的，结果今天想写个另外的抓图分析程序，发现运行到 GetDIBits 后就内存溢出，以前的另一个图形分析程序也是用的这个代码，长时间运行也没问题啊，后来只好逐个检查API，最后发现确实是由于 GetDIBits 函数导致的问题，仔细检查后才发现原文章【  VB图像处理，（一）像素的获取和输出     选择自 WallesCai 的 Blog 】中有一句代码：
Private Const Bits As Long = 32  '颜色深度，这里把所有图像都按照32位来处理
当初我理解的是，目前的BMP文件都是24bit的存储方式，所以我当初顺手改了这句 改成了：Bits = 24，我以为这样更符合实际情况，在上一个程序中，这样运行了很久也没见什么问题，而到了目前在写的这个程序中当：.bmInfo.bmiHeader.biWidth*3 不是4的整数倍时，GetDIBits 就会报内存溢出错误，检查后发现我报错时抓取的图片为 biWidth＝381 的！！！难怪会出错

Answer 4

Bits 改成 32 后程序顺利运行。
顺便提在读取BMP文件的时候不能用以上函数中的定义方式：
ReDim ColVal(I, InPutWid, InPutHei) 
来定义  bmpfile.bmDate()，因为目前接触到的BMP文件基本都是24bit的，必须计算每一行象素的实际占用字节数，并且，每一扫描行的字节数必需是4的整倍数，也就是DWORD对齐的，计算方式如：
BMLineBytes = ((.bmInfo.bmiHeader.biWidth * .bmInfo.bmiHeader.biBitCount + 31) And &HFFFFFFE0) \ 8 '每一扫描行的字节数必需是4的整倍数，也就是DWORD对齐的
定义方式如：ReDim bmpfile.bmDate(BMLineBytes - 1, .bmInfo.bmiHeader.biHeight - 1) '(x,y)(列，行)
用ReDim ColVal(I, InPutWid, InPutHei)这种方式定义bmpfile.bmDate()的话，如果你的：.bmInfo.bmiHeader.biWidth*3 是4的整数倍，那么基本正常，不会有什么影响但是如果不是4的整数倍的话，读取得字节就会错位啦！！！虽然ReDim ColVal(I, InPutWid, InPutHei)这种方式更容易编写代码，但我们可以用ReDim bmpfile.bmDate(BMLineBytes - 1, .bmInfo.bmiHeader.biHeight - 1)这种方式定义后读取完文件再进行转换为ReDim ColVal(I, InPutWid, InPutHei)这种格式就行。

Answer 5

由此可见，iBitmap = GetCurrentObject(IdSource, 7&) 这句产生的 BMP象素信息是以32Bit方式存放在内存的，跟踪查看ColVal的值也可以看到这一点，即：
'说明彩色表RGBQUAD结构的阵列，其中包含索引图像的真实RGB值。
Public Type rgbq    'RGBQUAD, bmiColors[1];
    rgbBlue As Byte  ' 指定蓝色强度
    rgbGreen As Byte ' 指定绿色强度
    rgbRed As Byte ' 指定红色强度
    rgbReserved As Byte ' 保留，设置为0
End Type
只是对于bmpfile，目前的Alpha通道的值是0。

Answer 6

看下这个吧,完整的DIB输入输出,和二次线性插值代码:
http://download.csdn.net/source/455619