frmpacman.frm

Pacman Game Using VB6

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()

  frmPacMan.Show
  DoEvents
  
  ' Arah Gerak
  YD(0) = -1
  YD(1) = 1
  XD(2) = -1
  XD(3) = 1
  
  ' Kebalikan dari Arah Gerak
  Rev(0) = 1
  Rev(1) = 0
  Rev(2) = 3
  Rev(3) = 2
  
  ' Batas Arah Gerak
  OffDir(0) = -1
  OffDir(1) = 1
  OffDir(2) = -1
  OffDir(3) = 1
  
  Game.Speed = 1
  Game.Enhanced = True
  Game.Started = False
  
  ' Jumlah bonus poin ketika hantu dimakan pacman (disebabkan memakan sebuah pil kekuatan)
  GhostEat(1) = 200
  GhostEat(2) = 400
  GhostEat(3) = 800
  GhostEat(4) = 1600
  
  Game.HiScore = 10000
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

  ' Escape untuk Exit Game
  If KeyCode = vbKeyEscape Then
    shutdown
    End
  End If
  
  ' Perubahan Enhanced ke Original Pacman (dan sebaliknya)
  If KeyCode = vbKeyE And Game.Started = False Then
    Game.Enhanced = Not Game.Enhanced
    If Game.Enhanced = True Then
      lblTitle.Caption = "ENHANCED PACMAN"
    Else
      lblTitle.Caption = "ORIGINAL PACMAN"
    End If
  End If
  
  ' Kecepatan Game
  ' 1) Lambat (Normal)
  ' 2) Cepat (Fast/Turbo)
  ' 4) Cepat Sekali (Insane)
  
  If KeyCode = vbKeyS And Game.Started = False Then
    Game.Speed = Game.Speed * 2
    If Game.Speed = 8 Then
      Game.Speed = 1
    End If
    Select Case Game.Speed
      Case 1
        lblSpeed.Caption = "NORMAL SPEED"
      Case 2
        lblSpeed.Caption = "TURBO SPEED!"
      Case 4
       lblSpeed.Caption = "INSANE SPEED!!"
    End Select
  End If
  
  ' Pemasukan Koin Virtual(bisa dilakukan pada saat permainan)
  If KeyCode = vbKeyI And Game.Coins < 99 Then
    Game.Coins = Game.Coins + 1
    sndPlay "fruiteat", SoundOps.SND_ASYNC
    ShowCoins
  End If
  
  ' 1 Player
  If KeyCode = vbKey1 And Game.Coins > 0 And Game.Started = False Then
    Game.Coins = Game.Coins - 1
    Game.Players = 1
    ShowCoins
    Initialize
    Game.Started = True
  End If
  
  ' 2 Player (bergantian)
  If KeyCode = vbKey2 And Game.Coins > 1 And Game.Started = False Then
    Game.Coins = Game.Coins - 2
    Game.Players = 2
    Game.CurrentPlay = 0 ' Player 1
    PacmanBackUp(1).Lives = 3 ' Pastikan Player 2 mempunyai Lives(nyawa)...
    PacmanBackUp(1).FirstGo = True
    ShowCoins
    Initialize
    Game.Started = True
  End If
  
End Sub

Private Sub ShowCoins()

  ' Menampilkan Jumlah Coin
  If Game.Coins <> 1 Then
    lblCoins.Caption = CStr(Game.Coins) & " CREDITS"
  Else
    lblCoins.Caption = "1 CREDIT"
  End If
  
  ' Jumlah Player yang diperbolehkan
  Select Case Game.Coins
    Case 0
      lblPlayers.Caption = ""
    Case 1
      lblPlayers.Caption = "1 PLAY ONLY"
    Case Else
      lblPlayers.Caption = "1 OR 2 PLAY"
  End Select

End Sub

Private Sub Initialize()

  tmrPookie.Enabled = False
  tmrFlash.Enabled = False
  pctScreen.Visible = True
  pctScreen.Left = 0
  lblKeys.Visible = False
  
  ' Inisialisasi Pacman
  Pacman.Lives = 3
  Pacman.Level = 1
  Pacman.Score = 0
  lblHiscore.Caption = Game.HiScore
  lblScore.Caption = Pacman.Score
  lblHiscore.Refresh
  lblScore.Refresh
  Pacman.FirstGo = True
  
  If Game.Enhanced = True Then
    frmPacMan.pctTiles.Picture = LoadPicture(App.Path & "/pacpics.bmp")
  Else
    frmPacMan.pctTiles.Picture = LoadPicture(App.Path & "/pacpicsold.bmp")
  End If
  ' Inisialisasi Level dan pemberian titik-titik jalan
  ResetLevel
  ' Inisialisai Posisi
  DefaultPositions

  ' Menampilkan jumlah Lives(nyawa) dan nomor level
  ShowLives
    
  ' Mainkan musik
  StartMusic
  PlayIntro
  

End Sub


Private Sub lblPookie_Click()
MsgBox "By M Rofiul Ibad dkk", vbInformation, "Information"
End Sub

Private Sub tmrFlash_Timer()

  Static flipflop As Boolean
  
  flipflop = Not flipflop
  
  ' Tulisan berkedip pada INSERT COIN
  If flipflop Then
    lblInsert.ForeColor = vbBlack
  Else
    lblInsert.ForeColor = vbWhite
  End If

End Sub

Private Sub tmrKeyBoard_Timer()

  Dim nLoop As Integer
  Dim Px As Integer
  Dim Py As Integer
  
  ' Test and Gerakkan Pacman
  PacmanMovement
  ' Test and Gerakkan Ghosts
  AIGhostMonsters
  ' Test untuk setiap tubrukan
  TestCollisions
  
  ' Sembunyikan semua yang bisa bergerak(sprites:pacman & ghosts) di layar
  HideSprites
  
  ' Pengecekan buah yang dimakan pacman dan menghapusnya dari layar
  If Pacman.TimeCount = 5000 / Game.Speed _
  Or (Pacman.TimeCount >= 4000 / Game.Speed _
  And Pacman.FruitHere = False And Pacman.FruitGone = False) Then
    HideBlit 216, 264, 5
    Pacman.FruitGone = True
  End If
  
  ' Pengaturan TimeCount(jumlah Tic waktu) untuk penampilan dan penghapusan fruit(buah) di layar
  Pacman.TimeCount = Pacman.TimeCount + 1
  
  ' Menyembunyikan semua Sprite dan Exit sub jika pacman mati
  If Pacman.Dead Then PacDied: Exit Sub



  ' Jika semua titik sudah dimakan pacman, go to next level
  If Pacman.DotsLeft < 1 Then
    Pacman.TimeCount = 0 ' kembalikan Tic
    Pacman.Level = Pacman.Level + 1
    Pacman.FirstGo = True ' Inisialisasi ulang dan Siap Memainkan musik lagi
    If Pacman.Level > 8 Then Pacman.Level = 8
    AddScore 1000
    ShowLives
    ResetLevel
    DefaultPositions
    StartMusic
    PlayIntro
    Exit Sub
  End If
  
  
  
  ' jika titik sudah dimakan pacman, hapus dari layar
  If Pacman.DotGone Then
    Px = (Sprite(0).OXpos + XD(Pacman.Direction) * 16) + 8
    Py = (Sprite(0).OYpos + YD(Pacman.Direction) * 16) + 8
    BitBlt pctScreen.hDC, Px, Py, 16, 16, pctpicture.hDC, Px, Py, BitbltOps.SRCCOPY
  End If
 
  ' menampilkan kembali buah(fruit)
  If Pacman.TimeCount = 4000 / Game.Speed Then
    ShowBlit 216, 264, ((Pacman.Level - 1) Mod 4) * 32, _
             ((Pacman.Level - 1) \ 4) * 32 + 256, 5
    Pacman.FruitHere = True
    Pacman.FruitGone = False
  End If
  
  ' Menampilkan semua sprite
  ShowSprites
  pctScreen.Refresh
  
    
End Sub


Sub PacDied()

  Dim i As Integer
  Dim j As Integer
  Dim TempVar As Integer
  
  Pacman.Dead = False
  Pacman.Lives = Pacman.Lives - 1
  
  ' Salin Pacman State ke variabel sementara ketika giliran pemain lain
  PacmanBackUp(Game.CurrentPlay) = Pacman
  
  
  ' Jika ada 2 pemain, simpan peta dan tukar dengan pemain lain
  If Game.Players = 2 Then ' 2 pemain
    ' periksa pemain lain apakah mempunyai Live yang tersisa
    If PacmanBackUp(1 - Game.CurrentPlay).Lives > 0 Then
      ' pertukaran level
      For j = 0 To 30
        For i = 0 To 27
          With PacLevel(i, j)
            TempVar = .MemPlay ' pertukaran info level
            .MemPlay = .Block
            .Block = TempVar
          End With
        Next
      Next
      RefreshLevel ' penggambaran ulang level
      Game.CurrentPlay = 1 - Game.CurrentPlay ' pertukaran pemain
      Pacman = PacmanBackUp(Game.CurrentPlay)
      If PacmanBackUp(Game.CurrentPlay).FirstGo Then
        Initialize
        Exit Sub
      End If
    End If
  End If
  
  If Pacman.Lives < 1 Then
    Game.Started = False
    pctScreen.Visible = False
    tmrKeyBoard.Enabled = False
    pctStats.Cls
    lblKeys.Visible = True
    tmrPookie.Enabled = True
    tmrFlash.Enabled = True
    Exit Sub
  End If
  
  ShowLives
  AddScore 0 ' update score
  DefaultPositions
  PlayIntro


End Sub

Private Sub tmrPookie_Timer()

  ' pewarnaan acak :)
  lblPookie.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)

End Sub

Sub PlayIntro()

  tmrKeyBoard.Enabled = False
  lblReady.ForeColor = vbYellow
  tmrReady.Enabled = True

End Sub

Private Sub tmrReady_Timer()

  Static Counter As Long
  Dim waittime As Integer
  
  If Pacman.FirstGo = True Then
    waittime = 9 ' Tunggu sampai Musik berhenti
  Else
    waittime = 6 ' tiga kedip untuk 'Ready'
  End If
  
  Counter = Counter + 1
  If Counter = waittime Then
    lblReady.Caption = ""
    lblPlayer.Caption = ""
    lblReady.Refresh
    Counter = 0
    tmrReady.Enabled = False
    tmrKeyBoard.Enabled = True
  End If
  
  If (Counter And 1) = 1 Then
    lblReady.Caption = "READY!"
    If Game.Players = 2 Then
      lblPlayer.Caption = "PLAYER " & CStr(Game.CurrentPlay + 1)
    End If
  Else
    lblReady.Caption = ""
    lblPlayer.Caption = ""
  End If
  lblReady.Refresh
  
End Sub

Private Sub StartMusic()

  ' Pilih Musik
  If Game.Enhanced Then
    sndPlay "startMusic", SoundOps.SND_ASYNC
  Else
    sndPlay "startMusicold", SoundOps.SND_ASYNC
  End If
  
End Sub