fspell.frm

一个用VB编的小游戏

      Index           =   1
      Left            =   5520
      TabIndex        =   8
      Top             =   3840
      Width           =   360
   End
   Begin VB.Label lbl 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Ｌｖ"
      ForeColor       =   &H00800000&
      Height          =   180
      Index           =   2
      Left            =   600
      TabIndex        =   7
      Top             =   3840
      Width           =   360
   End
   Begin VB.Label lbl 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "得分"
      ForeColor       =   &H00800000&
      Height          =   180
      Index           =   3
      Left            =   1560
      TabIndex        =   6
      Top             =   3840
      Width           =   360
   End
   Begin VB.Label lblNO 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00000000&
      Caption         =   "1"
      BeginProperty Font 
         Name            =   "System"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   0
      Left            =   960
      TabIndex        =   5
      Top             =   3840
      Width           =   375
   End
   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        =   4
      Top             =   3840
      Width           =   3495
   End
   Begin VB.Label lblFun 
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      Caption         =   "Now, spell some words."
      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        =   3
      Top             =   4560
      Width           =   6015
   End
End
Attribute VB_Name = "fSpell"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim LBN(0 To 35) As Integer
Dim LBC(0 To 35) As String
Dim LBS(0 To 35) As Boolean
Dim LWID(0 To 35) As Integer
Dim LastShow As Integer
Dim TimeRemain, ClickRemain As Integer
Dim gameMark As Long
Dim LevelNO As Integer

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 Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 200
tmr.Interval = gOption.gmSpeed
picTemp.Picture = LoadPicture(App.Path & "\pic\spellb.bmp")
cmdHlp.Picture = picTemp.Picture
LevelNO = 0
End Sub
Public Sub DoSummary()
GetMark = gameMark
CourseMark = LevelNO * 2 + Int(gameMark / 10000)
CourseLevel = LevelNO
MsgBox "您辛苦了！", vbOKOnly, "：Ｐ"
Unload Me
End Sub
Public Sub NewLevel()
Dim ok As Boolean
For i = 0 To 35
  lWord(i).Caption = "◇"
Next
If LevelNO < 20 Then
  LevelNO = LevelNO + 1
Else
  MsgBox "“全部都默写出了！”" & RL & "您可以继续游戏以得到高分，或退出游戏。", vbOKOnly, "恭喜"
End If
tmr.Enabled = False
lblNO(0).Caption = LevelNO
Randomize
'共1799
For i = 0 To 35 Step 2
  Do
    LBN(i) = Int(Rnd * DictLen) + 1
    LBN(i + 1) = LBN(i)
    ok = True
    If i > 0 Then
      For j = 0 To i - 1 Step 2
        If LBN(i) = LBN(j) Then ok = False
      Next
    End If
  Loop Until ok
  t = GetWordNo(LBN(i))
  a = InStr(1, t, "\")
  b = InStr(a + 1, t, "\")
  LBC(i) = Mid(t, a + 1, b - a - 1)
  LBC(i + 1) = Mid(t, b + 1)
  LBS(i) = False
  LBS(i + 1) = False
  'Debug.Print LBN(i), LBC(i), LBC(i + 1)
  lWord(i).Caption = "◎"
  lWord(i + 1).Caption = "◎"
  lWord(i).BackColor = vbYellow
  lWord(i + 1).BackColor = vbYellow
  lblProgress.Caption = Int(i * 2.5) & "%"
  shp.Width = Int((i * 2 + 4) * lblProgress.Width / 100)
Next
Call MaskIn
  lblProgress.Caption = "80%"
  shp.Width = Int(80 * lblProgress.Width / 100)
Call IDFix
  lblProgress.Caption = "90%"
  shp.Width = Int(90 * lblProgress.Width / 100)
TimeRemain = 600 - LevelNO * 10
ClickRemain = 200 - LevelNO * 2
LastShow = -1
lblProgress.Caption = "完成"
shp.Width = Int(lblProgress.Width)
tmr.Enabled = True
End Sub
Public Function GetWordNo(ByVal ID As Integer) As String
Dim temp As String
Open App.Path & "\word.ini" For Input As #1
For i = 1 To ID
  Line Input #1, temp
Next
Close #1
GetWordNo = temp
End Function
Public Sub MaskIn()
Dim a, b, c As Integer
Dim s As String
Randomize
For i = 0 To LevelNO * 3 Step 2
a = i Mod 36
c = Len(LBC(a))
b = Int(Rnd * c + 1)
If b = 1 Then s = "?" & Mid(LBC(a), 2)
If b = c Then s = Left(LBC(a), b - 1) & "?"
If b > 1 And b < c Then s = Left(LBC(a), b - 1) & "?" & Mid(LBC(a), b + 1)
LBC(a) = s
Next
End Sub
Public Sub IDFix()
Dim a, b, t As Integer
For i = 0 To 35
  LWID(i) = i
Next
Randomize
For i = 1 To 100
a = Int(Rnd * 36)
b = Int(Rnd * 36)
t = LWID(a)
LWID(a) = LWID(b)
LWID(b) = t
Next
End Sub

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

Private Sub lWord_Click(Index As Integer)
If Not tmr.Enabled Then Exit Sub
If Index = LastShow Then Exit Sub
If LBS(LWID(Index)) Then Exit Sub
ClickRemain = ClickRemain - 1
If LastShow = -1 Then
  lWord(Index).Caption = LBC(LWID(Index))
  LastShow = Index
Else
  lWord(Index).Caption = LBC(LWID(Index))
  If LBN(LWID(LastShow)) = LBN(LWID(Index)) Then
    LBS(LWID(LastShow)) = True
    LBS(LWID(Index)) = True
    lWord(LastShow).BackColor = vbBlue
    lWord(Index).BackColor = vbBlue
    LastShow = -1
    gameMark = gameMark + LevelNO * 100
    lblNO(1).Caption = gameMark
    Call FunTalk(0)
    Call Victory
  Else
    lWord(LastShow).Caption = "◎"
    LastShow = Index
    Call FunTalk(1)
    Call Defeat
  End If
End If
End Sub
Public Sub Victory()
Dim ok As Boolean
ok = True
For i = 0 To 35
  If LBS(i) = False Then ok = False
Next
If Not ok Then Exit Sub
gameMark = gameMark + TimeRemain * LevelNO * 2
gameMark = gameMark + ClickRemain * LevelNO * 5
lblNO(1).Caption = gameMark
s = sndPlaySound(App.Path & "\snd\cheer.wav", 1)
If LevelNO < 20 Then MsgBox "“怎么默写完了？再来一次。”", vbOKOnly, "过关"
Call NewLevel
End Sub

Private Sub tmr_Timer()
TimeRemain = TimeRemain - 1
shpTime.Height = Int(TimeRemain / (600 - LevelNO * 10) * 244)
shpTime.Top = 252 - shpTime.Height
shpClick.Height = Int(ClickRemain / (200 - LevelNO * 2) * 244)
shpClick.Top = 252 - shpClick.Height
Call Defeat
End Sub
Public Sub Defeat()
If TimeRemain = 0 Then
  s = sndPlaySound(App.Path & "\snd\hang.wav", 1)
  MsgBox "都已经下课了，看来是没指望了。", vbOKOnly, "失败"
  Call DoSummary
End If
If ClickRemain = 0 Then
  s = sndPlaySound(App.Path & "\snd\hang.wav", 1)
  MsgBox "根本就是在乱猜，看来是没指望了。", vbOKOnly, "失败"
  Call DoSummary
End If
End Sub
Public Sub FunTalk(ByVal kind As Integer)
Randomize
With lblFun
Select Case Int(Rnd * 6 + 1) + kind * 6
Case 1
  .Caption = "Good match!"
Case 2
  .Caption = "Excellent work!"
Case 3
  .Caption = "Oh! Splendid!"
Case 4
  .Caption = "Always..."
Case 5
  .Caption = "That would be fine."
Case 6
  .Caption = "About to win!"
Case 7
  .Caption = "Bad luck!"
Case 8
  .Caption = "Why!"
Case 9
  .Caption = "May god bless me!"
Case 10
  .Caption = "What's the matter?"
Case 11
  .Caption = "And then?"
Case 12
  .Caption = "Need some help?"
End Select
End With
End Sub