Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hbitmap As Long, _    ByVal dwCount As Long, _    lpBits As Any) As LongPrivate Declare Function SetBitmapBits Lib "gdi32" (ByVal hbitmap As Long, _    ByVal dwCount As Long, _    lpBits As Any) As LongPrivate 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 LongPrivate 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 LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _    ByVal hObject As Long) As LongPrivate Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, _    ByVal lpDeviceName As String, _    ByVal lpOutput As String, _    lpInitData As Long) As LongPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Type 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 LongEnd TypePrivate Type RGBQuad    rgbBlue As Byte    rgbGreen As Byte    rgbRed As Byte    ‘‘rgbReserved As ByteEnd TypePrivate Type BitMapInfo    bmiHeader As BitMapInfoHeader    bmiColors As RGBQuadEnd TypePrivate Sub Command1_Click()    Dim pic As StdPicture    Set pic = LoadPicture("D:\My Documents\Downloads\119562132_21n.jpg")    Dim w As Long    Dim h As Long    With pic        w = ScaleX(.Width, vbHimetric, vbPixels)        h = ScaleY(.Height, vbHimetric, vbPixels)    End With        Dim hdc As Long    hdc = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)    Call SelectObject(hdc, pic.Handle)        Dim bits() As Byte    ReDim bits(3, w, h) As Byte    Dim bi As BitMapInfo    With bi.bmiHeader        .biBitCount = 32&        .biCompression = 0&        .biPlanes = 1&        .biSize = Len(bi.bmiHeader)        .biWidth = w        .biHeight = h    End With    Call GetDIBits(hdc, pic.Handle, 0, h, bits(0, 0, 0), bi, 0&)        ‘灰度化    Dim x As Long    Dim y As Long    Dim g As Byte    For x = 0 To w        For y = 0 To h            ‘灰度公式：Gray=R×0.299+G×0.587+B×0.114            ‘貌似有更好的方案：g=(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)            ‘不过，肉眼看不出差别来 (>_<)            g = bits(0, x, y) * 0.114 + bits(1, x, y) * 0.587 + bits(2, x, y) * 0.299            bits(0, x, y) = g            bits(1, x, y) = g            bits(2, x, y) = g        Next    Next            Picture1.Picture = Picture1.Image    Call SetDIBits(Picture1.hdc, Picture1.Picture.Handle, 0&, h, bits(0, 0, 0), bi, 0&)    Picture1.Picture = Picture1.Image        Dim threshold As Byte    threshold = GetThreshold(bits, w, h)        ‘二值化，阈值通过[最大类间方差法(Otsu)]取得    For x = 0 To w        For y = 0 To h            If bits(0, x, y) > threshold Then                bits(0, x, y) = 255                bits(1, x, y) = 255                bits(2, x, y) = 255            Else                bits(0, x, y) = 0                bits(1, x, y) = 0                bits(2, x, y) = 0            End If        Next    Next    Picture2.Picture = Picture2.Image    Call SetDIBits(Picture2.hdc, Picture2.Picture.Handle, 0&, h, bits(0, 0, 0), bi, 0&)    Picture2.Picture = Picture2.Image        Erase bits    Call DeleteDC(hdc)    Set pic = NothingEnd SubPrivate Function GetThreshold(ByRef Pixels() As Byte, _    ByVal Width As Long, _    ByVal Height As Long) As Byte    ‘最大类间方差法(Otsu)    ‘这个函数是我根据百度文库一个文档里提供的C代码翻译过来的    ‘@http://wenku.baidu.com/link?url=wVl9A7eZiRddxpaCPPLcAIb-VDlyrV__-Zfw6j6o50FEUochgV9G_zRVsMHVDxN2ilOUXiRbSSM-as_ELJpjxnWEvERlABlvVoVK6-FDQpW    Dim hist(255) As Long    Dim x As Long    Dim y As Long    Dim i As Long        For i = 0 To 255: hist(i) = 0: Next    For y = 0 To Height        For x = 0 To Width            hist(Pixels(0, x, y)) = hist(Pixels(0, x, y)) + 1        Next    Next        Dim p(255) As Double    Dim ut As Double    Dim uk As Double    Dim sigma As Double    Dim mk As Double    Dim maxk As Byte    Dim maxs As Double    Dim total As Long    Dim EPSTLON As Double    EPSILON = 0.000001 ‘10 ^ -6            total = Width * Height    ut = 0    For i = 0 To 255        p(i) = hist(i) / total        ut = ut + i * hist(i)    Next    ut = ut / total    wk = 0    uk = 0    maxs = 0    For i = 0 To 255        uk = uk + i * p(i)        wk = wk + p(i)        If wk <= EPSTLON Or wk >= (1# - EPSTLON) Then        Else            sigma = (ut * wk - uk)            sigma = (sigma * sigma) / (wk * (1# - wk))            If sigma > maxs Then                maxs = sigma                maxk = i            End If        End If    Next    GetThreshold = maxkEnd Function