Анимация

[AntonGV]

Не получается сделать анимацию ходьбы. Нужно чтобы при одном нажатии на клавишу например вправо персонаж сдвигался на 16 пикселей вправо, при этом проигрывалась анимация и при каждом шаге(кадре, всего 4 кадра) персонаж сдвигался на 4px

Код: Выделить всё

Private Sub DrawPlayer()
Dim d As Integer
With Player

  'Ставим ACTION в 0. Это на случай эсли клавиши не нажаты
.Action = 0
  'Проверка нажатых клавиш
If KeyState(vbKeyUp) Then .Action = 2: .SrcX = .Width * 8
If KeyState(vbKeyDown) Then .Action = 4: .SrcX = .Width * 12
If KeyState(vbKeyLeft) Then .Action = 1: .SrcX = 0
If KeyState(vbKeyRight) Then .Action = 3: .SrcX = .Width * 4
If KeyState(vbKeySpace) Then .Action = 5: .SrcX = .Width * 16

'Проигрываем кадры с 1 ого по четвертый. Относительно положения  SrcX

Select Case .Action
  Case 1 ' Идём влево
   For d = 0 To 3
    .x = .x - 4
    DrawMap
    TransparentBlt SCREENBUFFER.DC, .x, .y, .Width, .Height, PLAYERSPRITE.DC, .SrcX + d * .Width, .SrcY, .Width, .Height, vbWhite
  'delay(20)  'sleep(20)
   Next d
  Case 2 ' Идём вверх
   For d = 0 To 3
    .y = .y - 4
    DrawMap
    TransparentBlt SCREENBUFFER.DC, .x, .y, .Width, .Height, PLAYERSPRITE.DC, .SrcX + d * .Width, .SrcY, .Width, .Height, vbWhite
   Next d
  Case 3 ' Идём вправо
   For d = 0 To 3
    .x = .x + 4
    DrawMap
    TransparentBlt SCREENBUFFER.DC, .x, .y, .Width, .Height, PLAYERSPRITE.DC, .SrcX + d * .Width, .SrcY, .Width, .Height, vbWhite
   Next d
  Case 4 'Идём вниз
   For d = 0 To 3
    .y = .y + 4
    DrawMap
    TransparentBlt SCREENBUFFER.DC, .x, .y, .Width, .Height, PLAYERSPRITE.DC, .SrcX + d * .Width, .SrcY, .Width, .Height, vbWhite
   Next d
  Case 5
   For d = 0 To 7
    DrawMap
    TransparentBlt SCREENBUFFER.DC, .x, .y, .Width, .Height, PLAYERSPRITE.DC, .SrcX + d * .Width, .SrcY, .Width, .Height, vbWhite
   Next d
  Case Else 'Стоим на месте
   .Frame = 1
   TransparentBlt SCREENBUFFER.DC, .x, .y, .Width, .Height, PLAYERSPRITE.DC, .SrcX + .Frame * .Width, .SrcY, .Width, .Height, vbWhite
End Select
End With
End Sub


Private Sub LoopTimer_Timer()
With SCREENBUFFER
  'Рисование чёрного фона.
  PatBlt .DC, 0, 0, .Width, .Height, vbBlack
  'Рисуем карту
  DrawMap
  'Рисуем игрока
  DrawPlayer
  'Выводим на форму
  StretchBlt P1.hdc, 0, 0, P1.ScaleWidth, P1.ScaleHeight, .DC, 0, 0, .Width, .Height, SRCCOPY
End With
End Sub

[AntonGV]

Неужели ни кто не знает?
Вообще-то я нашел ошибку: в процедуре DrawPlayer кадры рисуются в буффер, а на экран выводится только последний кадр. Что же нужно сделать, чтобы все работало нормально?