vb DIB 的一个问题
我现在要获得一个图片的像素，在网上找些资料后，写了下面的东西，但是得到的每个像素的值都是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 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 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 ErrLine
Done = False
TimeGet = timeGetTime
InPutWid = XEnd - XBegin
InPutHei = YEnd - YBegin
W = InPutWid + 1
H = InPutHei + 1
I = (Bits \ 8) - 1
ReDim ColVal(I, InPutWid, InPutHei)
With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = W
.biHeight = H
End With
iBitmap = 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 Sub
Private 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
麻烦大家看看，谢谢！
[解决办法]
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&
[解决办法]
给你完整点的：
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
