fgamesel.frm

一个用VB编的小游戏

      Begin VB.CommandButton cmdGroup1 
         Caption         =   "系统"
         Height          =   375
         Index           =   3
         Left            =   0
         TabIndex        =   12
         Top             =   1080
         Width           =   2355
      End
      Begin VB.CommandButton cmdGroup1 
         Caption         =   "帮助"
         Height          =   375
         Index           =   2
         Left            =   0
         TabIndex        =   11
         Top             =   720
         Width           =   2355
      End
      Begin VB.CommandButton cmdGroup1 
         Caption         =   "游戏简介"
         Height          =   375
         Index           =   1
         Left            =   0
         TabIndex        =   10
         Top             =   360
         Width           =   2355
      End
      Begin VB.CommandButton cmdGroup1 
         Caption         =   "世界记录"
         Height          =   375
         Index           =   0
         Left            =   0
         TabIndex        =   9
         Top             =   0
         Width           =   2355
      End
      Begin VB.Label lbl 
         BackStyle       =   0  'Transparent
         Caption         =   "世界记录："
         Height          =   3975
         Index           =   1
         Left            =   0
         TabIndex        =   13
         Top             =   1470
         Width           =   2355
      End
   End
End
Attribute VB_Name = "fGameSel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
  Real = MsgBox("返回主画面吗？", vbYesNo + vbDefaultButton2 + vbQuestion, "roe")
  If Real = 6 Then
    Unload Me
    fMenu.Show
  End If
Case 1
  Randomize
  i = Int(Rnd * 5)
  Call cmdGame_Click(i)
End Select
End Sub
Private Sub cmdGame_Click(Index As Integer)
GameSelected = Index + 1
NextWork = (chkWork.Value = 1)
Select Case Index
Case 0
  Unload Me
  fCatch.Show
Case 1
  Unload Me
  fSpell.Show
Case 2
  Unload Me
  fMaths.Show
Case 3
  Unload Me
  fLessons.Show
Case 4
  Unload Me
  fBall.Show
End Select
End Sub
Private Sub cmdGroup0_Click(Index As Integer)
Call ToolGroup(True, Index)
End Sub
Private Sub cmdGroup1_Click(Index As Integer)
Call ToolGroup(False, Index)
End Sub
Private Sub cmdSubmit_Click(Index As Integer)
i = 0
If gameMode Then
Do While opt0(i).Value = False
  i = i + 1
  If i = 4 Then Exit Do
Loop
Else
Do While opt1(i).Value = False
  i = i + 1
  If i = 4 Then Exit Do
Loop
End If
If i = 4 Then Exit Sub
Select Case i
Case 3
  Call cmd_Click(0)
Case 2
  IsSet = False
  Unload Me
  fSet.Show
Case 1
  IsLoad = False
  Unload Me
  fLoad.Show
Case 0
  Open App.Path & "\sav\" & STrim(gameData.nameFile) & ".wyf" For Random As #1 Len = Len(gameData)
    Put #1, 1, gameData
  Close #1
  MsgBox "保存完毕！", vbOKOnly, "RoE"
End Select
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 200
picBack(gameMode + 1).Visible = True
picBack(-gameMode).Visible = False
Call ToolGroup(gameMode, 0)
If gameMode Then chkWork.Visible = True
End Sub
Public Sub ToolGroup(ByVal LngGame As Boolean, IDBox As Integer)
If LngGame Then
  For i = 0 To IDBox
    cmdGroup0(i).Top = i * cmdGroup0(0).Height
  Next
  If IDBox < 3 Then
    For i = IDBox + 1 To 3
      cmdGroup0(i).Top = picBack(0).ScaleHeight - cmdGroup0(0).Height * (4 - i)
    Next
  End If
  lbl(0).Top = cmdGroup0(0).Height * (IDBox + 1) + 2
  Select Case IDBox
  Case 0
    Call WhichToShow(True, 0)
    Call GnrInfo
  Case 1
    Call FindRecord(0)
  Case 2
    Call GiveHelp(0)
  Case 3
  Call WhichToShow(False, 0)
  End Select
Else
  For i = 0 To IDBox
    cmdGroup1(i).Top = i * cmdGroup1(0).Height
  Next
  If IDBox < 3 Then
    For i = IDBox + 1 To 3
      cmdGroup1(i).Top = picBack(1).ScaleHeight - cmdGroup1(0).Height * (4 - i)
    Next
  End If
  lbl(1).Top = cmdGroup1(0).Height * (IDBox + 1) + 2
  Select Case IDBox
  Case 0
    Call FindRecord(1)
  Case 1
    Call Introduce(1)
  Case 2
    Call GiveHelp(1)
  Case 3
  Call WhichToShow(False, 1)
  End Select
End If
End Sub
Public Sub FindRecord(ByVal Owner As Integer)
Call WhichToShow(True, Owner)
Dim ReadItem As Integer
Dim OutText, StrIn As String
ReadItem = 0
OutText = "世界记录：" & RL
Open App.Path & "\Sav\Record.ini" For Input As #1
  Do While Not EOF(1)
    Line Input #1, StrIn
    If ReadItem = 0 Then
    Select Case Left(StrIn, 5)
    Case "[1Cn]"
      OutText = OutText & "［语文／抓作弊］" & RL
    Case "[2Eg]"
      OutText = OutText & "［英语／默单词］" & RL
    Case "[3Mh]"
      OutText = OutText & "［数学／发试卷］" & RL
    Case "[4Si]"
      OutText = OutText & "［综合／连课时］" & RL
    Case "[5PE]"
      OutText = OutText & "［体育／抢篮球］" & RL
    End Select
        ReadItem = ReadItem + 1
    Else
    Select Case ReadItem
    Case 1
      OutText = OutText & "Lv " & StrIn & "；"
    Case 2
      OutText = OutText & "得分 " & Format(StrIn, "###,###,##0") & RL
    Case 3
      OutText = OutText & "记录保持者：" & RL & "" & StrIn & RL
    End Select
    ReadItem = ReadItem + 1
    If ReadItem = 4 Then ReadItem = 0
    End If
  Loop
    lbl(Owner).Caption = OutText
    lbl(Owner).Alignment = 2
Close #1
End Sub
Public Sub Introduce(ByVal Owner As Integer)
Call WhichToShow(True, Owner)
lbl(Owner).Alignment = 0
lbl(Owner).Caption = "［抓作弊］在一个矩形方阵中，每格代表一个学生。亮＝作弊，点击使他老实。" & RL & _
  "［默单词］卡片背后有英文单词或中文解释。每次至多翻看其中两张，如果单词与词义匹配则视作默出。" & RL & _
  "［发试卷］古老的取石子游戏的演化版本。小心！电脑的只能可是很高的！" & RL & _
  "［连课时］游戏形式接近俄罗斯方块，玩家须将带有学科名称的方格连在一起，算一次考试，消除并得分。" & RL & _
  "［夺篮球］玩家从右下角开始向中央的球移动，但每次移动时球也会动，寻找规律吧！人与球在同一格便为胜利。"
End Sub
Public Sub GiveHelp(ByVal Owner As Integer)
Call WhichToShow(True, Owner)
lbl(Owner).Alignment = 0
lbl(Owner).Caption = "从左侧五个大按钮中选择一个游戏进行吧！如果需要参考，则点击“游戏简介”签。如果仍无法决定，则点击下面的RandomGame，系统为您自动选择。" & RL & _
  "进入游戏后可以得到关于游戏的详细介绍。" & RL & _
  "左下的BackToMain可以快捷地回到主画面；RandomGame是随机选择游戏。" & RL & _
  "右侧有多个副签，点击后可以得到许多信息，也可以作一些决策。"
End Sub
Public Sub WhichToShow(ByVal Textual As Boolean, Owner As Integer)
  lbl(Owner).Visible = Textual
  For i = 0 To 3
    opt0(i).Visible = Not Textual
    opt1(i).Visible = Not Textual
  Next
  lbl(Owner).Alignment = 0
  cmdSubmit(Owner).Visible = Not Textual
End Sub
Public Sub GnrInfo()
Call WhichToShow(True, 0)
Select Case gameData.gnrWeekday
Case 0
  s = "日"
  chkWork.Value = 1
Case 1
  s = "一"
  chkWork.Value = 1
Case 2
  s = "二"
  chkWork.Value = 1
Case 3
  s = "三"
  chkWork.Value = 1
Case 4
  s = "四"
  chkWork.Value = 1
Case 5
  s = "五"
  If gameData.gnrWorkday Then chkWork.Value = 1 Else chkWork.Value = 0
Case 6
  s = "六"
  chkWork.Value = 0
End Select
If chkWork.Value = 1 Then t = "" Else t = "不"
a = gameData.scChinese + gameData.scEnglish + gameData.scMaths + gameData.scScience
lbl(0).Caption = "距离高考还有" & gameData.gnrDay & "天！" & RL & _
  "今天是星期" & s & "。" & RL & _
  "按规定，明天" & t & "上课。" & RL & RL & _
  STrim(gameData.nameSchool) & "在校长" & STrim(gameData.namePresident) & "地领导下，展开了紧张的复习迎考工作。" & RL & _
  "预计目前平均总分为：" & RL & _
  "　　" & a & RL & _
  "目前各科平均成绩：" & RL & _
  "　　语文：" & gameData.scChinese & RL & _
  "　　英语：" & gameData.scEnglish & RL & _
  "　　数学：" & gameData.scMaths & RL & _
  "　　综合：" & gameData.scScience & RL & _
  "　　情绪：" & gameData.scPE
End Sub