VB6二值化图像的方法

方法：用windows API

下面是快速灰度化源代码，网上找的，亲测，管用！

 

Option Explicit

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要快出一个数量级
    Dim lrtn As Long
    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
    
    '将黑白图显示到picture3中
    Picture2.Picture = Picture2.Image '如果picture2的picture属性为空，需要在setDIBits之前将其picture属性设置一下，否则无法显示出图形
    SetDIBits Picture2.hdc, Picture2.Picture.Handle, 0&, iHeight, bitsBW(0, 0, 0), bi24BitInfo, 0&
    Picture2.Picture = Picture2.Image
 
End Sub
 
Private Sub Form_Load()
    Picture1.Picture = LoadPicture(App.Path & "\66668.JPG")
    Picture2.Width = Picture1.Width
    Picture2.Height = Picture1.Height
End Sub