放出代码
Public Class MeanShift
Const HISTOGRAM_LENGTH As Integer = 4096
Private imgWidth As Integer
Private imgHeight As Integer
Private trackWinWidth As Integer
Private trackWinHeight As Integer
Private currentX As Integer
Private currentY As Integer
Private currentHistogram(HISTOGRAM_LENGTH) As Double
Private tempHistogram(HISTOGRAM_LENGTH) As Double
' ---------------------------------------------------
Public Sub InitMeanShiftTracker(ByVal firstFrame() As Byte, ByVal frameWidth As Integer, ByVal frameHeight As Integer, _
ByVal targetPosX As Integer, ByVal targetPosY As Integer, ByVal targetWidth As Integer, ByVal targetHeight As Integer)
imgWidth = frameWidth
imgHeight = frameHeight
currentX = targetPosX
currentY = targetPosY
trackWinHeight = targetHeight
trackWinWidth = targetWidth
End Sub
Public Function CalcHistogramSp(ByVal frame() As Byte, ByVal histogram() As Double) As Integer
Dim pxValue As Integer = 0
For i As Integer = 0 To HISTOGRAM_LENGTH
histogram(i) = 0
Next
For j As Long = Math.Max(0, currentY - trackWinHeight / 2) To Math.Min(currentY + trackWinHeight / 2, imgHeight - 1)
For i As Integer = Math.Max(0, currentX - trackWinWidth / 2) To Math.Min(currentX + trackWinWidth / 2, imgWidth - 1)
Dim r As Integer = frame(j * imgWidth * 3 + i * 3) / 16
Dim g As Integer = frame(j * imgWidth * 3 + i * 3 + 1) / 16
Dim b As Integer = frame(j * imgWidth * 3 + i * 3 + 2) / 16
histogram(Int(256 * r + 16 * g + b)) += 1
pxValue += 1
Next
Next
For i As Integer = 0 To HISTOGRAM_LENGTH
histogram(i) /= pxValue
Next
Return pxValue
End Function
Public Function MeanShiftProcessSp(ByVal frame() As Byte)
Dim weights(HISTOGRAM_LENGTH) As Double
Dim newX As Double = 0.0
Dim newY As Double = 0.0
For i As Integer = 0 To HISTOGRAM_LENGTH
If currentHistogram(i) > 0.0 Then
weights(i) = tempHistogram(i) / currentHistogram(i)
Else
weights(i) = 0
End If
Next
Dim sumOfWeights As Double = 0.0
For j As Long = Math.Max(0, currentY - trackWinHeight / 2) To Math.Min(currentY + trackWinHeight / 2, imgHeight - 1)
For i As Integer = Math.Max(0, currentX - trackWinWidth / 2) To Math.Min(currentX + trackWinWidth / 2, imgWidth - 1)
Dim r As Integer = frame(j * imgWidth * 3 + i * 3) / 16
Dim g As Integer = frame(j * imgWidth * 3 + i * 3 + 1) / 16
Dim b As Integer = frame(j * imgWidth * 3 + i * 3 + 2) / 16
Dim ptr As Integer = 256 * r + 16 * g + b
newX += weights(ptr) * i
newY += weights(ptr) * j
sumOfWeights += weights(ptr)
Next
Next
If sumOfWeights <> 0 Then
currentX = Int(newX / sumOfWeights) + 0.5
currentY = Int(newY / sumOfWeights) + 0.5
End If
Return Nothing
End Function
Public Function MeanShiftTrackProcess(ByVal frame() As Byte, ByVal frameNumber As Integer)
If frameNumber = 0 Then
Me.CalcHistogramSp(frame, tempHistogram)
Else
Dim stopThreshold As Integer = 10
Dim counter As Integer = 0
While counter < stopThreshold
Me.CalcHistogramSp(frame, currentHistogram)
Me.MeanShiftProcessSp(frame)
counter += 1
End While
Me.DrawTrackBox(frame)
End If
Return Nothing
End Function
Public Sub DrawTrackBox(ByVal frame() As Byte)
For i As Integer = currentX To Math.Min(imgWidth, currentX + trackWinWidth)
frame(currentY * imgWidth * 3 + i * 3 + 0) = 0
frame(currentY * imgWidth * 3 + i * 3 + 1) = 0
frame(currentY * imgWidth * 3 + i * 3 + 2) = 255
frame(Math.Min(imgHeight - 1, currentY + trackWinHeight) * imgWidth * 3 + i * 3 + 0) = 0
frame(Math.Min(imgHeight - 1, currentY + trackWinHeight) * imgWidth * 3 + i * 3 + 1) = 0
frame(Math.Min(imgHeight - 1, currentY + trackWinHeight) * imgWidth * 3 + i * 3 + 2) = 255
Next
For j As Integer = currentY To Math.Min(imgHeight - 1, currentY + trackWinHeight)
frame(j * imgWidth * 3 + currentX * 3 + 0) = 0
frame(j * imgWidth * 3 + currentX * 3 + 1) = 0
frame(j * imgWidth * 3 + currentX * 3 + 2) = 255
frame(j * imgWidth * 3 + Math.Min(imgWidth - 1, currentX + trackWinWidth) * 3 + 0) = 0
frame(j * imgWidth * 3 + Math.Min(imgWidth - 1, currentX + trackWinWidth) * 3 + 1) = 0
frame(j * imgWidth * 3 + Math.Min(imgWidth - 1, currentX + trackWinWidth) * 3 + 2) = 255
Next
End Sub
End Class
Public Class MeanShift
Const HISTOGRAM_LENGTH As Integer = 4096
Private imgWidth As Integer
Private imgHeight As Integer
Private trackWinWidth As Integer
Private trackWinHeight As Integer
Private currentX As Integer
Private currentY As Integer
Private currentHistogram(HISTOGRAM_LENGTH) As Double
Private tempHistogram(HISTOGRAM_LENGTH) As Double
' ---------------------------------------------------
Public Sub InitMeanShiftTracker(ByVal firstFrame() As Byte, ByVal frameWidth As Integer, ByVal frameHeight As Integer, _
ByVal targetPosX As Integer, ByVal targetPosY As Integer, ByVal targetWidth As Integer, ByVal targetHeight As Integer)
imgWidth = frameWidth
imgHeight = frameHeight
currentX = targetPosX
currentY = targetPosY
trackWinHeight = targetHeight
trackWinWidth = targetWidth
End Sub
Public Function CalcHistogramSp(ByVal frame() As Byte, ByVal histogram() As Double) As Integer
Dim pxValue As Integer = 0
For i As Integer = 0 To HISTOGRAM_LENGTH
histogram(i) = 0
Next
For j As Long = Math.Max(0, currentY - trackWinHeight / 2) To Math.Min(currentY + trackWinHeight / 2, imgHeight - 1)
For i As Integer = Math.Max(0, currentX - trackWinWidth / 2) To Math.Min(currentX + trackWinWidth / 2, imgWidth - 1)
Dim r As Integer = frame(j * imgWidth * 3 + i * 3) / 16
Dim g As Integer = frame(j * imgWidth * 3 + i * 3 + 1) / 16
Dim b As Integer = frame(j * imgWidth * 3 + i * 3 + 2) / 16
histogram(Int(256 * r + 16 * g + b)) += 1
pxValue += 1
Next
Next
For i As Integer = 0 To HISTOGRAM_LENGTH
histogram(i) /= pxValue
Next
Return pxValue
End Function
Public Function MeanShiftProcessSp(ByVal frame() As Byte)
Dim weights(HISTOGRAM_LENGTH) As Double
Dim newX As Double = 0.0
Dim newY As Double = 0.0
For i As Integer = 0 To HISTOGRAM_LENGTH
If currentHistogram(i) > 0.0 Then
weights(i) = tempHistogram(i) / currentHistogram(i)
Else
weights(i) = 0
End If
Next
Dim sumOfWeights As Double = 0.0
For j As Long = Math.Max(0, currentY - trackWinHeight / 2) To Math.Min(currentY + trackWinHeight / 2, imgHeight - 1)
For i As Integer = Math.Max(0, currentX - trackWinWidth / 2) To Math.Min(currentX + trackWinWidth / 2, imgWidth - 1)
Dim r As Integer = frame(j * imgWidth * 3 + i * 3) / 16
Dim g As Integer = frame(j * imgWidth * 3 + i * 3 + 1) / 16
Dim b As Integer = frame(j * imgWidth * 3 + i * 3 + 2) / 16
Dim ptr As Integer = 256 * r + 16 * g + b
newX += weights(ptr) * i
newY += weights(ptr) * j
sumOfWeights += weights(ptr)
Next
Next
If sumOfWeights <> 0 Then
currentX = Int(newX / sumOfWeights) + 0.5
currentY = Int(newY / sumOfWeights) + 0.5
End If
Return Nothing
End Function
Public Function MeanShiftTrackProcess(ByVal frame() As Byte, ByVal frameNumber As Integer)
If frameNumber = 0 Then
Me.CalcHistogramSp(frame, tempHistogram)
Else
Dim stopThreshold As Integer = 10
Dim counter As Integer = 0
While counter < stopThreshold
Me.CalcHistogramSp(frame, currentHistogram)
Me.MeanShiftProcessSp(frame)
counter += 1
End While
Me.DrawTrackBox(frame)
End If
Return Nothing
End Function
Public Sub DrawTrackBox(ByVal frame() As Byte)
For i As Integer = currentX To Math.Min(imgWidth, currentX + trackWinWidth)
frame(currentY * imgWidth * 3 + i * 3 + 0) = 0
frame(currentY * imgWidth * 3 + i * 3 + 1) = 0
frame(currentY * imgWidth * 3 + i * 3 + 2) = 255
frame(Math.Min(imgHeight - 1, currentY + trackWinHeight) * imgWidth * 3 + i * 3 + 0) = 0
frame(Math.Min(imgHeight - 1, currentY + trackWinHeight) * imgWidth * 3 + i * 3 + 1) = 0
frame(Math.Min(imgHeight - 1, currentY + trackWinHeight) * imgWidth * 3 + i * 3 + 2) = 255
Next
For j As Integer = currentY To Math.Min(imgHeight - 1, currentY + trackWinHeight)
frame(j * imgWidth * 3 + currentX * 3 + 0) = 0
frame(j * imgWidth * 3 + currentX * 3 + 1) = 0
frame(j * imgWidth * 3 + currentX * 3 + 2) = 255
frame(j * imgWidth * 3 + Math.Min(imgWidth - 1, currentX + trackWinWidth) * 3 + 0) = 0
frame(j * imgWidth * 3 + Math.Min(imgWidth - 1, currentX + trackWinWidth) * 3 + 1) = 0
frame(j * imgWidth * 3 + Math.Min(imgWidth - 1, currentX + trackWinWidth) * 3 + 2) = 255
Next
End Sub
End Class