Option Explicit

Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim ddClipper As DirectDrawClipper
Dim bmpBild1 As DirectDrawSurface7
Dim AniCount As Single
Dim AniRunning As Boolean

Dim r1 As RECT
Dim r2 As RECT

Dim running As Boolean
Dim FrameTime As Long

Private Sub Form_Load()
  Dim srcrect As RECT
  Dim Aniline As Integer

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden

  running = True

  Do
    FrameTime = GetTime
    DX7.GetWindowRect Picture1.hWnd, r1
    BackBuffer.BltColorFill r2, 0

    Aniline = AniCount \ 9
    With srcrect
      .Left = 101 * (AniCount - (Aniline * 9))
      .Right = .Left + 101
      .Top = 102 * Aniline
      .Bottom = .Top + 102
    End With
    BackBuffer.BltFast 0, 0, bmpBild1, srcrect, DDBLTFAST_WAIT

    If AniRunning Then
      AniCount = AniCount + 1
      If AniCount > 43 Then AniCount = 0
    End If

    With r2
      .Left = 0: .Right = Picture1.ScaleWidth
      .Top = 0: .Bottom = Picture1.ScaleHeight
    End With
    PrimarySurface.Blt r1, BackBuffer, r2, DDBLT_WAIT

    DoEvents

    Do Until GetTime - FrameTime > 40
    Loop

  Loop While running

  Terminate
End Sub

Sub Initialization()
  Set DD7 = DX7.DirectDrawCreate("")

  DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL

  With SurfaceDesc
    .lFlags = DDSD_CAPS
    .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
  End With
  Set PrimarySurface = DD7.CreateSurface(SurfaceDesc)

  With SurfaceDesc
    .lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    .lHeight = Picture1.ScaleHeight
    .lWidth = Picture1.ScaleWidth
  End With
  Set BackBuffer = DD7.CreateSurface(SurfaceDesc)

  Set ddClipper = DD7.CreateClipper(0)
  ddClipper.SetHWnd Picture1.hWnd
  PrimarySurface.SetClipper ddClipper
End Sub

Sub BitmapLaden()
  Dim BmpDesc As DDSURFACEDESC2

  BmpDesc.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  BmpDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN

  BmpDesc.lWidth = 909
  BmpDesc.lHeight = 510

  Set bmpBild1 = _
      DD7.CreateSurfaceFromFile(App.Path & "\vbfun.bmp", BmpDesc)

End Sub

Function GetTime() As Long
  GetTime = DX7.TickCount
End Function

Sub Terminate()
  Set bmpBild1 = Nothing
  Set ddClipper = Nothing
  Set BackBuffer = Nothing
  Set PrimarySurface = Nothing

  DD7.RestoreDisplayMode
  DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
  End
End Sub

Private Sub cmd_Start_Click()
  AniRunning = True
  cmd_Stop.Enabled = cmd_Stop.Enabled Xor -1
  cmd_Start.Enabled = cmd_Start.Enabled Xor -1
End Sub

Private Sub cmd_Stop_Click()
  AniRunning = False
  cmd_Start.Enabled = cmd_Start.Enabled Xor -1
  cmd_Stop.Enabled = cmd_Stop.Enabled Xor -1
End Sub

Private Sub cmd_Beenden_Click()
  running = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, _
        UnloadMode As Integer)
  Terminate
End Sub