frmstageset.frm

一款飞机射击游戏的源代码

VERSION 5.00
Begin VB.Form FrmStageSet 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Set Stage Map"
   ClientHeight    =   6405
   ClientLeft      =   2010
   ClientTop       =   405
   ClientWidth     =   5880
   ControlBox      =   0   'False
   Icon            =   "FrmStageSet.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   427
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   392
   Begin VB.PictureBox PicCon 
      Height          =   6495
      Left            =   0
      ScaleHeight     =   429
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   389
      TabIndex        =   0
      Top             =   0
      Width           =   5895
      Begin VB.TextBox TxtSet 
         Height          =   270
         Index           =   0
         Left            =   840
         MaxLength       =   50
         TabIndex        =   4
         Top             =   360
         Visible         =   0   'False
         Width           =   1575
      End
      Begin VB.CommandButton CmdCancel 
         Caption         =   "取  消"
         Height          =   375
         Left            =   2400
         TabIndex        =   2
         Top             =   0
         Width           =   2295
      End
      Begin VB.CommandButton CmdOk 
         Caption         =   "请把地图名称填入下表"
         Height          =   375
         Left            =   0
         TabIndex        =   1
         Top             =   0
         Width           =   2295
      End
      Begin VB.Label LB 
         AutoSize        =   -1  'True
         Caption         =   "cap"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Visible         =   0   'False
         Width           =   270
      End
   End
End
Attribute VB_Name = "FrmStageSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdOk_Click()
Dim S As String
Dim NL As Integer
Dim IsEmp As Boolean
    For NL = TxtSet.UBound To 1 Step -1
        If Trim(TxtSet(NL).Text) <> "" And (Not IsEmp) Then
            IsEmp = True
        ElseIf Trim(TxtSet(NL).Text) = "" And IsEmp Then
            MsgBox "请不要在中间留几关空白", , "Set Error"
            Exit Sub
        End If
    Next NL
    If Not IsEnableMap Then Exit Sub
    Open App.Path & "\Map\StageSet" For Output As #1
        For NL = 1 To TxtSet.UBound
            S = Trim(TxtSet(NL).Text)
            Print #1, S
        Next NL
    Close #1
    Unload Me
End Sub

Private Sub Form_Load()
    Me.Top = 0
    CmdOk.Caption = "请把地图名称填入下表"
    CmdOk.Move 0, 0, PicCon.ScaleWidth \ 2
    CmdCancel.Move PicCon.ScaleWidth \ 2, 0, PicCon.ScaleWidth \ 2
    LB(0).Caption = ""
    LB(0).Move 0, CmdOk.Height - 20, 0, 20
    TxtSet(0).Height = LB(0).Height
    Call LoadTxt
    Call LoadStageSet
End Sub

Private Sub LoadTxt()
    Dim N As Byte
    For N = 1 To 20     '总共 20 关
        Load LB(N)
        Load TxtSet(N)
        With LB(N)
            .Left = 0
            .Top = LB(N - 1).Top + LB(0).Height
            .Caption = "Stage " & N
            .Visible = True
        End With
        With TxtSet(N)
            .Left = LB(1).Width + 8
            .Top = LB(N).Top
            .Width = PicCon.ScaleWidth - TxtSet(N).Left
            .Text = ""
            .Visible = True
        End With
    Next N
End Sub
Private Sub LoadStageSet()
On Error Resume Next
Dim N As Byte
Dim S As String
    Open App.Path & "\Map\StageSet" For Input As #1
        For N = 1 To TxtSet.UBound
            Line Input #1, S
            TxtSet(N).Text = Trim(S)
        Next N
    Close #1
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim N As Byte
    For N = 1 To TxtSet.UBound
        TxtSet(N).Text = vbNullString
        Unload TxtSet(N)
        Unload LB(N)
    Next N
        
End Sub
Private Function IsEnableMap() As Boolean
    Dim N As Byte
    Dim FName As String
    Dim HS As String * 20
    IsEnableMap = True
        For N = 1 To TxtSet.UBound
            If Trim(TxtSet(N).Text) = "" Then Exit Function
            FName = App.Path & "\map\" & Trim(TxtSet(N).Text) & ".Smp"
            If IsExistFile(FName) Then
            
                Open FName For Binary As #1
                    Get #1, 1, HS
                Close #1
                    If HS = "I'm a map for SkyWar" Then
                    Else
                        IsEnableMap = False
                        MsgBox "Map: " & FName & " is not a useable map! Please check it", , "Set Error"
                        Exit Function
                    End If
            Else
                IsEnableMap = False
                MsgBox "File " & FName & " is not exist!", , "Set Error"
                Exit Function
            End If
        Next N
End Function

Private Sub TxtSet_GotFocus(Index As Integer)
    CmdOk.Caption = "确   定"

End Sub