老代码备忘，我对图像处理不是太懂。
注：部分代码引援自网上，话说我到底自己写过什么代码。。。
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 Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, _
ByVal lpDeviceName As String, _
ByVal lpOutput As String, _
lpInitData As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private 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 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 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, &)
Call SelectObject(hdc, pic.Handle) Dim bits() As Byte
ReDim bits(, w, h) As Byte
Dim bi As BitMapInfo
With bi.bmiHeader
.biBitCount = &
.biCompression = &
.biPlanes = &
.biSize = Len(bi.bmiHeader)
.biWidth = w
.biHeight = h
End With
Call GetDIBits(hdc, pic.Handle, , h, bits(, , ), bi, &) '灰度化
Dim x As Long
Dim y As Long
Dim g As Byte
For x = To w
For y = 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(, x, y) * 0.114 + bits(, x, y) * 0.587 + bits(, x, y) * 0.299
bits(, x, y) = g
bits(, x, y) = g
bits(, x, y) = g
Next
Next Picture1.Picture = Picture1.Image
Call SetDIBits(Picture1.hdc, Picture1.Picture.Handle, &, h, bits(, , ), bi, &)
Picture1.Picture = Picture1.Image Dim threshold As Byte
threshold = GetThreshold(bits, w, h) '二值化，阈值通过[最大类间方差法(Otsu)]取得
For x = To w
For y = To h
If bits(, x, y) > threshold Then
bits(, x, y) =
bits(, x, y) =
bits(, x, y) =
Else
bits(, x, y) =
bits(, x, y) =
bits(, x, y) =
End If
Next
Next Picture2.Picture = Picture2.Image
Call SetDIBits(Picture2.hdc, Picture2.Picture.Handle, &, h, bits(, , ), bi, &)
Picture2.Picture = Picture2.Image Erase bits
Call DeleteDC(hdc)
Set pic = Nothing
End Sub Private 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() As Long
Dim x As Long
Dim y As Long
Dim i As Long For i = To : hist(i) = : Next
For y = To Height
For x = To Width
hist(Pixels(, x, y)) = hist(Pixels(, x, y)) +
Next
Next Dim p() 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 =
For i = To
p(i) = hist(i) / total
ut = ut + i * hist(i)
Next
ut = ut / total
wk =
uk =
maxs =
For i = To
uk = uk + i * p(i)
wk = wk + p(i)
If wk <= EPSTLON Or wk >= (# - EPSTLON) Then
Else
sigma = (ut * wk - uk)
sigma = (sigma * sigma) / (wk * (# - wk))
If sigma > maxs Then
maxs = sigma
maxk = i
End If
End If
Next
GetThreshold = maxk
End Function
上张图，看看效果：
原图：
