Question

vb编程 获取图片全面像素颜色信息

图片宽138像素 高91像素

Answer 1

'使用DIB获取图象，根据他人代码修改，ImgData()中保存的是颜色
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 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 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 Const DIB_RGB_COLORS = 0 ' color table in RGBs

Private Sub Command1_Click()
Picture1.Line (0, 0)-(Picture1.Width, Picture1.Height), vbRed
Dim BITMAP As BITMAPINFO
Dim ImgData() As Byte'图象颜色
Dim lIndex As Long
Dim i As Long, j As Long, n As Long, t As Long, m
With BITMAP
.bmiHeader.biSize = 40 'BMP3.0版本
End With

If GetDIBits(Picture1.hdc, Picture1.Picture.Handle, 0, 0, 0, BITMAP, DIB_RGB_COLORS) <> 0 Then '获取图像位图数据大小
ReDim ImgData(BITMAP.bmiHeader.biSizeImage - 1) '重定义数组准备接收位图数据
If GetDIBits(Picture1.hdc, Picture1.Picture.Handle, 0, BITMAP.bmiHeader.biHeight, ImgData(0), BITMAP, DIB_RGB_COLORS) <> 0 Then '正式获取位图数据并将数据存入定义的数组中
'注意数组中颜色分量的存储顺序为：B、G、R(并不是R、G、B），如果你需要对图像进行处理只需改变数组中的数据即可完成
'我试验的位图62x62像素，24色图,3字节存储，每行188字节(一个扫描行的长度必须是4的倍数)，这样扫描后共11656字节
'****************　下面这段程序是将图像亮度变暗(只作为演示，其它效果你可以自己动手做) ***********************
'注意：第一条扫描线的位置是从左下角开始
'BITMAP.bmiHeader.biHeight 位图的高度，单位是像素
'BITMAP.bmiHeader.biWidth 位图的宽度，单位是像素
'BITMAP.bmiHeader.biBitCount 图像的颜色位数
'每个像素点的颜色是：(从下往上)
t = ((BITMAP.bmiHeader.biWidth * 3 + 3) \ 4) * 4 '每行的字节数

For i = 1 To BITMAP.bmiHeader.biHeight
DoEvents
m = t * (i - 1)
For j = 1 To BITMAP.bmiHeader.biWidth
n = m + (j - 1) * 3
Debug.Print "(" & i & "," & j & ")" & n & "： R=" & ImgData(n) & " G=" & ImgData(n + 1) & " B=" & ImgData(n + 2)
Next
Next
For lIndex = 0 To BITMAP.bmiHeader.biSizeImage - 1
DoEvents
If ImgData(lIndex) - 100 < 0 Then
ImgData(lIndex) = 0
Else
ImgData(lIndex) = ImgData(lIndex) - 100
End If
Next
'*********************************************************************
SetDIBits Picture2.hdc, Picture2.Image.Handle, 0, BITMAP.bmiHeader.biHeight - 1, ImgData(0), BITMAP, DIB_RGB_COLORS '将位图数据写入PICTURE2中
End If
End If
End Sub

Answer 2

Dim x As Single, y As Single
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3 '坐标系统设为像素，这个很关键
Picture1.Picture = LoadPicture("e:\tmp\cd1.gif") '图片文件名自己改
For y = 0 To Picture1.ScaleHeight - 1
For x = 0 To Picture1.ScaleWidth - 1
Debug.Print Picture1.Point(x, y); '像素值输出到立即窗口
Next
Debug.Print
Next