用point 方法太慢了，还是用api的getDIBits和setDIBits吧，彩图转灰度图的代码如下：
Private 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 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 ''文件信息头——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 Sub Command1_Click()
Dim ix As Integer
Dim iy As Integer
Dim iWidth As Integer '以像素为单位的图形宽度
Dim iHeight As Integer '以像素为单位的图形高度
Dim bytGray As Byte
Dim bytThreshold As Byte
Dim bits() As Byte '三维数组，用于获取原彩色图像中各像素的RGB数值以及存放转化后的灰度值
Dim bitsBW() As Byte '三维数组，用于存放转化为黑白图后各像素的值
'获取图形的宽度和高度
iWidth = Picture1.ScaleWidth / Screen.TwipsPerPixelX
iHeight = Picture1.ScaleHeight / Screen.TwipsPerPixelY
Picture1.Picture = Picture1.Image
'创建并初始化一个bitMapInfo自定义类型
Dim bi24BitInfo As BitMapInfo
With bi24BitInfo.bmiHeader
.biBitCount = 32
.biCompression = 0&
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = iWidth
.biHeight = Picture1.ScaleHeight / Screen.TwipsPerPixelY
End With
'重新定义数组大小
ReDim bits(3, 0 To iWidth, 0 To iHeight) As Byte
ReDim bitsBW(3, 0 To iWidth, 0 To iHeight) As Byte
'使用GetDIBits方法一次性获取picture1中各点的rgb值，比point方法或getPixel函数逐像素获取像素rgb要快出一个数量级
lrtn = GetDIBits(Picture1.hdc, Picture1.Picture.Handle, 0&, iHeight, bits(0, 0, 0), bi24BitInfo, 0&)
'数组的三个维度分别代表像素的RGB分量、以图形左下角为原点的X和Y坐标。
'具体说来，这时bits(0,2,3)代表从图形左下角数起横向第2个纵向第3个像素的Blue值，而bits(1,2,3)和bits(2,2,3)分别的Green值和Red值.
bytThreshold = 128 '这里定义转换为黑白图像时的阈值为128，即灰色亮度大于128的像素转为白色，小于128的像素转为黑的，此值可根据需要修改为0-255之前任意数值
For ix = 0 To iWidth
For iy = 0 To iHeight
'***********RGB转为灰度的算法有多种，这里给出常见的两种*******
'bytGray = bits(0, ix, iy) * 0.11 + bits(1, ix, iy) * 0.59 + bits(2, ix, iy) * 0.3 '这是传统的根据三原色亮度加权得到灰阶的算法
bytGray = (bits(0, ix, iy) ^ 2.2 * 0.0722 + bits(1, ix, iy) ^ 2.2 * 0.7152 + bits(2, ix, iy) ^ 2.2 * 0.2126) ^ (1 / 2.2) '这是简化 sRGB IEC61966-2.1 [gamma=2.20]，有点类似于photoshop中所用的算法
bits(0, ix, iy) = bytGray
bits(1, ix, iy) = bytGray
bits(2, ix, iy) = bytGray
'*********转为黑白图像********
If bits(0, ix, iy) < bytThreshold Then
bitsBW(0, ix, iy) = 0
bitsBW(1, ix, iy) = 0
bitsBW(2, ix, iy) = 0
Else
bitsBW(0, ix, iy) = 255
bitsBW(1, ix, iy) = 255
bitsBW(2, ix, iy) = 255
End If
Next
Next
'将灰度图显示到picture2中
Picture2.Picture = Picture2.Image '如果picture2的picture属性为空，需要在setDIBits之前将其picture属性设置一下，否则无法显示出图形
SetDIBits Picture2.hdc, Picture2.Picture.Handle, 0&, iHeight, bits(0, 0, 0), bi24BitInfo, 0&
Picture2.Picture = Picture2.Image
'将黑白图显示到picture3中
Picture3.Picture = Picture3.Image
SetDIBits Picture3.hdc, Picture3.Picture.Handle, 0&, iHeight, bitsBW(0, 0, 0), bi24BitInfo, 0&
Picture3.Picture = Picture3.Image
End Sub
代码运行很快，如图所示图片基本可瞬间完成
Option Explicit
Dim R As Byte
Dim G As Byte
Dim B As Byte
Dim aaa As Long
Dim bbb As Byte
Dim i As Integer
Dim j As Integer
Private Sub Command1_Click()
For i = 1 To Picture1.ScaleHeight Step 15
For j = 1 To Picture1.ScaleWidth Step 15
aaa = Picture1.Point(j, i)
R = (aaa Mod 256) '取得红色值
G = (aaa Mod 65536) \ 256 '取得绿色值
B = (aaa Mod 16777216) \ 65536 '取得蓝色值
bbb = R / 3 + G / 3 + B / 3 '取得灰度值
If bbb >= 171 Then '这里bbb可作适当改变以获得最佳2值化效果
Picture2.PSet (j, i), RGB(255, 255, 255)
Else
Picture2.PSet (j, i), RGB(0, 0, 0)
End If
Next j
Next i
End Sub
首先，原程序最好写成bbb = ( R + G + B ) / 3，否则会有误差。
其次，如果想转二值，只需把
Picture2.PSet (j, i), RGB(bbb, bbb, bbb)
改成
If bbb>127 Then bbb=255 Else bbb=0
Picture2.PSet (j, i), RGB(bbb, bbb, bbb)
用 VB 来直接操作 bmp 比较麻烦，如果允许用 Matlab 的话就方便许多。。。
转化后你要懂BMP的格式才能转啊
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024