pacfrm.frm

来自「吃豆子游戏的源代码。 嘿嘿」· FRM 代码 · 共 1,452 行 · 第 1/4 页

 PacMan.Picture = PacLeft(0).Picture    '  \---reset all positions
 For Index = 2 To Ghoul.Count           '  /---of ghouls and pacman
  Ghoul(Index).Top = GhoulPos(Index).Y  ' /
  Ghoul(Index).Left = GhoulPos(Index).X '/
 Next Index

 NowDead = False
 InBltLoop = False 'exit the protection blt loop
 Lives = Str(Val(Lives) - 1) 'take a life
 'rest of sub is described in the sub "LoadNextLevel"
 Info.Caption = "READY"
 Info.Visible = True
 Pause 0.7
 Info.Caption = "Go!"
 Pause 0.7
 GhoulTimer.Enabled = True
 EatTimer.Enabled = True
 Area.Enabled = True
 Info.Caption = "Level " & CurrLevel
End Sub
' chack for all the food types
Private Function CheckForAllFoodTypes(Direction As Integer) As Boolean
Dim Check As Integer
 
 Check = CheckForObject(Direction, FoodList) 'see if there is food there
 If Check <> 0 Then 'then there is food
  Score = Val(Score) + 100 'add to score
  EatenFood = EatenFood + 1 'add to the ammount of food eaten
  Unload Food(Check) 'unload the eaten food
  If EatenFood = FoodCount Then LoadNextLevel 'if all food has been eaten then load the next level
  GoTo FoodCollected: 'no need to check for other foods
 End If
 
 Check = CheckForObject(Direction, CherryList) 'see if ther is a cherry there
 If Check <> 0 Then 'there is
  Score = Val(Score) + 500 'add to score
  Unload Cherry(Check) 'unload the food
  GoTo FoodCollected: 'no need to check for other foods
 End If
 
 '------------------------------------------------------------'
 ' The next two blocks have the same set out as the one above '
 '------------------------------------------------------------'
 
 Check = CheckForObject(Direction, LifeList)
 If Check <> 0 Then
  Unload Life(Check)
  Lives = Str(Val(Lives + 1))
  GoTo FoodCollected:
 End If
 
 Check = CheckForObject(Direction, BerryList)
 If Check <> 0 Then
  Score = Val(Score) + 2500
  Unload Berry(Check)
  GoTo FoodCollected:
 End If

CheckForAllFoodTypes = False 'no food found
GoTo NoFoodCollected:

FoodCollected:               'food found
 CheckForAllFoodTypes = True

NoFoodCollected: 'carry on

 IsDrunk (Direction)  'see if pacman is drunck
 IsProtected (Direction) 'see if pacman is protected
End Function
Private Sub ContinueBttn_Click()
 EndScreen.Visible = False 'continue to the start screen
End Sub
Private Sub ContinueBttn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 ContinueBttn.ForeColor = vbBlack 'change the colour of the button text
End Sub
Private Sub DrunkBar_GotFocus()
 Area.SetFocus 'set the focus to the main area
End Sub
Private Sub EndScreen_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 ContinueBttn.ForeColor = RGB(0, 200, 0) 'change the colour of the button text
End Sub
Private Sub ExitPacman_Click() 'unload the game
 Unload Me
 End
End Sub
Private Sub ExitPacman_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 ExitPacman.ForeColor = vbBlack 'change the colour of the button text
 LevEdit.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
 Play.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 Call Area_KeyDown(KeyCode, Shift) ' give the area the keycodes
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 'unload the game
 NowDead = True
 Lives.Caption = "-1"
 Area.Enabled = False
 GhoulTimer.Enabled = False
 EatTimer.Enabled = False
 InBltLoop = False
 End
End Sub
Private Sub InfoPane_KeyDown(KeyCode As Integer, Shift As Integer)
 Call Area_KeyDown(KeyCode, Shift) 'give the main area the keycodes
End Sub
Private Sub LevReached_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ContinueBttn.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
End Sub
Private Sub Play_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Play.ForeColor = vbBlack 'change the colour of the button text
 ExitPacman.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
 LevEdit.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
End Sub
Private Sub LevEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 LevEdit.ForeColor = vbBlack 'change the colour of the button text
 Play.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
 ExitPacman.ForeColor = RGB(0, 200, 0) 'reset the colour of the button text
End Sub
Private Sub LevEdit_Click()
 ThisDir 'goto this directory
 On Error GoTo errHand:
  Shell "leveledit.exe", vbNormalFocus 'load the editor
 Exit Sub
errHand: 'something went wrong
  'load the editor
  Shell Trim(App.Path & "\" & "leveledit.exe"), vbNormalFocus
 End Sub
Private Sub Play_Click() 'play the game
 NowDead = False
 StartScreen.Visible = False 'hise the start screen
 LoadNextLevel  'load the next level
End Sub

Private Sub ScoreTotal_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 ContinueBttn.ForeColor = RGB(0, 200, 0) 'reset the buuton text colour
End Sub
Private Sub ShieldBar_GotFocus()
 On Error Resume Next
 Area.SetFocus 'give focus the the main area
End Sub
Private Sub StartScreen_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Play.ForeColor = RGB(0, 200, 0) 'reset the buuton text colour
 ExitPacman.ForeColor = RGB(0, 200, 0) 'reset the buuton text colour
 LevEdit.ForeColor = RGB(0, 200, 0) 'reset the buuton text colour
End Sub
Private Sub ProtectTimer_Timer()
 ProtectTime = ProtectTime + 1 'add a second to the time pacman has been protected
 ShieldBar.Value ProtectTime 'update the timer
 If ProtectTime >= ProtectTimeLength Then NotProtectedNow 'see if pacman is no longer protected
End Sub
Private Sub DrunkTimer_Timer()
 DrunkTime = DrunkTime + 1 'add a second to the time pacman has been drunk
 DrunkBar.Value DrunkTime 'update the timer
 If DrunkTime = DrunkTimeLength Then NotDrunkNow 'see if pacman is no longer protected
End Sub
Private Sub EatTimer_Timer() 'change the status of pacmans mouth
  If MouthOpen = 0 Then MouthOpen = 1 Else MouthOpen = 0 'where 0 = no , and 1 = yes
  Select Case LastDirection 'select the last direction pacman moved and update to the correct image
   Case Is = 1
    PacMan.Picture = PacUp(MouthOpen).Picture
   Case Is = 2
    PacMan.Picture = PacDown(MouthOpen).Picture
   Case Is = 3
    PacMan.Picture = PacLeft(MouthOpen).Picture
   Case Is = 4
    PacMan.Picture = PacRight(MouthOpen).Picture
  End Select
End Sub
Private Sub Form_Load()
 ' add a little cheat, and helpful when testing
 If Command() <> "" Then CurrLevel = Val(Command()) - 1
 If CurrLevel > 8 Then CurrLevel = 8 'make sure the levelnumber is valid
 If CurrLevel < 0 Then CurrLevel = 0 'make sure the levelnumber is valid
 Area.Width = Grid * MapWidth   '\
 Area.Height = Grid * MapHeight ' \
 StartScreen.Top = -45          '  \
 StartScreen.Left = -45         '   \
 EndScreen.Top = -45            '    \
 EndScreen.Left = -45           '     |-- set defaults
 Loading.Top = -45              '    /
 Loading.Left = -45             '   /
 InBltLoop = False              '  /
 LastDirection = 3              ' /
 NowDead = False                '/
 LoadAllImages  'load all the images into the form
 Me.Show
 Me.Refresh
End Sub
Private Sub GhoulTimer_Timer() 'move the ghouls
Dim ChangeDirect As Boolean 'should the ghouls change direction
Dim CheckDir As Integer 'check a direction
Dim Index As Integer 'index array
For Index = 2 To (Ghoul.Count) 'go through each ghoul
If NowDead = True Then Exit Sub 'if PM's dead exit sub
 
 Select Case NextDirect(Index) 'if a wall is there then change the direction
  Case Is = 1
    ChangeDirect = MoveGhoul(Index, dirUp)
  Case Is = 2
    ChangeDirect = MoveGhoul(Index, dirDown)
  Case Is = 3
    ChangeDirect = MoveGhoul(Index, dirLeft)
  Case Is = 4
    ChangeDirect = MoveGhoul(Index, dirRight)
 End Select

' check if PM should die
If ProtectCollected = False Then 'PM's protected
 If Ghoul(Index).Top = PacMan.Top And Ghoul(Index).Left = PacMan.Left Then Reset_Level 'PM is dead
End If

Retry:
 Randomize Timer
 CheckDir = Int(Rnd * 4) + 1 'give a random direction
 
 If IsWallThere(Ghoul(Index), CheckDir) = False Then ChangeDirect = True Else GoTo Retry: 'if a wall is there change the direction
 LastDirect(Index) = NextDirect(Index) 'update the last dir
 NextDirect(Index) = Int(Rnd * 4) + 1  'set a new next dir
 If LastDirect(Index) = 1 And NextDirect(Index) = 2 Then GoTo Retry '-make sure the ghoul is not going to where it came from (make them more active)
 If LastDirect(Index) = 3 And NextDirect(Index) = 4 Then GoTo Retry '^
Next Index
End Sub
'move the ghoul
Private Function MoveGhoul(Index As Integer, Direction As Integer) As Boolean
 If NowDead = True Then Exit Function 'if PM's Dead Then Exit The Function
 Dim Check As Integer
 Select Case Direction
  Case Is = 1
1:
   If Ghoul(Index).Top <= 330 Then GoTo 2 'if the pacman is on the top line, he can't move up
   If IsWallThere(MainFrm.Ghoul(Index), 1) = False Then 'see if there is a wall
    Ghoul(Index).Top = Ghoul(Index).Top - Grid 'ther is not so, move the ghoul
   Else 'there was a wall
     GoTo 2: 'try another direction
   End If
  Case Is = 2
2:
   'same set out as CASE 1
   If Ghoul(Index).Top >= Int((MapHeight * Grid) - (2 * Grid)) Then GoTo 3
   If IsWallThere(MainFrm.Ghoul(Index), 2) = False Then
    Ghoul(Index).Top = Ghoul(Index).Top + Grid
   Else
    GoTo 3:
   End If
  Case Is = 3
3:
   'same set out as CASE 1
   If Ghoul(Index).Left <= Grid Then GoTo 4
   If IsWallThere(MainFrm.Ghoul(Index), 3) = False Then
     Ghoul(Index).Left = Ghoul(Index).Left - Grid
   Else
    GoTo 4:
   End If
  Case Is = 4
4:
   'same set out as CASE 1
   If Ghoul(Index).Left >= Int((MapWidth * Grid) - (Grid * 2)) Then GoTo 1
   If IsWallThere(MainFrm.Ghoul(Index), 4) = False Then
    Ghoul(Index).Left = Ghoul(Index).Left + Grid
   Else
    GoTo 1:
   End If
 End Select
End Function
Public Sub IsDrunk(Direction As Integer) 'see if pacman is drunk
Dim Check As Integer
 If BeerCollected = False Then 'PM's Not Drunk
     Check = CheckForObject(Direction, MainFrm.BeerList) 'check to see if PM ate Beer
     If Check <> 0 Then 'PM Ate Beer
      Unload MainFrm.Beer(Check) 'unload the beer
      Score = Val(Score) - 1000 'decrease the score
      BeerCollected = True 'set the beer collected to true
      MainFrm.DrunkTimer.Enabled = True 'enable the timer
      MainFrm.DrunkBar.Value 0 'set the current time to 0
      MainFrm.InfoLabel.Visible = True 'show the DRUNK Label
      InfoLabel.ZOrder 0 'set it to the top
     End If
   Else
     If DrunkTime >= DrunkTimeLength Then NotDrunkNow 'pm is no longer drunk
 End If
End Sub
Public Sub NotDrunkNow() 'PM's No Longer Drunk
       BeerCollected = False
       DrunkTime = 0
       MainFrm.DrunkTimer.Enabled = False
       MainFrm.InfoLabel.Visible = False
End Sub
Public Sub UpdateInfoLabelPos() 'Update The Pos Of The DRUNK Label
 With MainFrm
  If LastDirection <> dirDown Then 'put it above PM
   .InfoLabel.Top = (.PacMan.Top + Int(.PacMan.Height - .InfoLabel.Height)) + 30
  ElseIf LastDirection <> dirUp Then 'Put It Below PM
   .InfoLabel.Top = .PacMan.Top - 30
  End If
  .InfoLabel.Left = .PacMan.Left + ((.PacMan.Width - .InfoLabel.Width) / 2)
 End With
End Sub

Public Sub IsProtected(Direction As Integer)
Dim Check As Integer
 If ProtectCollected = False Then ' PM's Not Protected
     Check = CheckForObject(Direction, MainFrm.ProtectList) 'checkfor protection
     If Check <> 0 Then 'eaten protecion
      Unload MainFrm.Protect(Check) 'unload protection object
      ProtectCollected = True
      MainFrm.ProtectTimer.Enabled = True
      MainFrm.ShieldBar.Value 0 'set timer value to 0
    End If
   Else
     If ProtectTime >= ProtectTimeLength Then NotProtectedNow 'no longer protected
 End If
End Sub
Public Sub NotProtectedNow() 'no longer protected
       ProtectCollected = False
       ProtectTime = 0
       MainFrm.ProtectTimer.Enabled = False
End Sub
Public Sub UpdateShieldPos() 'update the protection shield's position
Do While ProtectCollected = True Or InBltLoop = False
 InBltLoop = True
 With MainFrm
  'draw the mask
  Call BitBlt(.Area.hDC, _
     Int(.PacMan.Left / Screen.TwipsPerPixelX), _
     Int(.PacMan.Top / Screen.TwipsPerPixelY), _
     22, 22, .ShieldPicMsk.hDC, 0, 0, SRCAND)
  'draw on the colour
  Call BitBlt(.Area.hDC, _
     Int(.PacMan.Left / Screen.TwipsPerPixelX), _
     Int(.PacMan.Top / Screen.TwipsPerPixelY), _
     22, 22, .ShieldPic.hDC, 0, 0, SRCPAINT)
 End With
 For I = 0 To 300
  DoEvents
 Next I
Loop
InBltLoop = False
End Sub
'the game has been completed, or Game Over
Public Sub FinishGame(WhichEnd As EndType)
  UnloadArrays 'unload all level objects
 If WhichEnd = died Then 'PM Died, No Lives Left
  EndPic.Picture = EndPicDie.Picture 'Show The Game Over Pic
  EndInfoTitle.Caption = "Game Over!" & Chr(13) & "Try Again." 'Show The Game Over Text
 ElseIf WhichEnd = Completed Then 'All Levels Finished
  EndPic.Picture = EndPicCon.Picture 'Show Win Picture
  EndInfoTitle.Caption = "Congratulations You've Completed VB-Pacman!" 'Show Win Win Text
 End If
  
  EndPic.Left = (Me.Width - EndPic.Width) / 2 'centre image
  ScoreTotal.Caption = Score.Caption 'set score value
  LevReached = CurrLevel 'set the level reached
  
  EndScreen.Visible = True 'show the end screen
  EndScreen.ZOrder 0 'put it on top
  StartScreen.Visible = True 'show the start screen (it is underneath)
  
  CurrLevel = 0 '-reset some values
  Lives = 3     '^
  UnloadArrays 'make sure all levels are unloaded
End Sub