fmaths.frm

一个用VB编的小游戏

   Begin VB.Label lblNO 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00000000&
      Caption         =   "0"
      BeginProperty Font 
         Name            =   "System"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Index           =   1
      Left            =   1920
      TabIndex        =   5
      Top             =   3840
      Width           =   3495
   End
   Begin VB.Label lblFun 
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      Caption         =   "又要考试呀！"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   0
      TabIndex        =   4
      Top             =   4560
      Width           =   6015
   End
End
Attribute VB_Name = "fMaths"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim gameLevel As Integer
Dim gameMark As Long
Dim Numbers(1 To 6) As Integer
Dim NOinBin(1 To 6, 0 To 4) As Integer
Dim GroupSel As Integer
Dim TimeRemain As Integer
Private Sub cmb_Click()
cmdOK.Caption = "从第" & GroupSel & "组中抽出" & cmb.ListIndex + 1 & "张试卷"
End Sub
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
  cmd(0).Visible = False
  cmdHlp.Visible = False
  cmd(1).Visible = True
  Call NewLevel
Case 1
  tmr.Enabled = False
  Real = MsgBox("如此一来，您此局的努力便白费了呀！" & RL & "您考虑清楚了吗？", vbYesNo + vbDefaultButton2 + vbQuestion, "RoE")
  If Real = 6 Then Call DoSummary Else tmr.Enabled = True
End Select
End Sub
Private Sub cmdHlp_Click()
Me.Enabled = False
fHelp.Show
End Sub
Private Sub cmdOK_Click()
Call PCTurn
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 200
tmr.Interval = gOption.gmSpeed
tmr.Enabled = False
'cmdHlp.Picture = LoadPicture(App.Path & "\pic\logicb.bmp")
gameLevel = 0
gameMark = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
tmr.Enabled = False
fResult.Show
End Sub

Private Sub lNO_Click(Index As Integer)
If lNO(Index) = "0" Then Exit Sub
GroupSel = Index + 1
Call TakeCmb
End Sub
Private Sub tmr_Timer()
If Not tmr.Enabled Then Exit Sub
TimeRemain = TimeRemain - 1
If TimeRemain = 0 Then
  MsgBox "“您思考的时间也未免太长了吧？”", vbOKOnly, "失败"
  Call DoSummary
  Exit Sub
End If
shp.Width = Int((600 - gameLevel * 5 - TimeRemain) / (600 - gameLevel * 5) * 324)
End Sub
Public Sub NewLevel()
For i = 1 To 6
  Numbers(i) = 0
  For j = 0 To 4
    NOinBin(i, j) = 0
  Next
Next
Randomize
If gameLevel < 20 Then
  gameLevel = gameLevel + 1
Else
  MsgBox "“好伟大呀！其实你已经不必继续了。”" & RL & _
    "当然您仍可以继续游戏以博得高分。", vbOKOnly, "恭喜"
End If
lblNO(0).Caption = gameLevel
For i = 1 To 6
  Numbers(i) = Int(Rnd * 25) + 5
  lNO(i - 1).Caption = Numbers(i)
  Call DecToBin(i)
Next
If LeadToWin Then
  Numbers(1) = Numbers(1) - 1
  lNO(0).Caption = Numbers(1)
  Call DecToBin(1)
End If
Call PlTurn
End Sub
Public Sub DecToBin(ByVal Owner As Integer)
temp = Numbers(Owner)
For j = 0 To 4
  NOinBin(Owner, j) = (Numbers(Owner) Mod 2)
  Numbers(Owner) = Int(Numbers(Owner) / 2)
Next
Numbers(Owner) = temp
End Sub
Public Function LeadToWin() As Boolean
Dim ok As Boolean
ok = True
For j = 0 To 4
  t = 0
  For i = 1 To 6
    t = t + NOinBin(i, j)
  Next
  If (t Mod 2) = 1 Then
    ok = False
    Exit For
  End If
Next
LeadToWin = ok
End Function
Public Sub TakeCmb()
If Numbers(GroupSel) = 0 Then Exit Sub
cmb.Move lNO(GroupSel - 1).Left - 16
cmb.Visible = True
cmdOK.Visible = True
With cmb
  .Clear
  For i = 1 To Numbers(GroupSel)
    .AddItem i
  Next
  .ListIndex = 0
End With
cmb.SetFocus
End Sub
Public Sub DoSummary()
GetMark = gameMark
CourseMark = gameLevel * 2 + Int(GetMark / 10000)
CourseLevel = gameLevel
MsgBox "您辛苦了！", vbOKOnly, "：Ｐ"
tmr.Enabled = False
Unload Me
End Sub
Public Sub PlTurn()
img(0).Visible = True
img(1).Visible = False
'lblFun.Caption = "It's your turn now."
TimeRemain = 600 - gameLevel * 5
GroupSel = 0
tmr.Enabled = True
End Sub
Public Sub PCTurn()
Numbers(GroupSel) = Numbers(GroupSel) - cmb.ListIndex - 1
lNO(GroupSel - 1).Caption = Numbers(GroupSel)
Call HighLightIt(GroupSel)
s = sndPlaySound(App.Path & "\snd\ccheat.wav", 1)
gameMark = gameMark + TimeRemain * Int((gameLevel + 1) / 3)
lblNO(1).Caption = gameMark
Call DecToBin(GroupSel)
Call GameOver(True)
GroupSel = 0
cmb.Visible = False
cmdOK.Visible = False
tmr.Enabled = False
img(0).Visible = False
img(1).Visible = True
lblFun.Caption = "Let me think…"
'开始思考
Randomize
Dim Super As Integer
Dim ok As Boolean
k = 0
For i = 1 To 6
  k = k + Numbers(i)
Next
If LeadToWin Or (Rnd * (9 - gameLevel / 2) > 1 And k >= 5 + gameLevel) Then
  Call TakeRandom
Else
  ok = False
  For i = 1 To 6
    Super = Numbers(i)
    Do While Numbers(i) > 0
      Numbers(i) = Numbers(i) - 1
      Call DecToBin(i)
      If LeadToWin Then
        ok = True
        Exit Do
      End If
    Loop
    If ok Then Exit For
    Numbers(i) = Super
    DecToBin (i)
    shp.Width = 20 + 40 * i
  Next
    shp.Width = 300
    If Not ok Then
      Call TakeRandom
    Else
      Call DecToBin(i)
      lblFun.Caption = "I take " & temp - Numbers(i) & " from group " & i
      lNO(i - 1).Caption = Numbers(i)
      s = sndPlaySound(App.Path & "\snd\cyz1.wav", 1)
      Call HighLightIt(i)
    End If
End If
Call GameOver(False)
End Sub
Public Sub TakeRandom()
Randomize
Do
i = Int(Rnd * 6 + 1)
Loop Until Numbers(i) > 0
v2 = Numbers(i)
Select Case v2
Case 1
  Numbers(i) = 0
Case Else
  k = 0
  For j = 1 To 6
    k = k + Numbers(j)
  Next
  If k > Numbers(i) Then
  r = Int(Rnd * (Numbers(i) - 1) + 1)
  Numbers(i) = Numbers(i) - r
  Else
    Numbers(i) = 0
  End If
End Select
Call DecToBin(i)
lNO(i - 1).Caption = Numbers(i)
lblFun.Caption = "I take " & v2 - Numbers(i) & " from group " & i
s = sndPlaySound(App.Path & "\snd\cyz2.wav", 1)
Call HighLightIt(i)
End Sub
Public Sub GameOver(Win As Boolean)
k = 0
For i = 1 To 6
  k = k + Numbers(i)
Next
If k > 0 Then
  If Not Win Then
    gameMark = gameMark + gameLevel * gameLevel
    lblNO(1).Caption = gameMark
    Call PlTurn
  End If
Else
If Win Then
  s = sndPlaySound(App.Path & "\snd\csigh.wav", 0)
  MsgBox "得到了最后一张秘传精选试题！", vbOKOnly, "胜利"
  gameMark = gameMark + gameLevel * 1000
  lblNO(1).Caption = gameMark
  Call NewLevel
Else
  s = sndPlaySound(App.Path & "\snd\sc" & Int(Rnd * 3 + 1) & ".wav", 0)
  MsgBox "被对方拿走了最后一张！", vbOKOnly, "失败"
  Call DoSummary
End If
End If
End Sub
Public Sub HighLightIt(ByVal k As Integer)
For i = 0 To 5
  lNO(i).ForeColor = vbRed
Next
lNO(k - 1).ForeColor = vbBlue
End Sub