Code aus bewegungsfilter.frm
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias _
    "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObjectAPI Lib "gdi32" Alias _
    "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, _
    lpObject As Any) As Long
Private Type SAFEARRAYBOUND
  cElements As Long
  lLbound As Long
End Type
Private Type SAFEARRAY2D
  cDims As Integer
  fFeatures As Integer
  cbElements As Long
  cLocks As Long
  pvData As Long
  Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" _
    (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" _
    (lpFrequency As LARGE_INTEGER) As Long
Private Type LARGE_INTEGER
  lowpart As Long
  highpart As Long
End Type
Dim freq As LARGE_INTEGER, calibration As Double

'In der IDE zu langsam!
Public Sub DoImagePro()
  Dim Pic1() As Byte
  Dim SA1 As SAFEARRAY2D, BMP1 As BITMAP
  Dim Pic2() As Byte
  Dim SA2 As SAFEARRAY2D, BMP2 As BITMAP
    
  Dim x As Long, y As Long
  Dim n1 As Long, n2 As Long
    
  Dim maxX As Long, minX As Long
  Dim maxY As Long, minY As Long
  Dim mitX As Long, mitY As Long
    
  Dim randx As Long, randy As Long
    
  Dim schwelle As Long
  Dim flag As Boolean
    
    schwelle = HScroll1.Value
    randx = Val(Text1.Text)
    randy = Val(Text1.Text)
    
    If Check1.Value Then
      flag = True
    Else
      flag = False
    End If
    
    
    '### Pic 1
    GetObjectAPI Pictbox.Picture, Len(BMP1), BMP1
    With SA1
      .cbElements = 1
      .cDims = 2
      .Bounds(0).lLbound = 0
      .Bounds(0).cElements = BMP1.bmHeight
      .Bounds(1).lLbound = 0
      .Bounds(1).cElements = BMP1.bmWidthBytes
      .pvData = BMP1.bmBits
    End With
    CopyMemory ByVal VarPtrArray(Pic1), VarPtr(SA1), 4
    
    '### Pic 2
    GetObjectAPI Pictbuf.Picture, Len(BMP2), BMP2
    With SA2
      .cbElements = 1
      .cDims = 2
      .Bounds(0).lLbound = 0
      .Bounds(0).cElements = BMP2.bmHeight
      .Bounds(1).lLbound = 0
      .Bounds(1).cElements = BMP2.bmWidthBytes
      .pvData = BMP2.bmBits
    End With
    CopyMemory ByVal VarPtrArray(Pic2), VarPtr(SA2), 4
    
    '## Bewegungsfilter
    maxX = -1
    minX = UBound(Pic1, 1) + 1
    maxY = -1
    minY = UBound(Pic1, 2) + 1
    
    For x = LBound(Pic1, 1) To UBound(Pic1, 1)
      For y = LBound(Pic1, 2) To UBound(Pic1, 2)
        n1 = Pic1(x, y)
        n2 = Pic2(x, y)
        If (n1 - n2) > schwelle Then
          
          '44
        End If
        If x > maxX Then
          maxX = x
        End If
        If x < minX Then
          minX = x
        End If
        If y > maxY Then
          maxY = y
        End If
        If y < minY Then
          minY = y
        End If
        
        If flag Then
          Pic1(x, y) = 255
        End If
      Else
        If flag Then
          Pic1(x, y) = 0
        End If
      End If
    Next y
  Next x
  
  mitX = (minX \ 3 + maxX \ 3) \ 2
  mitY = (minY + maxY) \ 2
  '## ##
  
  maxX = mitX + randx
  minX = mitX - randx
  minY = Pictbox.ScaleHeight - (mitY - randy)
  maxY = Pictbox.ScaleHeight - (mitY + randy)
  Pictbox.Line (minX, minY)-(maxX, maxY), RGB(255, 255, 255), B
  
  CopyMemory ByVal VarPtrArray(Pic1), 0&, 4
  CopyMemory ByVal VarPtrArray(Pic2), 0&, 4
  
  Pictbox.Refresh
End Sub
Private Sub Form_Load()
  Dim start As LARGE_INTEGER, ende As LARGE_INTEGER
  
  Pictbox.Picture = LoadPicture(App.Path & "\001.bmp")
  Pictbuf.Picture = LoadPicture(App.Path & "\001.bmp")
  
  QueryPerformanceFrequency freq
  
  QueryPerformanceCounter start
  QueryPerformanceCounter ende
  
  calibration = (CDouble(ende) - CDouble(start)) / CDouble(freq) * 1000
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Unload Me
  End
End Sub
Private Sub HScroll1_Change()
  Label2.Caption = HScroll1.Value
End Sub
Private Sub Timer1_Timer()
  Static img As Integer
  Static v As Integer
  Dim start As LARGE_INTEGER, ende As LARGE_INTEGER
  
  Timer1.Enabled = False
  Do While True
    If img = 0 Then
      img = 1
    End If
    If v = 0 Then
      v = 1
    End If
    
    If img = 1 And v = -1 Then
      v = 1
    End If
    If img = 9 And v = 1 Then
      v = -1
    End If
    
    img = img + v
    
    Pictbox.Picture = LoadPicture(App.Path & "\" & Format(img, _
        "000") & ".bmp")
    If img = 1 And v = 1 Then
      Pictbuf.Picture = LoadPicture(App.Path & "\" & Format(img, _
          "000") & ".bmp")
    ElseIf img = 9 And v = -1 Then
      Pictbuf.Picture = LoadPicture(App.Path & "\" & Format(img, _
          "000") & ".bmp")
    Else
      Pictbuf.Picture = LoadPicture(App.Path & "\" & Format(img - _
          v, "000") & ".bmp")
    End If
    
    QueryPerformanceCounter start
    DoImagePro
    QueryPerformanceCounter ende
    Form1.Caption = (CDouble(ende) - CDouble(start)) / _
        CDouble(freq) * 1000 - calibration
    
    DoEvents
  Loop
End Sub
Private Function CDouble(Num As LARGE_INTEGER) As Double
  Dim Low As Double, High As Double
  
  Low = Num.lowpart
  High = Num.highpart
  
  If Low < 0 Then
    Low = 4294967296# + Low + 1
  End If
  If High < 0 Then
    High = 4294967296# + High + 1
  End If
  
  CDouble = Low + High * 4294967296#
End Function