baspacsetup.bas

Pacman Game Using VB6

  With frmPacMan
    ' pengembalian tampilan ke background di bawah sprite
    BitBlt .pctScreen.hDC, X, Y, 32, 32, .pctBack.hDC, 0, pos * 32, BitbltOps.SRCCOPY

  End With
  
End Sub

Sub DefaultPositions()
  
  With Pacman
    .Xpos = 224
    .Ypos = 376
    .Direction = 3
    .Offset = 8
    .Speed = Game.Speed
    .Mouth = 0
    .MouthDir = 1
    .MouthSpeed = 0
    ShowBlit .Xpos - 16, .Ypos - 16, .Direction * 32, 7 * 32, 0
  End With
  
  With Ghost(1) ' di luar kotak asal ghost
    .Xpos = 224
    .Ypos = 184
    .Direction = 2 + Rnd
    .Offset = 8
    .Speed = Game.Speed
    .InGame = False
    .Eyesonly = False
    .PPTimer = 0
    ShowBlit .Xpos - 16, .Ypos - 16, 0, .Direction * 32, 1
  End With
  
  With Ghost(2) ' di dalam kotak asal ghost sebelah kiri
    .Xpos = 192
    .Ypos = 224
    .Direction = 0
    .Offset = 8
    .InGame = False
    .Eyesonly = False
    .Ycounter = 0
    .Speed = Game.Speed
    .PPTimer = 0
    ShowBlit .Xpos - 16, .Ypos - 16, 32, .Direction * 32, 2
  End With
  
  With Ghost(3) ' di dalam kotak asal ghost bagian tengah
    .Xpos = 224
    .Ypos = 240
    .Direction = 1
    .Offset = 8
    .InGame = False
    .Eyesonly = False
    .Ycounter = 0
    .Speed = Game.Speed
    .PPTimer = 0
    ShowBlit .Xpos - 16, .Ypos - 16, 64, .Direction * 32, 3
  End With
  
  With Ghost(4) '  di dalam kotak asal ghost sebelah kanan
    .Xpos = 256
    .Ypos = 224
    .Direction = 0
    .Offset = 0
    .InGame = False
    .Eyesonly = False
    .Ycounter = 0
    .Speed = Game.Speed
    .PPTimer = 0
    ShowBlit .Xpos - 16, .Ypos - 16, 96, .Direction * 32, 4
  End With
  
  frmPacMan.pctScreen.Refresh
  
End Sub

Sub sndPlay(strName As String, sndType As Long)

 ' mainkan musik :O
 sndPlaySound App.Path & "/" & strName & ".wav", sndType

End Sub


Sub HideSprites()
  
  Dim nLoop As Integer
  ' hapus semua sprites dari layar dengan urutan mundur
  For nLoop = 4 To 0 Step -1
    With Sprite(nLoop)
      HideBlit .OXpos, .OYpos, nLoop
    End With
  Next
    
End Sub

Sub ShowSprites()

  Dim nLoop As Integer
  
  ' loop proses pembuatan ghost berkedip/flash ketika hampir selesai fase siap dimakan pacman
  Pacman.FlashOkay = (Pacman.FlashOkay + 1) Mod 16

  With Sprite(0)
    ShowBlit .NXpos, .NYpos, .XSprite, .YSprite, 0 ' tampilkan pacman
  End With
  
  For nLoop = 1 To 4
    With Sprite(nLoop)
      
      If Ghost(nLoop).PPTimer > 0 Then ' jika ghost dalam posisi siap dimakan
        ' jika pptimer < 200 maka ghost akan berkedip (hampir selesai)
        If (Ghost(nLoop).PPTimer < 200 / Game.Speed _
        And Pacman.FlashOkay > 7) _
        Or Ghost(nLoop).PPTimer >= 200 / Game.Speed Then
          
          .XSprite = 128 ' 128 adalah gambar ghost warna biru, hanya ditampilkan ketika
          ' dalam fase siap dimakan dan tidak berkedip
        
        End If
      
      End If
      
      ShowBlit .NXpos, .NYpos, .XSprite, .YSprite, nLoop ' gambar ghost
    End With
  Next

End Sub

Sub TestCollisions()

  Dim Px      As Integer
  Dim Py      As Integer
  Dim nLoop   As Integer
  
  Px = Pacman.Xpos
  Py = Pacman.Ypos
  
  For nLoop = 1 To 4
    With Ghost(nLoop)
    If Abs(Px - .Xpos) < 16 And Abs(Py - .Ypos) < 16 Then
      If .PPTimer > 0 Then ' ghost dalam fase siap dimakan
        sndPlay "ghosteat", SoundOps.SND_ASYNC
        Pacman.GhostsEaten = Pacman.GhostsEaten + 1
        AddScore GhostEat(Pacman.GhostsEaten)
        .Eyesonly = True ' ghost hanya tampil mata ketika habis dimakan
        .PPTimer = 0 ' ghost tidak dalam fase siap dimakan lagi
        .Speed = .Speed * 2 ' percepat ghost
        ' pastikan ghost tetap pada jalurnya pada grid
        ' kalau tidak memungkinkan untuk ghost menembus dinding :(
        Select Case Game.Speed
          Case 1
            .Offset = .Offset And 4094
            .Xpos = .Xpos And 4094
            .Ypos = .Ypos And 4094
          Case 2
          .Offset = .Offset And 4092
          .Xpos = .Xpos And 4092
          .Ypos = .Ypos And 4092
          Case 4
            .Offset = .Offset And 4088
            .Xpos = .Xpos And 4088
            .Ypos = .Ypos And 4088
        End Select
      Else
        ' if pac mengenai ghost dan ghost dalam fase normal maka pacman mati :..O
        If .Eyesonly = False And Pacman.Dead = False Then
          If Game.Cheat = False Then
            Pacman.Dead = True
            sndPlay "killed", SoundOps.SND_SYNC
          End If
        End If
      End If
    End If
    If .Eyesonly Then Sprite(nLoop).XSprite = 160 ' ubah sprite ghost hanya tampil mata
    End With
  Next
  
  ' periksa jika pacman dapat memakan beberapa buah di peta
  If Pacman.FruitHere = True _
  And Pacman.FruitGone = False _
  And Abs(Pacman.Xpos - 232) < 16 _
  And Pacman.Ypos = 280 Then
    
    Pacman.FruitHere = False ' hentikan pacman dari memakan buah lagi pada level terkait
    AddScore 500 * Pacman.Level
    sndPlay "Fruiteat", SoundOps.SND_ASYNC
  
  End If

End Sub

Sub AddScore(addTo As Long)

  Pacman.Score = Pacman.Score + addTo
  
  If Pacman.Score >= 10000 And Pacman.Score - addTo < 10000 Then
    ExtraLife
  End If
  
  If Pacman.Score >= 50000 And Pacman.Score - addTo < 50000 Then
    ExtraLife
  End If
  
  If Pacman.Score >= 100000 And Pacman.Score - addTo < 100000 Then ' As if. :)
    ExtraLife
  End If
  
  ' ubah skor dan label skor tertinggi
  With frmPacMan
    .lblScore.Caption = Pacman.Score
    If Pacman.Score > Game.HiScore Then
      Game.HiScore = Pacman.Score
      .lblHiscore.Caption = Pacman.Score
    End If
  End With
  
End Sub

Sub ExtraLife()

  ' yay
  Pacman.Lives = Pacman.Lives + 1
  sndPlay "extralife", SoundOps.SND_ASYNC
  ShowLives
  
End Sub

Sub shutdown()
  
  ' tutup tampilan utama
  Unload frmPacMan
  End

End Sub

Sub RefreshLevel()

  Dim i As Integer
  Dim j As Integer

  If Game.Enhanced = True Then
    ' untuk pengembangan game ini selanjutnya,
    ' diperlukan untuk mengubah nomor jadi setiap level punya background sendiri
    frmPacMan.pctScreen.Picture = LoadPicture(App.Path & "/level1.bmp")
  Else
    frmPacMan.pctScreen.Picture = LoadPicture(App.Path & "/levelold.bmp")
  End If
  
  frmPacMan.pctpicture.Picture = frmPacMan.pctScreen.Picture ' salin gambar
  
  ' gambar semua dot/pil dan power pil di layar
  For j = 1 To 29
    For i = 1 To 26
      With PacLevel(i, j)
       
        If .Block = Pac.Pill Then ' gambar sebuah pil di layar
          BitBlt frmPacMan.pctScreen.hDC, i * 16, j * 16, 16, 16, frmPacMan.pctTiles.hDC, 0, 320 + 16, BitbltOps.SRCAND
          BitBlt frmPacMan.pctScreen.hDC, i * 16, j * 16, 16, 16, frmPacMan.pctTiles.hDC, 0, 320, BitbltOps.SRCPAINT
        End If
        
        If .Block = Pac.PowerPill Then        ' gambar sebuah power pil di layar
          BitBlt frmPacMan.pctScreen.hDC, i * 16, j * 16, 16, 16, frmPacMan.pctTiles.hDC, 16, 320 + 16, BitbltOps.SRCAND
          BitBlt frmPacMan.pctScreen.hDC, i * 16, j * 16, 16, 16, frmPacMan.pctTiles.hDC, 16, 320, BitbltOps.SRCPAINT
        End If
      End With
    Next
  Next

End Sub