baspacsetup.bas

Pacman Game Using VB6

Attribute VB_Name = "basSetUp"
Option Explicit

Public Enum BitbltOps   ' Untuk fungsi bitblt
    SRCCOPY = &HCC0020  ' Dest = Source
     SRCAND = &H8800C6  ' Dest = Dest AND Source
  SRCINVERT = &H660046  ' Dest = Dest XOR Source
   SRCPAINT = &HEE0086  ' Dest = Dest OR  Source
   SRCERASE = &H4400328 ' Dest = (XOR Dest) AND Source
  WHITENESS = &HFF0062  ' Dest = vbWhite
  BLACKNESS = &H42      ' Dest = vbBlack
End Enum

Public Enum SoundOps
       SND_SYNC = &H0
      SND_ASYNC = &H1
  SND_NODEFAULT = &H2
       SND_LOOP = &H8
     SND_NOSTOP = &H10
      SND_PURGE = &H40
     SND_NOWAIT = &H2000
End Enum

' Enumerasi tipe block dari map level untuk setiap cell nya
Public Enum Pac
  Wall = -1
  Blank = 0
  Pill = 1
  PowerPill = 2
End Enum

' atribut data dari PacLevel (per cell nya)
Public Type UDTPacLevel
  Junction    As Boolean ' Junction(percabangan) atau tidak
  JUp         As Boolean ' ghost dapat bergerak ke atas atau tidak
  JDown       As Boolean ' ghost dapat bergerak ke bawah atau tidak
  Jleft       As Boolean ' ghost dapat bergerak ke kiri atau tidak
  Jright      As Boolean ' ghost dapat bergerak ke kanan atau tidak
  Block       As Integer ' tipe block ( pac enum)
  MemPlay     As Integer
End Type


Public Type UDTGhost
  InGame      As Boolean ' jika ghost dalam permainan(diluar kotak asal) atau tidak
  Eyesonly    As Boolean ' Jika ghost setelah dimakan pacman dan belum pulih(tampil hanya mata)
  Xpos        As Integer ' posisi x dari ghost
  Ypos        As Integer ' posisi y dari ghost
  Direction   As Integer ' arah gerak dari ghost
  Offset      As Integer ' offset dari cell selanjutnya yang dituju
  Xcounter    As Integer ' belum digunakan
  Ycounter    As Integer ' sudah berapa kali ghost memantul naik turun dalam kotak asal
  Speed       As Integer ' kecepatan gerak ghost
  PPTimer     As Integer ' lama (waktu yang tersisa) ghost dalam state siap dimakan
  DelayTime   As Integer ' perlambatan gerak separuh dari kecepatan semula/normal ketika siap dimakan
End Type

'obyek animasi/yang bergerak untuk penggambaran
Public Type UDTSprites
  OXpos       As Integer ' posisi x lama
  OYpos       As Integer ' posisi y lama
  NXpos       As Integer ' posisi x baru
  NYpos       As Integer ' posisi y baru
  XSprite     As Integer ' posisi x relatif terhadap pcttiles
  YSprite     As Integer ' posisi y relatif terhadap pcttiles
End Type

Public Type UDTPacman
  FruitHere   As Boolean ' buah di layar atau tidak
  FruitGone   As Boolean ' buah sudah dimakan atau belum
  Dead        As Boolean ' pacman mati atau tidak
  DotGone     As Boolean ' jika pil sudah dimakan
  FirstGo     As Boolean ' jika ya mainkan inisial musik
  Score       As Long    ' skor pemain
  TimeCount   As Long    ' timer untuk check kapan meletakkan dan menyembunyikan buah
  Xpos        As Integer ' posisi x pacman
  Ypos        As Integer ' posisi y pacman
  Lives       As Integer ' jumlah lives/nyawa
  Direction   As Integer ' arah gerak
  Offset      As Integer ' sama dengan ghost
  Speed       As Integer ' kecepatan gerak pacman
  Level       As Integer ' level permainan yang sedang dijalani
  GhostsEaten As Integer ' jumlah ghost yang sudah dimakan pacman dengan 1 power pil
  FlashOkay   As Integer ' ghosts akan berkedip-kedip warnanya ketika state siap dimakan hampir selesai
  DotsLeft    As Integer ' menyimpan banyaknya dots/pil yang tersisa dalam permainan
  Mouth       As Integer ' Sprite dari mulut pacman yang digunakan
  MouthDir    As Integer ' Menyimpan keadaan mulut, terbuka atau tertutup
  MouthSpeed  As Integer ' kecepatan pergerakan frame
End Type

Public Type UDTGame
  Enhanced    As Boolean ' mode grafik
  HiScore     As Long    ' skor teringgi
  Coins       As Integer ' jumlah coin
  Players     As Integer ' jumlah pemain
  CurrentPlay As Integer ' pemain yang sedang bermain
  Speed       As Integer ' kecepatan permainan. >:)
  Started     As Boolean ' permainan sedang berlangsung atau tidak
  Cheat       As Boolean
End Type

' Deklarasi variable yang dibutuhkan dari tipe diatas
Public Pacman           As UDTPacman
Public Ghost(1 To 4)    As UDTGhost
Public Sprite(4)        As UDTSprites
Public PacLevel(27, 33) As UDTPacLevel
Public Game             As UDTGame
Public PacmanBackUp(1)  As UDTPacman

' deklarasi beberapa array
Public Rev(3)           As Integer ' Kebalikan arah gerak
Public XD(3)            As Integer ' Arah X
Public YD(3)            As Integer ' Arah Y
Public GhostEat(4)      As Long    ' bonus points untuk setiap ghost yang dimakan
Public OffDir(3)        As Integer

' deklarasi fungsi API :)
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long



' -----------------------------------------------------------------------------------------


' beberapa fungsi/prosedur/subrutine

Sub ShowLives() 'tampilkan nyawa

  Dim nLoop     As Integer ' jumlah loop
  Dim Xo        As Integer ' offset x dari buah
  Dim Yo        As Integer ' offset y dari buah
  
  With frmPacMan
    
    ' bersihkan layar picturebox
    .pctStats.Cls
    
    ' tampilkan semua pacman
    For nLoop = 1 To Pacman.Lives - 1
      BitBlt .pctStats.hDC, nLoop * 32 - 32, 0, 32, 32, .pctTiles.hDC, 96, 224, BitbltOps.SRCCOPY
    Next
    
    ' tampilkan semua buah sebagai sarana ke level berikutnya
    For nLoop = 0 To Pacman.Level - 1
      Xo = Int(nLoop Mod 4) * 32
      Yo = Int(nLoop / 4) * 32 + 256
      BitBlt .pctStats.hDC, 416 - nLoop * 32, 0, 32, 32, .pctTiles.hDC, Xo, Yo, BitbltOps.SRCCOPY
    Next
    frmPacMan.pctStats.Refresh
  
  End With
  
End Sub

Sub ResetLevel()

  Dim i             As Integer ' x loop
  Dim j             As Integer ' y loop
  Dim strData(30)   As String  ' map / peta level berbasis teks
  Dim ju            As Integer ' data junction/percabangan arah
  
  ' load the walls pills and powerpills into an array via strings
   strData(0) = "WWWWWWWWWWWWWWWWWWWWWWWWWWWW"
   strData(1) = "W............WW............W"
   strData(2) = "W.WWWW.WWWWW.WW.WWWWW.WWWW.W"
   strData(3) = "WoWWWW.WWWWW.WW.WWWWW.WWWWoW"
   strData(4) = "W.WWWW.WWWWW.WW.WWWWW.WWWW.W"
   strData(5) = "W..........................W"
   strData(6) = "W.WWWW.WW.WWWWWWWW.WW.WWWW.W"
   strData(7) = "W.WWWW.WW.WWWWWWWW.WW.WWWW.W"
   strData(8) = "W......WW....WW....WW......W"
   strData(9) = "WWWWWW.WWWWW WW WWWWW.WWWWWW"
  strData(10) = "     W.WWWWW WW WWWWW.W     "
  strData(11) = "     W.WW          WW.W     "
  strData(12) = "     W.WW WWWWWWWW WW.W     "
  strData(13) = "WWWWWW.WW W      W WW.WWWWWW"
  strData(14) = "      .   W      W   .      "
  strData(15) = "WWWWWW.WW W      W WW.WWWWWW"
  strData(16) = "     W.WW WWWWWWWW WW.W     "
  strData(17) = "     W.WW          WW.W     "
  strData(18) = "     W.WW WWWWWWWW WW.W     "
  strData(19) = "WWWWWW.WW WWWWWWWW WW.WWWWWW"
  strData(20) = "W............WW............W"
  strData(21) = "W.WWWW.WWWWW.WW.WWWWW.WWWW.W"
  strData(22) = "W.WWWW.WWWWW.WW.WWWWW.WWWW.W"
  strData(23) = "Wo..WW.......  .......WW..oW"
  strData(24) = "WWW.WW.WW.WWWWWWWW.WW.WW.WWW"
  strData(25) = "WWW.WW.WW.WWWWWWWW.WW.WW.WWW"
  strData(26) = "W......WW....WW....WW......W"
  strData(27) = "W.WWWWWWWWWW.WW.WWWWWWWWWW.W"
  strData(28) = "W.WWWWWWWWWW.WW.WWWWWWWWWW.W"
  strData(29) = "W..........................W"
  strData(30) = "WWWWWWWWWWWWWWWWWWWWWWWWWWWW"
 
  
  Pacman.DotsLeft = 0 ' set counter ke 0
  
  ' transformasi dari strdata ke PacLevel
  For j = 0 To 30
    For i = 0 To 27
      With PacLevel(i, j)
        Select Case Mid(strData(j), i + 1, 1)
          Case "W"
            .Block = Pac.Wall
          Case "."
            .Block = Pac.Pill
            Pacman.DotsLeft = Pacman.DotsLeft + 1
          Case "o"
            .Block = Pac.PowerPill
            Pacman.DotsLeft = Pacman.DotsLeft + 1
        End Select
      End With
    Next
  Next
   
  ' penghitungn semua percabangan / junction di permainan
  For j = 1 To 29
    For i = 1 To 26
      ju = 0
      With PacLevel(i, j)
        
        If .Block <> Pac.Wall Then
          If PacLevel(i, j - 1).Block <> Pac.Wall Then ju = ju Or 1: .JUp = True
          If PacLevel(i, j + 1).Block <> Pac.Wall Then ju = ju Or 2: .JDown = True
          If PacLevel(i - 1, j).Block <> Pac.Wall Then ju = ju Or 4: .Jleft = True
          If PacLevel(i + 1, j).Block <> Pac.Wall Then ju = ju Or 8: .Jright = True
          
          If ju < 5 Or ju = 8 Or ju = 12 Then
            .Junction = False ' menghapus jalan buntu
          Else
            .Junction = True
          End If
        End If
      End With
    Next
  Next
  
  ' menggambar semua dot/pil/dll pada layar
  RefreshLevel
  
End Sub


Sub ShowBlit(ByVal X As Integer, ByVal Y As Integer, _
               ByVal XP As Integer, ByVal YP As Integer, ByVal pos As Integer)

  Dim maskOffset As Integer
  
  With frmPacMan

    ' salin info dibelakang sprite ke buffer
    BitBlt .pctBack.hDC, 0, pos * 32, 32, 32, .pctScreen.hDC, X, Y, BitbltOps.SRCCOPY
  
    If pos = 0 Or pos = 5 Then ' pacman atau buah saja
      maskOffset = XP + 128
    Else
      If Ghost(pos).Eyesonly = False Then
        maskOffset = 192 ' topeng ghost normal
      Else
        maskOffset = 224 ' mata topeng
      End If
    End If
    
    BitBlt .pctScreen.hDC, X, Y, 32, 32, .pctTiles.hDC, maskOffset, YP, BitbltOps.SRCAND
    BitBlt .pctScreen.hDC, X, Y, 32, 32, .pctTiles.hDC, XP, YP, BitbltOps.SRCPAINT
  
  End With

End Sub

Sub HideBlit(X As Integer, Y As Integer, pos As Integer)