Otsu Threshold
This algorithm is used to automatically perform clustering-based image thresholding or, the reduction of a graylevel image to a binary image.
Public Shared Sub ApplyOtsuThreshold(ByRef bmp As Bitmap)
Grayscale(bmp)
Dim otsuThreshold As Integer = GetOtsuThreshold(bmp) * 3
Threshold(bmp, CShort(otsuThreshold))
End Sub
Private Shared Sub Grayscale(ByRef bmp As Bitmap)
Dim bmData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
Dim p As IntPtr = bmData.Scan0
Dim stopAddress As Integer = CInt(p) + bmData.Stride * bmData.Height
While CInt(p) <> stopAddress
Dim gs = Math.Truncate(0.299 * Marshal.ReadByte(p + 2) + 0.587 * Marshal.ReadByte(p + 1) + 0.114 * Marshal.ReadByte(p))
Marshal.WriteByte(p, gs)
Marshal.WriteByte(p + 1, gs)
Marshal.WriteByte(p + 2, gs)
p += 3
End While
bmp.UnlockBits(bmData)
End Sub
Private Shared Sub Threshold(ByRef bmp As Bitmap, thresholdValue As Short)
Dim MaxVal As Integer = 768
If thresholdValue < 0 Then
Return
ElseIf thresholdValue > MaxVal Then
Return
End If
Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
Dim TotalRGB As Integer
Dim ptr As IntPtr = bmpData.Scan0
Dim stopAddress As Integer = CInt(ptr) + bmpData.Stride * bmpData.Height
While CInt(ptr) <> stopAddress
TotalRGB = CInt(Marshal.ReadByte(ptr)) + CInt(Marshal.ReadByte(ptr + 1)) + CInt(Marshal.ReadByte(ptr + 2))
If TotalRGB <= thresholdValue Then
Marshal.WriteByte(ptr + 2, 0)
Marshal.WriteByte(ptr + 1, 0)
Marshal.WriteByte(ptr, 0)
Else
Marshal.WriteByte(ptr + 2, 255)
Marshal.WriteByte(ptr + 1, 255)
Marshal.WriteByte(ptr, 255)
End If
ptr += 3
End While
bmp.UnlockBits(bmpData)
End Sub
Private Shared Function Px(init As Integer, [end] As Integer, hist As Integer()) As Single
Dim sum As Integer = 0
Dim i As Integer
For i = init To [end]
sum += hist(i)
Next
Return CSng(sum)
End Function
Private Shared Function Mx(init As Integer, [end] As Integer, hist As Integer()) As Single
Dim sum As Integer = 0
Dim i As Integer
For i = init To [end]
sum += i * hist(i)
Next
Return CSng(sum)
End Function
Private Shared Function FindMax(vec As Single(), n As Integer) As Integer
Dim maxVec As Single = 0
Dim idx As Integer = 0
Dim i As Integer
For i = 1 To n - 2
If vec(i) > maxVec Then
maxVec = vec(i)
idx = i
End If
Next
Return idx
End Function
Private Shared Sub GetHistogram(p As IntPtr, w As Integer, h As Integer, ws As Integer, hist As Integer())
hist.Initialize()
For i As Integer = 0 To h - 1
For j As Integer = 0 To w * 3 - 1 Step 3
Dim index As Integer = i * ws + j
hist(Marshal.ReadByte(p + index)) += 1
Next
Next
End Sub
Private Shared Function GetOtsuThreshold(bmp As Bitmap) As Integer
Dim t As Byte = 0
Dim vet As Single() = New Single(255) {}
Dim hist As Integer() = New Integer(255) {}
vet.Initialize()
Dim p1 As Single, p2 As Single, p12 As Single
Dim k As Integer
Dim bmData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)
Dim p As IntPtr = bmData.Scan0
GetHistogram(p, bmp.Width, bmp.Height, bmData.Stride, hist)
k = 1
While k <> 255
p1 = Px(0, k, hist)
p2 = Px(k + 1, 255, hist)
p12 = p1 * p2
If p12 = 0 Then
p12 = 1
End If
Dim diff As Single = (Mx(0, k, hist) * p2) - (Mx(k + 1, 255, hist) * p1)
vet(k) = CSng(diff) * diff / p12
k += 1
End While
bmp.UnlockBits(bmData)
t = CByte(FindMax(vet, 256))
Return t
End Function
Example
DIm b As Bitmap = CType(Image.FromFile("rose.jpg"), Bitmap)
ApplyOtsuThreshold(b)