VB6灰度化图片的方法

应用场景

自定义的button控件，其视觉效果是绘图实现的，其中涉及贴图、绘图、画文本，一幅图绘制完成后，如果该button被设置为Enabled=False，则需要对图进行灰度化处理。

方法1：再造各像素点

对图像中的每个像素点进行重新计算一个新值，构成一幅灰度化的图像。网上烂大街的方法就是它。

优点：简单、直接

缺点：低效，图像尺寸稍微大一点的话，慢得无法忍受，体验极差

Private Sub Command1_Click()
    Dim i As Long, j As Long, R As Integer, G As Integer, B As Integer, newColor As Long
    For i = 0 To Picture1.ScaleWidth - 1
        For j = 0 To Picture1.ScaleHeight - 1
            GetRGBColors Picture1.Point(i, j), R, G, B
            newColor = (3 * R + 6 * G + B) / 10
            Picture1.PSet (i, j), RGB(newColor, newColor, newColor)
        Next
    Next
End Sub

'根据颜色的Long值获取颜色的16进制RGB值
Private Function GetRGBColors(ByVal Color As Long, R As Integer, G As Integer, B As Integer)
    Dim sHexColor As String
    If Color = -1 Then
        R = 0
        G = 0
        B = 0
    Else
        sHexColor = String(6 - Len(Hex(Color)), "0") & Hex(Color)
        R = "&H" & Mid(sHexColor, 5, 2)
        G = "&H" & Mid(sHexColor, 3, 2)
        B = "&H" & Mid(sHexColor, 1, 2)
    End If
End Function

方法2：用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
    
    '将灰度图显示到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
End Sub

Private Sub Form_Load()
    Picture1.Picture = LoadPicture(App.Path & "\66668.JPG")
    Picture2.Width = Picture1.Width
    Picture2.Height = Picture1.Height
End Sub