flessons.frm

一个用VB编的小游戏

VERSION 5.00
Begin VB.Form fLessons 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "综合／连课时"
   ClientHeight    =   4800
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6000
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   320
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   400
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmd 
      Caption         =   "14喂，游戏已经开始了哟！"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   1080
      TabIndex        =   1
      Top             =   4200
      Width           =   3855
   End
   Begin VB.PictureBox picTemp 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   0  'None
      Height          =   600
      Left            =   3840
      ScaleHeight     =   40
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   80
      TabIndex        =   0
      Top             =   1920
      Visible         =   0   'False
      Width           =   1200
   End
   Begin VB.Timer tmr 
      Enabled         =   0   'False
      Interval        =   300
      Left            =   120
      Top             =   4080
   End
   Begin VB.PictureBox picSquare 
      BackColor       =   &H00C0C0C0&
      Height          =   3675
      Left            =   570
      ScaleHeight     =   241
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   321
      TabIndex        =   3
      Top             =   120
      Width           =   4875
      Begin VB.CommandButton cmdHlp 
         Caption         =   "帮助"
         Height          =   1800
         Left            =   1560
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   960
         Width           =   1800
      End
   End
   Begin VB.CommandButton cmd 
      Caption         =   "22我已经坚持不住了。"
      Height          =   375
      Index           =   1
      Left            =   1080
      TabIndex        =   2
      Top             =   4200
      Visible         =   0   'False
      Width           =   3855
   End
   Begin VB.Shape shpTime 
      BackColor       =   &H0000FF00&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00808080&
      Height          =   3660
      Left            =   120
      Top             =   120
      Width           =   375
   End
   Begin VB.Shape shpClick 
      BackColor       =   &H0000FF00&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00808080&
      Height          =   3660
      Left            =   5520
      Top             =   120
      Width           =   375
   End
   Begin VB.Label lbl 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "时间"
      ForeColor       =   &H00800000&
      Height          =   180
      Index           =   0
      Left            =   120
      TabIndex        =   11
      Top             =   3840
      Width           =   360
   End
   Begin VB.Label lbl 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "考试"
      ForeColor       =   &H00800000&
      Height          =   180
      Index           =   1
      Left            =   5520
      TabIndex        =   10
      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        =   9
      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        =   8
      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        =   7
      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        =   6
      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        =   5
      Top             =   4560
      Width           =   6015
   End
End
Attribute VB_Name = "fLessons"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim wa(1 To 16) As Boolean
Dim wb(1 To 12) As Boolean
Dim gameLevel As Integer
Dim gameMark As Long
Dim TimeRemain As Integer
Dim NOToWin As Integer
Dim TimeTable(1 To 16, 1 To 12) As Integer
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
  cmd(0).Visible = False
  cmd(1).Visible = True
  cmdHlp.Visible = False
  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\lessonb.bmp")
cmdHlp.Picture = LoadPicture(App.Path & "\pic\lessonb.bmp")
gameMark = 0
gameLevel = 0
End Sub
Public Sub NewLevel()
tmr.Enabled = False
If gameLevel < 20 Then
  gameLevel = gameLevel + 1
Else
  MsgBox "“连续考试这么多场！”" & RL & "您可以继续游戏以得到高分，或退出游戏。", vbOKOnly, "恭喜"
End If
lblNO(0).Caption = gameLevel
gameMark = gameMark + TimeRemain * gameLevel
lblNO(1).Caption = gameMark
NOToWin = gameLevel * 4 + 60
TimeRemain = 350 - gameLevel * 10
Randomize
For i = 1 To 16
  For j = 1 To 12
    TimeTable(i, j) = Int(Rnd * 7) + 1
  Next
Next
Call RoomDraw
tmr.Enabled = True
End Sub
Public Sub DoSummary()
tmr.Enabled = False
GetMark = gameMark
CourseMark = gameLevel * 2 + Int(GetMark / 10000)
CourseLevel = gameLevel
tmr.Enabled = False
MsgBox "您辛苦了！", vbOKOnly, "：Ｐ"
Unload Me
End Sub
Public Sub RoomDraw()
hs = picTemp.hdc
hd = picSquare.hdc
For i = 1 To 16
  For j = 1 To 12
    a = ((TimeTable(i, j) - 1) Mod 4) * 20
    b = Int((TimeTable(i, j) - 1) / 4) * 20
    If TimeTable(i, j) > 0 Then
      X = BitBlt(hd, i * 20 - 20, j * 20 - 20, 20, 20, hs, a, b, SRCCOPY)
    Else
      X = BitBlt(hd, i * 20 - 20, j * 20 - 20, 20, 20, hs, 60, 20, SRCCOPY)
    End If
  Next
Next
End Sub

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

Private Sub picSquare_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim m, n, s As Integer
Dim ok As Boolean
m = Int(X / 20) + 1
n = Int(Y / 20) + 1
If m > 16 Or n > 12 Then Exit Sub
If m = 0 Or n = 0 Then Exit Sub
s = 0
c = TimeTable(m, n)
If c = 0 Then Exit Sub
Call ClearOne(m, n, s, c)
Call GDrop
Call GDrop
Call GDrop
Call EDrop
Call EDrop
Call EDrop
If s >= 5 Then a = 1 Else a = 6 - s
X = sndPlaySound(App.Path & "\snd\pain" & a & ".wav", 1)
gameMark = gameMark + gameLevel * s * s * 5
NOToWin = NOToWin - s
If NOToWin <= 0 Then
  X = sndPlaySound(App.Path & "\snd\csigh.wav", 0)
  MsgBox "“天哪！还要考试！”", vbOKOnly, "过关"
  Call NewLevel
End If
lblNO(1).Caption = gameMark
End Sub
Private Sub tmr_Timer()
Call RoomDraw
TimeRemain = TimeRemain - 1
shpTime.Height = Int(TimeRemain / (350 - gameLevel * 10) * 244)
shpTime.Top = 252 - shpTime.Height
If gameLevel * 4 + 60 >= NOToWin Then shpClick.Height = Int((gameLevel * 4 + 60 - NOToWin) / (gameLevel * 4 + 60) * 244)
shpClick.Top = 252 - shpClick.Height
If TimeRemain = 0 Then
  MsgBox "“终于结束了！”", vbOKOnly, "失败"
  Call DoSummary
End If
End Sub
Public Function NearBy(ByVal X As Integer, ByVal Y As Integer, ByVal way As Integer, ByVal Wcolor As Integer) As Boolean
'way 1Up2Down3Left4Right
Dim ok As Boolean
ok = False
Select Case way
Case 1
  If Y > 1 Then
    If (Wcolor = TimeTable(X, Y - 1)) Then ok = True
  End If
Case 2
  If Y < 12 Then
  If (Wcolor = TimeTable(X, Y + 1)) Then ok = True
  End If
Case 3
  If X > 1 Then
  If (Wcolor = TimeTable(X - 1, Y)) Then ok = True
  End If
Case 4
  If X < 16 Then
  If (Wcolor = TimeTable(X + 1, Y)) Then ok = True
  End If
End Select
NearBy = ok
End Function
Public Sub ClearOne(ByVal X As Integer, ByVal Y As Integer, s As Integer, ByVal Wcolor As Integer)
Dim ok As Boolean
ok = False
For i = 1 To 4
  If NearBy(X, Y, i, Wcolor) Then ok = True
Next
If ok Or s >= 1 Then
  TimeTable(X, Y) = 0
  s = s + 1
For i = 1 To 4
  a = NearBy(X, Y, i, Wcolor)
  If a Then
  Select Case i
  Case 1
  Call ClearOne(X, Y - 1, s, Wcolor)
  Case 2
  Call ClearOne(X, Y + 1, s, Wcolor)
  Case 3
  Call ClearOne(X - 1, Y, s, Wcolor)
  Case 4
  Call ClearOne(X + 1, Y, s, Wcolor)
  End Select
  End If
Next
End If
End Sub
Public Sub GDrop()
j = 12
Do
  For i = 1 To 16
    If TimeTable(i, j) = 0 Then
      For k = j To 2 Step -1
        TimeTable(i, k) = TimeTable(i, k - 1)
      Next
      TimeTable(i, 1) = 0
    End If
  Next
  j = j - 1
Loop Until j = 1
End Sub
Public Sub EDrop()
i = 1
Do
  If (TimeTable(i, 11) = 0) Then
  TimeTable(i, 12) = 0
  For j = 1 To 12
    For k = i To 15 Step 1
      TimeTable(k, j) = TimeTable(k + 1, j)
    Next
  TimeTable(16, j) = 0
  Next
  End If
  i = i + 1
Loop Until i = 16
End Sub