editor.frm

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

  For I = 0 To Grid.Count - 1
   If Grid(I).Tag <> 3 Then LoadObject I, 3 'food tag id=3
  Next I
End Sub
Private Sub ExitButton_Click()
 Unload Me
End Sub
Private Sub CopyWindowMnu_Click()
 CopyForm 'creates a copy of the current active form
End Sub
Private Sub ExitMnu_Click()
 Unload Me
End Sub
Private Sub FloorClear_Click()
 ClearFloor_Click ' call the sub to clear with floor
End Sub
Private Sub FoodClear_Click()
 ClearFood_Click ' call the sub to clear with food
End Sub
Private Sub Form_Activate()
 SetForm Me 'sets the current active form to this one
 MDIFrm.NewWall.Picture = Me.NewWall.Picture 'changes the object selectors image to that of the current scheme
 MDIFrm.NewFood.Picture = Me.NewFood.Picture 'changes the object selectors image to that of the current scheme
 ' the following set the selected objects to that of the mdi form
 If MDIFrm.NewBeer.Value = True Then Me.NewBeer.Value = True
 If MDIFrm.NewFood.Value = True Then Me.NewFood.Value = True
 If MDIFrm.NewWall.Value = True Then Me.NewWall.Value = True
 If MDIFrm.NewCherry.Value = True Then Me.NewCherry.Value = True
 If MDIFrm.NewBerry.Value = True Then Me.NewBerry.Value = True
 If MDIFrm.NewLife.Value = True Then Me.NewLife.Value = True
 If MDIFrm.NewShield.Value = True Then Me.NewShield.Value = True
 If MDIFrm.NewGhoul.Value = True Then Me.NewGhoul.Value = True
 If MDIFrm.PacMan.Value = True Then Me.PacMan.Value = True
 ' shows the object selector
 MDIFrm.ToolBar.Enabled = True
 MDIFrm.IsDis.FillStyle = 1
End Sub

Private Sub Form_Click()
 MDIFrm.ToolBar.Enabled = True
 MDIFrm.IsDis.FillStyle = 1
End Sub

Private Sub Form_Deactivate()
 ' hides the object selector, (fixes alot of problems)
 MDIFrm.ToolBar.Enabled = False
 MDIFrm.IsDis.FillStyle = 4
End Sub


Private Sub Form_GotFocus()
 MDIFrm.ToolBar.Enabled = True
 MDIFrm.IsDis.FillStyle = 1
End Sub

Private Sub Form_Initialize()
 MDIFrm.ToolBar.Enabled = True
 MDIFrm.IsDis.FillStyle = 1
End Sub

Private Sub Form_Load()
  'see if this is the very first form
  If IsLoaded = False Then 'it is the first form
   LoadAllImages Me 'load all the images onto the form
   LoadingForm.Reset_Bar 'reset the loading form
  Else 'it is not the first form
   LoadLocalImages Me 'load the images from the first form (much faster then from the hard disk)
  End If
   LevelScheme = "00" ' sets the scheme to standard
   Area.Picture = BackPic(0).Picture 'loads the back pic of the level
   Grid(0).Tag = "1" 'sets the square to wall (tag id=1)
   Grid(0).Picture = NewWall.Picture
 
 For I = 1 To Int(19 * 19) - 1
   For II = 1 To 19 'goes throgh a line of squares
     If I = 19 * II Then iTop = iTop + 330  'sets the current y-square pos(each square is 330 twips high)
   Next II
   iLeft = iLeft + 330 'sets the current x-axis square pos
   If iLeft >= Int(19 * 330) Then iLeft = 0 'if the x asis is larger then 19 squares then set it to 0
   Load Grid(I) 'creates a new square
 If iLeft = 0 Or iLeft = Int(18 * 330) Or _
    iTop = 0 Or iTop = Int(330 * 18) Then 'if the square it at the edge then set it to a wall
   Grid(I).Tag = "1" 'give it the wall id
   Grid(I).Picture = NewWall.Picture 'load the wall picture
   Grid(I).Visible = True
  Else ' it is not on the edge
   Grid(I).Tag = "3" 'give block food id
   Grid(I).Picture = NewFood.Picture 'load food image
   Grid(I).Visible = True
 End If
 Grid(I).Left = iLeft 'sets the square to the correct x-axis
 Grid(I).Top = iTop 'sets the square to the correct y-axis
 Next I 'next square
 Form_Activate 'set this to the activated form
End Sub
'this sub loads an object into a square(ie, food, wall, ghoul...)
Public Sub LoadObject(Index As Integer, Optional ObjNum As Integer)
' if square is on the edge then load a wall object
For I = 0 To 18
 If Index = I Then
 Grid(I).Picture = NewWall.Picture
 Grid(I).Tag = "1"
 Exit Sub
 End If
Next I
' if square is on the edge then load a wall object
For I = 0 To 360 Step 19
 If Index = I Then
 Grid(I).Picture = NewWall.Picture
 Grid(I).Tag = "1"
 Exit Sub
 End If
Next I
' if square is on the edge then load a wall object
For I = 342 To 360
 If Index = I Then
 Grid(I).Picture = NewWall.Picture
 Grid(I).Tag = "1"
 Exit Sub
 End If
Next I
' if square is on the edge then load a wall object
For I = 18 To 360 Step 19
 If Index = I Then
 Grid(I).Picture = NewWall.Picture
 Grid(I).Tag = "1"
 Exit Sub
 End If
Next I
' if the pacman is being replaced then set the PacmanIsDown value to false
If Grid(Index).Tag = "2" Then PacManIsDown = False
'see which object is being placed down
    If NewBerry.Value = True Or ObjNum = 9 Then 'load a berry
      Grid(Index).Picture = NewBerry.Picture 'load the object picture
      Grid(Index).Tag = "9" 'set the tag id
     ElseIf NewWall.Value = True Or ObjNum = 1 Then 'load a wall
      Grid(Index).Picture = NewWall.Picture 'load the object picture
      Grid(Index).Tag = "1" 'set the tag id
     ElseIf NewFloor.Value = True Or ObjNum = 0 Then 'load a floor
      Grid(Index).Picture = NewFloor.Picture 'load the object picture
      Grid(Index).Tag = "0" 'set the tag id
     ElseIf NewCherry.Value = True Or ObjNum = 6 Then 'load a cherry
      Grid(Index).Picture = NewCherry.Picture 'load the object picture
      Grid(Index).Tag = "6" 'set the tag id
     ElseIf NewShield.Value = True Or ObjNum = 8 Then 'load a shield
      Grid(Index).Picture = NewShield.Picture 'load the object picture
      Grid(Index).Tag = "8" 'set the tag id
     ElseIf NewGhoul.Value = True Or ObjNum = 4 Then 'load a ghoul
      Grid(Index).Picture = NewGhoul.Picture 'load the object picture
      Grid(Index).Tag = "4" 'set the tag id
     ElseIf NewLife.Value = True Or ObjNum = 7 Then 'load a life
      Grid(Index).Picture = NewLife.Picture 'load the object picture
      Grid(Index).Tag = "7" 'set the tag id
     ElseIf NewBeer.Value = True Or ObjNum = 5 Then 'load a beer
      Grid(Index).Picture = NewBeer.Picture 'load the object picture
      Grid(Index).Tag = "5" 'set the tag id
     ElseIf NewFood.Value = True Or ObjNum = 3 Then 'load a food
      Grid(Index).Picture = NewFood.Picture 'load the object picture
      Grid(Index).Tag = "3" 'set the tag id
     ElseIf PacMan.Value = True Or ObjNum = 2 Then 'load a pacman
      'make sure another pacman is not placed down
      For I = 0 To (Grid.Count) - 1
       If Grid(I).Tag = "2" Then 'there is another pacman, unload it
        Grid(I).Picture = NewFloor.Picture 'load the object picture
        Grid(I).Tag = "0" 'set the tag id
       End If
      Next I
      'load the new pacman
      Grid(Index).Picture = PacMan.Picture 'load the object picture
      Grid(Index).Tag = "2" 'set the tag id
      PacManIsDown = True 'a pacman is now placed down
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 MDIFrm.ToolBar.Enabled = True
 MDIFrm.IsDis.FillStyle = 1
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 MDIFrm.ToolBar.Enabled = False 'disable the object selector
 MDIFrm.IsDis.FillStyle = 4  'show the disabled indicator
End Sub

Private Sub Grid_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 1 Then 'the mouse button is down
  Call LoadObject(Index, 99) 'load the object
 ElseIf Button = 2 Then 'delete the r object if the right mouse button is pressed
    If Grid(Index).Tag = "2" Then PacManIsDown = False
    Grid(Index).Picture = NewFloor.Picture
    Grid(Index).Tag = "0"
 End If
End Sub
' highlight the active square
Private Sub Grid_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 MDIFrm.ToolBar.Enabled = True
 MDIFrm.IsDis.FillStyle = 1
 If LastGrid = 0 And Index <> 0 Then LastGrid = Index: Grid(0).BorderStyle = 0
 If Index <> LastGrid Then Grid(LastGrid).BorderStyle = 0 'unhighlight the last square
 If LastGrid <> Index Then Grid(Index).BorderStyle = 1 'highlight thsi square
 If Shift = 1 Then
  Call LoadObject(Index, 99) 'load the current object if shift is pressed
 End If
LastGrid = Index
End Sub
'show the open level dialoge
Private Sub LoadLevel_Click()
 Load OpenDlg
 OpenDlg.Show
End Sub
Public Sub SetAllToFalse()
 'set all object selectors to false (no object is selected)
 NewCherry.Value = False
 NewShield.Value = False
 NewBerry.Value = False
 NewGhoul.Value = False
 NewFloor.Value = False
 NewLife.Value = False
 NewWall.Value = False
 NewBeer.Value = False
 NewFood.Value = False
 PacMan.Value = False
End Sub

Public Sub LoadLevel_Map(Optional FileName As String)
Dim LineString As String 'the x-axis objects (1 to 19)
Dim Obj As Integer 'the object to load
Dim Lines As Integer 'the number of lines down (y-axis)
Dim Index As Integer 'the next squares number
Dim Char As Integer 'the object character
Dim File 'the cuurent file

SetAllToFalse 'set all object selectors to false
Close #1 '--close all open files
Close #2 '--^

On Error GoTo errHand:

If Trim(FileName) <> "" Then 'make sure a file name is given
 File = FileName 'set the file to the file name given
 GoTo LoadIt: 'load the level
End If
If Trim(File) = "" Then Exit Sub 'exit the sub if no file was given
LoadIt:
ThisDir "Levels" ' set the path to {drive}:\{app.dir}\levels
Open File For Input As #2 'open the level for input
 Line Input #2, LevelScheme ' get the level scheme
 SetLevScheme LevelScheme 'set the level scheme
 For Lines = 1 To 19 'go through each y-axis
  Line Input #2, LineString 'get the next line of objects
  For Char = 1 To 19 ' go through each object of the current line
   Obj = Val(Mid(LineString, Char, 1)) 'get the object number
   Call LoadObject(Index, Obj) 'load the object
   Index = Index + 1 'goto next square
  Next Char
 Next Lines
Close #2 'close file
Exit Sub
errHand: 'there was an error
 MsgBox "The Level Is missing Or Corrupt", vbCritical
End Sub
Private Sub NewWindow_Click()
 NumFrms = NumFrms + 1 'add to the value of loaded forms
 Set nEdit(NumFrms) = New EditFrm 'copy "editfrm" to the new form
 Load nEdit(NumFrms) 'load the new form
End Sub
Public Sub OpenMnu_Click()
 'show the open menu dialoge
 OpenDlg.Show
End Sub
Private Sub Replace_Click()
 'show the object replacer form
 RepMnu_Click
End Sub
Private Sub RepMnu_Click()
 'show the object replacer form
 RepFrm.Visible = True
End Sub
Private Sub Save_Click()
 SaveMnu_Click
End Sub
Private Sub SaveMnu_Click()
 'make sure there is a pacman
 If PacManIsDown = False Then MsgBox "Please Place Down Pacman Before Saving", vbCritical, "Pacman": Exit Sub
 'show the save dialoge
 Load SaveDlg
 SaveDlg.Show
End Sub
'set the level scheme
Private Sub SetScheme_Click()
 OptionsFrm.Visible = True
End Sub
'set the level scheme
Public Sub SetLevScheme(LevSch As String)
 Dim LevSet As Integer, LevWall As Integer
 'convert the string value (LevSch) to separate numbers: LevWall and LevSet
 If Len(LevSch) = 1 Then LevSch = LevSch & "0"
 LevSet = Int(Left(LevSch, 1))
 LevWall = Int(Right(LevSch, 1))
 'load the set scheme
 OptionsFrm.PublicLoadScheme LevSet, LevWall
End Sub
Private Sub SetSchemeMnu_Click()
 SetScheme_Click 'set the level scheme
End Sub