optionsfrm.frm

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

FRM
839
字号
               ScaleWidth      =   330
               TabIndex        =   6
               Top             =   630
               Width           =   330
            End
            Begin VB.OptionButton SetSpaceWall 
               BackColor       =   &H00000000&
               Caption         =   "SetWall"
               ForeColor       =   &H00FFFFFF&
               Height          =   240
               Index           =   0
               Left            =   1260
               TabIndex        =   5
               Top             =   675
               Width           =   915
            End
            Begin VB.PictureBox WallPic2 
               AutoSize        =   -1  'True
               BackColor       =   &H00000000&
               BorderStyle     =   0  'None
               Height          =   330
               Index           =   5
               Left            =   855
               ScaleHeight     =   330
               ScaleWidth      =   330
               TabIndex        =   4
               Top             =   1035
               Width           =   330
            End
            Begin VB.OptionButton SetSpaceWall 
               BackColor       =   &H00000000&
               Caption         =   "SetWall"
               ForeColor       =   &H00FFFFFF&
               Height          =   240
               Index           =   1
               Left            =   1260
               TabIndex        =   3
               Top             =   1080
               Value           =   -1  'True
               Width           =   915
            End
            Begin VB.Label Label1 
               BackStyle       =   0  'Transparent
               Caption         =   "Background:"
               ForeColor       =   &H00FFFFFF&
               Height          =   285
               Index           =   5
               Left            =   45
               TabIndex        =   9
               Top             =   45
               Width           =   1095
            End
            Begin VB.Label Label2 
               BackStyle       =   0  'Transparent
               Caption         =   "Wall"
               ForeColor       =   &H00FFFFFF&
               Height          =   195
               Index           =   5
               Left            =   405
               TabIndex        =   8
               Top             =   630
               Width           =   735
            End
            Begin VB.Label Label4 
               BackStyle       =   0  'Transparent
               Caption         =   "Food"
               ForeColor       =   &H00FFFFFF&
               Height          =   240
               Index           =   5
               Left            =   360
               TabIndex        =   7
               Top             =   1530
               Width           =   420
            End
            Begin VB.Image FoodImg 
               Height          =   330
               Index           =   5
               Left            =   855
               Top             =   1440
               Width           =   330
            End
         End
      End
   End
End
Attribute VB_Name = "OptionsFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'get the scheme has two numbers held in a string
Public Function GetSchemeNum() As String
  Dim TabIndex As Integer
  'see which tab has been selected
  TabIndex = Int(tbsOptions.Tab)
  Select Case TabIndex
   Case Is = 0 'the standard scheme tab has been selected
    GetSchemeNum = "00" 'convert this into the code, where the first number is the scheme number, and the second number is the wall type
   Case Is = 1 'the chocolate scheme tab has been selected
    GetSchemeNum = "10" 'convert this into the code
   Case Is = 2 'the sky scheme tab has been selected
    GetSchemeNum = "30"
   Case Is = 3 'the metal scheme tab has been selected
    If SetMetalWall(0).Value = True Then 'see which wall type has been selected
     GetSchemeNum = "50"
    Else
     GetSchemeNum = "51"
    End If
   Case Is = 4 'the christmas scheme tab has been selected
    If SetChristmasWall(0).Value = True Then 'see which wall type has been selected
     GetSchemeNum = "40"
    Else
     GetSchemeNum = "41"
    End If
   Case Is = 5 'the space scheme tab has been selected
    If SetSpaceWall(0).Value = True Then 'see which wall type has been selected
     GetSchemeNum = "20"
    Else
     GetSchemeNum = "21"
    End If
  End Select
End Function
Private Sub cmdApply_Click()
 LoadScheme 'load the scheme, but do not exit
End Sub
Private Sub LoadScheme()
 Dim TabIndex As Integer
 TabIndex = Int(tbsOptions.Tab)
 If nForm.LevelScheme = GetSchemeNum Then Exit Sub ' exit it the scheme is already loaded
  nForm.LevelScheme = GetSchemeNum
  With nForm
    For I = 0 To .Grid.Count - 1 'go through each square on the grid
     If .Grid(I).Tag = "1" Then 'the object is a wall
      .Grid(I).Picture = WallPic(TabIndex) 'change the wall image
      Select Case TabIndex
       Case Is = 0 '\
       Case Is = 1 ' |--these scheme do not have multiple walls
       Case Is = 2 '/
       Case Is = 3
         If SetMetalWall(1).Value = True Then 'change the wall to this one
            .Grid(I).Picture = WallPic2(TabIndex)
         Else
            GoTo Cont: 'used if there is only one wall type
         End If
            GoTo NextPic:
       Case Is = 4
        If SetChristmasWall(1).Value = True Then 'change the wall to this one
         .Grid(I).Picture = WallPic2(TabIndex)
        Else
         GoTo Cont: 'used if there is only one wall type
        End If
        GoTo NextPic:
       Case Is = 5
        If SetSpaceWall(1).Value = True Then 'change the wall to this one
         .Grid(I).Picture = WallPic2(TabIndex)
        Else
         GoTo Cont: 'used if there is only one wall type
        End If
        GoTo NextPic:
      End Select
Cont:
      .Grid(I).Picture = WallPic(TabIndex) 'used if there is only one wall type
NextPic:
     End If
     If .Grid(I).Tag = "3" Then .Grid(I).Picture = FoodImg(TabIndex).Picture ' change the food picture
    Next I
    .NewWall.Picture = .Grid(0).Picture             '--change the images selected on the active form
    .NewFood.Picture = FoodImg(TabIndex).Picture    '-^
    .Area.Picture = .BackPic(TabIndex).Picture 'set the background image
  End With
 MDIFrm.NewWall.Picture = nForm.NewWall.Picture '--change the images on the tool bar
 MDIFrm.NewFood.Picture = nForm.NewFood.Picture '-^
End Sub
Private Sub cmdCancel_Click()
    Unload Me
End Sub
Private Sub cmdOK_Click()
    LoadScheme 'load  the scheme
    Unload Me  'and exit
End Sub
'Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'    Dim I As Integer
'    'handle ctrl+tab to move to the next tab
'    If Shift = vbCtrlMask And KeyCode = vbKeyTab Then
'        I = tbsOptions.SelectedItem.Index
'        If I = tbsOptions.Tabs.Count Then
'            'last tab so we need to wrap to tab 1
'            Set tbsOptions.SelectedItem = tbsOptions.Tabs(1)
'        Else
'            'increment the tab
'            Set tbsOptions.SelectedItem = tbsOptions.Tabs(I + 1)
'        End If
'    End If
'End Sub

Private Sub Form_Load()
 Me.Icon = nForm.Icon
 If BackPic(0).Picture = 0 Then BackPic(0).Picture = nForm.BackPic(0)
 'load the images onto the form
 With OptionsFrm
   LoadPic2 .WallPic, "stdwall", 0, "schemes"
   LoadPic2 .WallPic, "chocolatewall", 1, "schemes"
   LoadPic2 .WallPic, "skywall", 2, "schemes"
   LoadPic2 .WallPic, "metalwall", 3, "schemes"
   LoadPic2 .WallPic2, "metalwall2", 3, "schemes"
   LoadPic2 .WallPic, "christmaswall", 4, "schemes"
   LoadPic2 .WallPic2, "christmaswall2", 4, "schemes"
   LoadPic2 .WallPic, "spacewall", 5, "schemes"
   LoadPic2 .WallPic2, "spacewall2", 5, "schemes"
   LoadPic2 .FoodImg, "stdfood", 0, "schemes"
   LoadPic2 .FoodImg, "chocolatefood", 1, "schemes"
   LoadPic2 .FoodImg, "skyfood", 2, "schemes"
   LoadPic2 .FoodImg, "metalfood", 3, "schemes"
   LoadPic2 .FoodImg, "christmasfood", 4, "schemes"
   LoadPic2 .FoodImg, "spacefood", 5, "schemes"
 End With
End Sub
'change the selected tab
'Private Sub tbsOptions_Click()
'    Dim I
'    For I = 0 To 5
'     If BackPic(I).Picture = 0 Then BackPic(I).Picture = nForm.BackPic(I)
'     Sample(I).Visible = False 'hide the current tab contents
'    Next I
'        'change the tab contents
'        Sample(tbsOptions.SelectedItem.Index - 1).Visible = True
'End Sub
Public Sub PublicLoadScheme(LevSet As Integer, LevWall As Integer)
'this loads the scheme in the same way as the sub LoadScheme
' but as been modified  so it can be acessed out side of the form
'Dim IsWinOpen As Boolean 'is the scheme selection window already open?
'IsWinOpen = OptionsFrm.Visible 'get the current value
nForm.LevelScheme = Trim(CStr(LevSet)) & Trim(CStr(LevWall))
With nForm
 Select Case LevSet
  Case Is = 0
   .NewWall.Picture = WallPic(0).Picture
   .NewFood.Picture = FoodImg(0).Picture
   .Area.Picture = .BackPic(0).Picture
  Case Is = 1
   .NewWall.Picture = WallPic(1).Picture
   .NewFood.Picture = FoodImg(1).Picture
   .Area.Picture = .BackPic(1).Picture
  Case Is = 2
   If LevWall = 1 Then
    .NewWall.Picture = WallPic2(5).Picture
   Else
    .NewWall.Picture = WallPic(5).Picture
   End If
   .NewFood.Picture = FoodImg(5).Picture
   .Area.Picture = .BackPic(5).Picture
  Case Is = 3
   .NewWall.Picture = WallPic(2).Picture
   .NewFood.Picture = FoodImg(2).Picture
   .Area.Picture = .BackPic(2).Picture
  Case Is = 4
   If LevWall = 1 Then
    .NewWall.Picture = WallPic2(4).Picture
   Else
    .NewWall.Picture = WallPic(4).Picture
   End If
   .NewFood.Picture = FoodImg(4).Picture
   .Area.Picture = .BackPic(4).Picture
  Case Is = 5
  If LevWall = 1 Then
    .NewWall.Picture = WallPic2(3).Picture
   Else
    .NewWall.Picture = WallPic(3).Picture
   End If
   .NewFood.Picture = FoodImg(3).Picture
   .Area.Picture = .BackPic(3).Picture
  End Select
 End With
 MDIFrm.NewWall.Picture = nForm.NewWall.Picture
 MDIFrm.NewFood.Picture = nForm.NewFood.Picture
 Unload OptionsFrm 'if the scheme selection window was not open, close it
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?