pacmod.bas

来自「吃豆子游戏的源代码。 嘿嘿」· BAS 代码 · 共 386 行 · 第 1/2 页

Attribute VB_Name = "GameMod"
'bitblt api
Public 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
'image copy constants
Public Const SRCCOPY = &HCC0020 'used in direct copy
Public Const SRCAND = &H8800C6   '--used when copying transparent images
Public Const SRCPAINT = &HEE0086 '-^

Private Enum MapObject 'the map object type
 mBerry = 9             'these values are also the tags given to the objects
 mProtect = 8
 mLife = 7
 mCherry = 6
 mBeer = 5
 mGhoul = 4
 mFood = 3
 mPacMan = 2
 mWall = 1
 mSpace = 0
End Enum

Public Enum EndType 'ending type
 died = 1            'died before finishing game
 Completed = 2       'completed
End Enum

Public Type ObjPos 'object position types
 X As Integer
 Y As Integer
End Type

Public Const dirUp = 1        '\
Public Const dirDown = 2      ' |---direction constants
Public Const dirLeft = 3      ' |--^
Public Const dirRight = 4     '/

Public Const Grid = 330      '\
Public Const MapWidth = 19   ' |-- Map Size Constants
Public Const MapHeight = 19  '/

Public Const DrunkTimeLength = 7   '--timer constants
Public Const ProtectTimeLength = 7 '-^

Global InBltLoop As Boolean 'is it currently drawing the shield ?

Global GhoulPos(19 * 19 + 1) As ObjPos 'position of the ghouls
Global PacManPos As ObjPos 'position of pacman

Global NowDead As Boolean  'is he dead?

Global GhoulColour As Integer 'the colour of the last ghoul loaded

Global NextDirect(19 * 19 + 1) As Integer  'used to predict the next direction of the ghouls
Global LastDirect(19 * 19 + 1) As Integer  'used to see the last direction of the ghouls

Global PacManLoaded As Boolean 'is pacman loaded?

Global FoodCount As Integer ' the number of food on the level
Global WallCount As Integer ' the number of walls on the level
Global EatenFood As Integer ' the number of foods eaten
Global CurrLevel As Integer ' the current level

Global FinalString As String ' the encoded position of the pacman, ghouls or any other object. so it can be stored in a ListBox
Global TmpStr1 As String '\
Global TmpStr2 As String ' |-used when turing co-ordinates into one string, so they can be stored in a ListBox
Global TmpStr3 As String '/

Public Sub LoadMap(File As String) ' load the map
 Dim Lines As Integer, Char As Integer 'the current position in the file
 Dim MapObj As MapObject
 Dim LevLine As String 'the line of chars retrieved from the file
 On Error GoTo ErrHandler 'error in the map some where
 ThisDir "levels" 'goto app.path\levels\  directory
 Open File For Input As #1 'open the level file for input
  Line Input #1, LevScheme 'get the level scheme
  WallTypeNum = Int(Right(LevScheme, 1)) 'get the wall type
  LevScheme = Trim(Left(LevScheme, 1)) 'get the scheme type
  Load_Scheme Int(LevScheme) 'load the scheme
  For Lines = 1 To MapHeight 'go through then next 19  lines in the file
   Line Input #1, LevLine 'get the line of chars
    If Lines = 1 Or Lines = 19 Then LevLine = "1111111111111111111" 'make sure there are walls around the level
    For Char = 1 To MapWidth 'go through each char in the line of chars
     If Char = 1 Or Char = 19 Then 'make sure a wall is loaded at the edge
       MapObj = mWall 'set the map object to a wall
     ElseIf Char = 18 And Lines = 18 And PacManLoaded = False Then 'make sure there is a pacman
       MapObj = mPacMan 'load a pacman
     Else 'load the given object
       MapObj = Int(Mid(LevLine, Char, 1))
     End If
     Call LoadMapObject(MapObj, Lines, Char) 'load the object into the correct position
    Next Char
  Next Lines
 Close #1 'close the open file
 Call ZOrderObjects 'order the objects
 Exit Sub 'finished
ErrHandler: 'ther was an error
 MsgBox Left$(File, 6) & " Is Missing or Corrupt !!", vbCritical 'display error message
 Dim Result As VbMsgBoxResult
 Result = MsgBox("Do You Want To Create A Replacement Level?", vbYesNo, "Create New Level?") 'ask to create a replacment level
 If Result = vbYes Then
  MsgBox "Please Remember To Save The Level As " & Left$(File, 6)
  ThisDir 'goto  this directory
  Shell "leveledit.exe", vbNormalFocus 'load the editor
 ElseIf Result = vbNo Then
  MsgBox "VB Pacman Will Now Exit", vbOKOnly, "Exiting..." 'exit
 End If
 Unload MainFrm
 End
End Sub
'order the objects
Public Sub ZOrderObjects()
' bottom ones first
 With MainFrm
  OrderIt .Wall
  OrderIt .Food
  OrderIt .Beer
  OrderIt .Cherry
  OrderIt .Berry
  OrderIt .Life
  OrderIt .Protect
  OrderIt .PacMan, True
  OrderIt .InfoLabel, True
  OrderIt .Ghoul
 End With
'tops ones last
End Sub
Public Sub OrderIt(Obj As Object, Optional ObjHasNoArray As Boolean = False)
 If ObjHasNoArray = True Then GoTo NoArray
   For ObjNum = 2 To Obj.Count 'go through each array
     Obj(ObjNum).ZOrder 0 'make it top
   Next ObjNum
 Exit Sub
NoArray:
 Obj.ZOrder 0 'make the object top
End Sub
Public Sub LoadMapObject(MapObj, Lines As Integer, Char As Integer)
Dim NewWall As Integer, NewFloor As Integer, NewFood As Integer     '\
Dim NewGhoul As Integer, NewBeer As Integer, NewCherry As Integer   ' >-- the objects that can be placed on the map
Dim NewLife As Integer, NewProtect As Integer, NewBerry As Integer  '/
  With MainFrm
    Select Case MapObj 'select which object is to be loaded
      '---------------------------------------------------------------------------------------'
      ' The following case subs all have the same format. Any differences will be highlighted '
      '---------------------------------------------------------------------------------------'
      Case Floor 'nothing needs to be loaded
      Case mWall 'load the wall
         NewWall = .Wall.Count + 1 'add a wall to the wall array
         Load .Wall(NewWall) 'load the object array
         WallCount = WallCount + 1 'add a wall to its current count
         .Wall(NewWall).Top = Grid * (Lines - 1) '\--set the wall position
         .Wall(NewWall).Left = Grid * (Char - 1) '^
         .Wall(NewWall).Visible = True
         Call AddObjectToList(MainFrm.WallList, Lines, Char, NewWall) 'add the object to the listbox
      Case mPacMan
         'only one pacman, no need to load another
         .PacMan.Top = Grid * (Lines - 1)
         .PacMan.Left = Grid * (Char - 1)
          PacManPos.Y = .PacMan.Top
          PacManPos.X = .PacMan.Left
          PacManLoaded = True
      Case mFood
         NewFood = .Food.Count + 1
         Load .Food(NewFood)
         FoodCount = FoodCount + 1
         .Food(NewFood).Top = Int((Grid - .Food(NewFood).Width) / 2) + (Grid * (Lines - 1))
         .Food(NewFood).Left = Int((Grid - .Food(NewFood).Height) / 2) + (Grid * (Char - 1))
         .Food(NewFood).ZOrder 0
         .Food(NewFood).Visible = True
         Call AddObjectToList(MainFrm.FoodList, Lines, Char, NewFood)
      Case mGhoul
         Randomize Timer
         NewGhoul = .Ghoul.Count + 1
         Load .Ghoul(NewGhoul)
         .Ghoul(NewGhoul).Top = Grid * (Lines - 1)
         .Ghoul(NewGhoul).Left = Grid * (Char - 1)
         GhoulColour = GhoulColour + 1
         If GhoulColour = 5 Then GhoulColour = 1
         LastDirect(NewGhoul) = Int(Rnd * 4) + 1 'Ghouls need a lastdirection
         NextDirect(NewGhoul) = Int(Rnd * 4) + 1 'and a next direction
         GhoulPos(NewGhoul).X = .Ghoul(NewGhoul).Left
         GhoulPos(NewGhoul).Y = .Ghoul(NewGhoul).Top
         .Ghoul(NewGhoul).Picture = .GhoulPic(GhoulColour) 'there are different colours  of ghouls, load the next colour
         .Ghoul(NewGhoul).Visible = True
      Case mBeer
         NewBeer = .Beer.Count + 1
         Load .Beer(NewBeer)
         .Beer(NewBeer).Top = Int((Grid - .Beer(NewBeer).Width) / 2) + (Grid * (Lines - 1))
         .Beer(NewBeer).Left = Int((Grid - .Beer(NewBeer).Height) / 2) + (Grid * (Char - 1))
         .Beer(NewBeer).Visible = True
         Call AddObjectToList(MainFrm.BeerList, Lines, Char, NewBeer)
      Case mCherry
        NewCherry = .Cherry.Count + 1
        Load .Cherry(NewCherry)