VB求灰度图转二值化,或者有直接二值化的代码

2025-02-06 09:51:51
推荐回答(5个)
回答1:

用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 

代码运行很快,如图所示图片基本可瞬间完成

回答2:

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

回答3:

首先,原程序最好写成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)

回答4:

用 VB 来直接操作 bmp 比较麻烦,如果允许用 Matlab 的话就方便许多。。。

回答5:

转化后你要懂BMP的格式才能转啊