Code aus Form1.frm
Option Explicit
Private Sub Command1_Click()
  Dim curx As Long, cury As Long, hx As Long, hy As Long
  Dim denom As Double, subwin() As Long, sub2() As Long, sub3() As Long
  Dim x As Long, y As Long, xarr() As Long, yarr() As Long
  Dim incx As Double, incy As Double, dist2 As Double, eps2 As Double
  Dim startx As Long, starty As Long
    
  Dim i As Long, lastdist As Double
    
    hx = 50: hy = 50
    startx = 100: starty = 160
    curx = startx: cury = starty
    eps2 = 0.1
    dist2 = 2
    
    While (dist2 > eps2 And i < 1000) And lastdist <> dist2
      i = i + 1
      
      Debug.Print "Durchlauf", i
      
      lastdist = dist2
      
      ReadSubwin subwin, curx - hx, curx + hx, cury - hy, cury + hy
      Debug.Print "Ausgelesen"
      
      denom = SumXY(subwin)
      Debug.Print "Summiert", denom
      
      ReDim sub2(2 * hx, 2 * hy)
      ReDim sub3(2 * hx, 2 * hy)
      
      ReDim xarr(2 * hx, 2 * hy)
      ReDim yarr(2 * hx, 2 * hy)
      
      For y = 0 To 2 * hy
        For x = -hx To hx
          xarr(x + hx, y) = x
        Next x
      Next y
      
      For x = 0 To 2 * hx
        For y = -hy To hy
          yarr(x, y + hy) = y
        Next y
      Next x
      
      MultArray subwin, xarr, sub2
      MultArray subwin, yarr, sub3
      
      If denom <> 0 Then
        incx = SumXY(sub2) / denom
        incy = SumXY(sub3) / denom
      Else
        incx = 20
        incy = 20
      End If
      
      'sumxy(subwin) = m00 I
      'sumxy(sub2) = m10 xI
      'sumxy(sub3) = m01 yI
      
      Debug.Print "Verschiebung:", incx, incy
      
      curx = Round(curx + incx)
      cury = Round(cury + incy)
      
      dist2 = incx ^ 2 + incy ^ 2
      
      Debug.Print "Distanz:", dist2
    Wend
    
    Picture1.Line (curx - hx, cury - hy)-(curx + hx, cury + hy), , B
    Picture1.Line (startx - hx, starty - hy)-(startx + hx, starty _
        + hy), RGB(0, 0, 150), B
End Sub
Private Sub Form_Load()
    Picture1.Picture = LoadPicture(App.Path & "\weights.bmp")
End Sub
Function SumXY(arr() As Long) As Long
  Dim x As Long, y As Long, sum As Long
    
    For y = LBound(arr, 1) To UBound(arr, 1)
      For x = LBound(arr, 2) To UBound(arr, 2)
        sum = sum + arr(x, y)
      Next x
    Next y
    
    SumXY = sum
End Function
Sub ReadSubwin(ByRef subwin() As Long, x1 As Long, x2 As Long, y1 _
    As Long, y2 As Long)
  Dim x As Long, y As Long
    
    ReDim subwin(x2 - x1, y2 - y1)
    For x = x1 To x2
      For y = y1 To y2
        subwin(x - x1, y - y1) = 255 - (Picture1.Point(x, y) And &HFF)
      Next y
    Next x
End Sub
Sub MultArray(inp() As Long, mult() As Long, out() As Long)
  Dim x As Long, y As Long
    
    ReDim out(UBound(inp, 1), UBound(inp, 2))
    
    For x = LBound(inp, 1) To UBound(inp, 1)
      For y = LBound(inp, 2) To UBound(inp, 2)
        out(x, y) = inp(x, y) * mult(x, y)
      Next y
    Next x
End Sub