📄 frmmain.frm
字号:
VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Begin VB.Form FrmMain
BorderStyle = 1 'Fixed Single
ClientHeight = 5955
ClientLeft = 150
ClientTop = 435
ClientWidth = 8460
Icon = "FrmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5955
ScaleWidth = 8460
StartUpPosition = 1 '所有者中心
Begin VB.Timer TmrMidi
Interval = 5000
Left = 8025
Top = 4050
End
Begin VB.Timer TmrPlus
Enabled = 0 'False
Interval = 50
Left = 8025
Top = 4500
End
Begin VB.Timer TmrMain
Enabled = 0 'False
Interval = 1000
Left = 8025
Top = 4950
End
Begin VB.PictureBox PicB
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 5055
Left = 4200
MouseIcon = "FrmMain.frx":3072
ScaleHeight = 5055
ScaleWidth = 3735
TabIndex = 0
Top = 360
Width = 3735
End
Begin MCI.MMControl MCL_MIDI
Height = 315
Left = 2475
TabIndex = 9
Top = 4800
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 556
_Version = 393216
PrevVisible = 0 'False
NextVisible = 0 'False
BackVisible = 0 'False
StepVisible = 0 'False
RecordVisible = 0 'False
EjectVisible = 0 'False
DeviceType = ""
FileName = ""
End
Begin VB.Label LblTotle
ForeColor = &H80000002&
Height = 240
Left = 1200
TabIndex = 8
Top = 75
Width = 2040
End
Begin VB.Label LblChance
ForeColor = &H8000000D&
Height = 240
Left = 3675
TabIndex = 7
Top = 5610
Width = 1365
End
Begin VB.Label LblFinished
ForeColor = &H8000000D&
Height = 255
Left = 5250
TabIndex = 6
Top = 5610
Width = 3060
End
Begin VB.Label Label1
Caption = "在右图中选出5处与左图不同的地方"
ForeColor = &H80000002&
Height = 255
Left = 4200
TabIndex = 5
Top = 75
Width = 3135
End
Begin VB.Label LblTime
Alignment = 1 'Right Justify
ForeColor = &H8000000D&
Height = 255
Left = 3000
TabIndex = 4
Top = 5610
Width = 270
End
Begin VB.Label LbltimeInt
Caption = "剩余时间："
ForeColor = &H8000000D&
Height = 255
Left = 1950
TabIndex = 3
Top = 5610
Width = 960
End
Begin VB.Label LblScore
Alignment = 1 'Right Justify
Caption = "0"
ForeColor = &H8000000D&
Height = 255
Left = 1125
TabIndex = 2
Top = 5610
Width = 645
End
Begin VB.Label LblScoreInt
Caption = "当前分数："
ForeColor = &H8000000D&
Height = 255
Left = 150
TabIndex = 1
Top = 5625
Width = 915
End
Begin VB.Image ImgA
Height = 5175
Left = 225
Top = 360
Width = 3855
End
Begin VB.Menu M_File
Caption = "文件(&F)"
Begin VB.Menu M_New
Caption = "重新开始(&N)"
End
Begin VB.Menu M_Exit
Caption = "退出(&X)"
End
End
Begin VB.Menu M_Help
Caption = "帮助(&H)"
Begin VB.Menu M_About
Caption = "关于(&A)"
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub Form_Load()
If Not First Then '第一次玩游戏
Randomize
'====================================================
'读取最高分
Open App.Path + "\dat\score.txt" For Input As #1
Input #1, Totle '从文件中读入图片总数
For I = 0 To 4
Input #1, Record(I).Na
Input #1, Record(I).Sc
Next I
Close #1
'====================================================
First = True '标记已不是初次游戏
Me.Caption = Pname + "版本" + Ver '显示标题
ReDim Played(Totle) '重新定义数组
PicB.DrawWidth = 4
Init_Mid '初始化背景音乐
End If
For I = 0 To Totle - 1 '新游戏中没有1张图片被玩过
Played(I) = False
Next I
Fin = 1 '完成的图片数初始化
GameOver = False '游戏没有结束
Score = 0 '分数初始化
LblScore.Caption = 0 '显示分数
Init '初始化新的一版
End Sub
Private Sub Form_Unload(Cancel As Integer) '退出程序过程
rt = MsgBox("是否要结束游戏", vbYesNo, Pname & Ver)
If rt = vbNo Then
Cancel = 1
If GameOver Then Form_Load '如果游戏结束了，重新开始
Else '如果结束游戏，则把分数写入文件
Open App.Path + "\dat\score.txt" For Output As #1
Print #1, Totle
For I = 0 To 4
Print #1, Record(I).Na
Print #1, Record(I).Sc
Next I
Close #1
Unload FrmAbout
Unload FrmHighScore
End If
End Sub
'==========================游戏过程=================================
Private Sub PicB_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Right As Boolean '判断是否选中
Dim Num As Byte '点的序号
Right = False '假设没有选中
For I = 0 To 4 '对所有的点进行分析
If (X - Px(I)) * (X - Px(I)) + (Y - Py(I)) * (Y - Py(I)) < MaxP And Flag(I) Then
'在允许的误差分为之内，且该点未被选中
Right = True '标记有点被选中
Flag(I) = False '这个点已被选中
Num = I '记录序号
Exit For '有一点被选中就退出
End If
Next I
If Right Then '选择正确
Score = Score + 1000 '加分
Finished = Finished + 1 '完成点数++
LblScore.Caption = Score '显示分数
PicB.Circle (Px(Num), Py(Num)), 200, RGB(255, 0, 0) '在正确的地方画一个圈
Select Case Finished '根据完成的点数鼓励玩家
Case 1, 2
st = "呵呵，不错嘛！"
Case 3, 4
st = "再努力一点！"
Case 5
st = "恭喜你过版！"
End Select
LblFinished.Caption = "进度 " & Finished & "/5" & " " & st '显示当前进度
If Finished = 5 Then '这版已经完成了
MsgBox " 恭喜你过关", , Pname & Ver
TmrMain.Enabled = False '主计时器暂停
Next_Pic '进入下一张图片
End If
Else '选择错误
Chance_Left = Chance_Left - 1 '剩余机会数--
LblChance.Caption = "还剩" & Chance_Left & "次机会" '显示剩余机会数
'============================在鼠标的附近画一个大差==================================
PicB.Line (X - 200, Y - 200)-(X + 200, Y + 200), RGB(255, 0, 0)
PicB.Line (X + 200, Y - 200)-(X - 200, Y + 200), RGB(255, 0, 0)
'====================================================================================
If Chance_Left = 0 Then Game_Over '剩余机会为0时结束游戏
End If
End Sub
Private Sub Init() '初始化新的一版
N = Int(Rnd * Totle) + 1
Do While Played(N) '随机产生一张没有玩过的图片
N = Int(Rnd * Totle) + 1
Loop
Nth = Trim(Str(N)) '文件序号
Played(N) = True '标记这张图片已被玩过
'=======================读取文件===============================
FileName = App.Path + "\pic\" + Nth + "a.jpg" '原图
ImgA.Picture = LoadPicture(FileName)
ImgA.Left = (FrmMain.ScaleWidth / 2 - ImgA.Width) / 2 '……
FileName = App.Path + "\pic\" + Nth + "b.jpg" '现图
PicB.Picture = LoadPicture(FileName)
PicB.Left = 2 * ImgA.Left + ImgA.Width '……
FileName = App.Path + "\dat\" + Nth + ".txt" '读取坐标文件
Open FileName For Input As #1
For I = 0 To 4
Flag(I) = True '初始化点
Input #1, Px(I), Py(I) '将点的坐标读入变量
Next I
Close #1
'========================初始化设置==============================
Chance_Left = MaxChance '设置剩余机会数
LblChance.Caption = "还剩" & MaxChance & "次机会" '显示剩余机会数
LblFinished.Caption = "进度 0/5 仔细看看！还有很多呢！" '显示进度
Finished = 0 '完成的点数
Time_Left = MaxTime '设置剩余时间
LblTime.Caption = Time_Left '显示剩余时间
Chance_Left = MaxChance '设置剩余机会数
LblChance.Caption = "还剩" & MaxChance & "次机会" '显示剩余机会数
LblTotle.Caption = "这是第" & Fin & "关，共" & Totle & "关" '显示当前状态
PicB.Enabled = True
TmrMain.Enabled = True '主计时器开始
'=================================================================
End Sub
'============================计时器相关==============================
Private Sub TmrMain_Timer() '主时间器
If DoEvents = 1 Then
If Time_Left > 0 Then
Time_Left = Time_Left - 1 '剩余时间--
LblTime.Caption = Time_Left '显示剩余时间
Else
TmrMain.Enabled = False
Game_Over '时间到了就gameover
End If
End If
End Sub
Private Sub TmrMidi_Timer() '用于检测背景音乐是否播放完毕
If MCL_MIDI.Mode = mciModeStop Then
MCL_MIDI.From = 0
MCL_MIDI.Command = "Play" '循环播放音乐
End If
End Sub
Private Sub TmrPlus_Timer() '加分系统
If Time_Left > 0 Then
Time_Left = Time_Left - 1 '扣剩余时间
LblTime.Caption = Time_Left '显示剩余时间
Score = Score + 50 '根据剩余的时间加分，1s=50分
LblScore.Caption = Score '显示分数
ElseIf Fin < Totle Then '还没有全部完成
Fin = Fin + 1 '完成的图片数++
Init '完成加分，初始化新图片
TmrPlus.Enabled = False
Else '全部完成
Game_Over '结束游戏
TmrPlus.Enabled = False
End If
End Sub
'=============================菜单相关==================================
Private Sub M_Exit_Click() '菜单退出
Unload Me
End Sub
Private Sub M_About_Click() '菜单关于
Unload FrmAbout
FrmAbout.Show '显示关于
End Sub
Private Sub M_New_Click() '重新开始游戏
rt = MsgBox("是否要重新开始游戏?", vbYesNo, Pname & Ver)
If rt = vbYes Then
TmrPlus.Enabled = False
TmrMain.Enabled = False
Game_Over
End If
End Sub
'======================================================================
'==========================其他过程====================================
Private Sub Next_Pic() '下一版
TmrMain.Enabled = False '停止主计时器
If Fin <= Totle Then '如果还没全部完成
PicB.Enabled = False
TmrPlus.Enabled = True '加分系统
' Else
'TmrPlus.Enabled = True
'Game_Over '结束游戏过程
End If
End Sub
Private Sub Game_Over() '游戏结束过程
GameOver = True '游戏结束了
MsgBox "游戏结束，感谢你的使用！", , Pname & Ver
If Score > Record(4).Sc Then '分数进入排行榜
ch = InputBox("你已经成为五大高手之一，请输入你的姓名", "输入姓名", "No.1")
If ch = "" Then ch = "无名氏"
Record(4).Sc = Score '假设为最后一位
Record(4).Na = ch
Sort_Score '对分数进行排序
End If
FrmHighScore.Show '显示最高分
End Sub
Public Sub Init_Mid() '初始化背景音乐
FileName = App.Path + "\sound\1.mid" '背景音乐路径
MCL_MIDI.DeviceType = "sequencer" 'Mid
MCL_MIDI.FileName = FileName '建立文件关联
MCL_MIDI.Command = "OPEN" '打开
MCL_MIDI.Command = "PLAY" '播放
End Sub
Private Sub Sort_Score() '分数排序过程
'数据较小，采用插入排序法
For I = 1 To 4
tsc = Record(I).Sc
tna = Record(I).Na
J = I
Do While J > 0 And tsc > Record(J - 1).Sc
Record(J).Sc = Record(J - 1).Sc
Record(J).Na = Record(J - 1).Na
J = J - 1
Loop
Record(J).Sc = tsc
Record(J).Na = tna
Next I
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -