📄 form1.frm
字号:
End
Begin VB.Menu ClickStaRight
Caption = "-"
Index = 30
End
Begin VB.Menu ClickStaRight
Caption = "隐藏(&H)"
Index = 40
End
End
Begin VB.Menu System
Caption = "界面右键"
Index = 6
Visible = 0 'False
Begin VB.Menu ClickMainRight
Caption = "更换背景色...(&C)"
Index = 0
End
Begin VB.Menu ClickMainRight
Caption = "-"
Index = 10
End
Begin VB.Menu ClickMainRight
Caption = "默认背景色(&D)"
Checked = -1 'True
Index = 20
End
End
Begin VB.Menu System
Caption = "工具栏右键"
Index = 7
Visible = 0 'False
Begin VB.Menu ClickToolRight
Caption = "Office 2003样式(&O)"
Checked = -1 'True
Index = 0
End
Begin VB.Menu ClickToolRight
Caption = "设置(&Z)"
Index = 10
Begin VB.Menu ToolExt
Caption = "恢复原来样式(&H)"
Checked = -1 'True
Index = 0
End
Begin VB.Menu ToolExt
Caption = "-"
Index = 10
End
Begin VB.Menu ToolExt
Caption = "按钮背景色...(&B)"
Index = 20
End
End
Begin VB.Menu ClickToolRight
Caption = "-"
Index = 20
End
Begin VB.Menu ClickToolRight
Caption = "隐藏(&H)"
Index = 30
End
End
Begin VB.Menu System
Caption = " 帮助(&H)"
Index = 8
Begin VB.Menu Help
Caption = "目录(&D)"
Index = 0
Shortcut = {F1}
End
Begin VB.Menu Help
Caption = "联系我们(&C)..."
Index = 10
End
Begin VB.Menu Help
Caption = "-"
Index = 20
End
Begin VB.Menu Help
Caption = "关于本游戏软件(&A)..."
Index = 30
Shortcut = ^{F1}
End
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit '强制显式声明模块中的所有变量
Private Type Loc '自定义用户类型
my_Left As Integer '左
my_Top As Integer '顶
End Type
Private my_Rand() As Integer, arr() As Loc 'arr:存放所有数字;my_Rand:产生随机数
Private cnt As Integer 'Sqr(my_Level+1)
Private flag As Boolean '若不能达到目标状态时,再次调用函数时不进行第二次加载控件
Private my_Seconds As Integer '记录秒数
Private my_Done As Boolean '记录游戏是否结束
Private my_Hang As Boolean '判断是否中止自动演示
Private my_Repeat As Boolean '判断是否按下重置按钮
Private my_Loc As Integer '用于存储当前背景音乐播放曲目位置
Public my_Path As String '路径存储
Public my_Level As Integer '等级--N迷问题
Public my_Ext As Boolean '判断是否点击了自定义窗口中的确定按钮
Public maxcount As Integer '最大步数
Private Sub my_ClickWav()
If Opt(70).Checked Then Effect.Command = "close"
Effect.FileName = App.Path & "\Effect\Click.wav" '鼠标点击音效
If Opt(70).Checked Then
Effect.Command = "open"
Effect.Command = "play"
End If
End Sub
Private Sub my_FolderWav()
If Opt(70).Checked Then Effect.Command = "close"
Effect.FileName = App.Path & "\Effect\Folder.wav" '菜单音效
If Opt(70).Checked Then
Effect.Command = "open"
Effect.Command = "play"
End If
End Sub
Private Sub my_AXSwap(num1 As Object, num2 As Object) '控件交换
Dim temp As Object
Set temp = num1.Container
Set num1.Container = num2.Container
Set num2.Container = temp
End Sub
Private Sub my_NumSwap(num1 As Object, num2 As Object) '数值交换
Dim temp As String
temp = num1.Tag
num1.Tag = num2.Tag
num2.Tag = temp
End Sub
Private Sub my_Reload() '隐藏所有图片并重新加载
Dim pic As PictureBox, img As Image
For Each img In Block '针对一个Image形集合中的每个元素
img.Picture = LoadPicture()
Next
For Each pic In Num '针对一个PictureBox集合中的每个元素
pic.Visible = False
Next
Call Sys_Click(0)
End Sub
Private Sub my_Mode() '背景音乐相关设置
Dim i As Integer
For i = 1 To 5
If Play(i).Checked Then Exit For
Next
Call Play_Click(i)
BkMusic.Tag = 0 '清空标志
BkMusic.FileName = ".\music\No." & Trim(Str(my_Loc)) & ".mp3"
BkMusic.Command = "open"
BkMusic.Command = "play"
End Sub
Private Sub my_LabelColor() '统计标签字体颜色设置
Dim i As Integer
For i = 2 To 11
Label1(i).ForeColor = Label1(1).ForeColor
Next
End Sub
Private Sub my_StaColor() '统计内容字体颜色设置
Dim i As Integer
For i = 2 To 6
Sta(i).ForeColor = Sta(1).ForeColor
Next
End Sub
Private Sub my_Color() '背景色相关设置
Dim i As Integer
BackFrame.BackColor = Me.BackColor
ClickButton.BackColor = Me.BackColor
StaFrame.BackColor = Me.BackColor
For i = 1 To 11
If i <= 6 Then Sta(i).BackColor = Me.BackColor
Label1(i).BackColor = Me.BackColor
Next
End Sub
Private Sub my_MenuCheck() '菜单打勾
Dim i As Integer
For i = 0 To 40 Step 10
If i <> 30 Then
Lev1(i).Checked = False
Lev2(i).Checked = False
Lev3(i).Checked = False
Lev4(i).Checked = False
Lev5(i).Checked = False
End If
Next
End Sub
Private Sub my_Auto() '自动演示(分枝限界法)----上(1):左(2):下(3):右(4)
Dim gotoflag As Boolean, pre As Integer, my_Count As Integer, my_Min As Integer, Except As Integer, ExceptExt As Integer, temp As Integer, i As Integer, j As Integer
'gotoflag:判断是否再次进入循环体;pre:不允许回到前一个状态(上、左 + 2 = 下、右);my_Count:记录次数;my_Min:c1(x)+1的最小值;Except、ExceptExt:排除状态且最多两个状态(规定 Except<ExceptExt);temp:记录最佳状态
While 1 '死循环
PausePic.SetFocus '为了屏蔽按键
Sta(5).Caption = Sta(5).Caption + 1
my_Min = 32767 '将要记录的最小值初始化为最大值
gotoflag = False
my_Count = 0
If Block(my_Level + 1).Tag = 1 Then '左上
Except = 1
ExceptExt = 2
ElseIf Block(my_Level + 1).Tag = cnt Then '右上
Except = 1
ExceptExt = 4
ElseIf Block(my_Level + 1).Tag = (my_Level + 1) - cnt + 1 Then '左下
Except = 2
ExceptExt = 3
ElseIf Block(my_Level + 1).Tag = my_Level + 1 Then '右下
Except = 3
ExceptExt = 4
ElseIf Block(my_Level + 1).Tag > 1 And Block(my_Level + 1).Tag < cnt Then '上
Except = 1
ExceptExt = 0
ElseIf Block(my_Level + 1).Tag > (my_Level + 1) - cnt + 1 And Block(my_Level + 1).Tag < my_Level + 1 Then '下
Except = 3
ExceptExt = 0
ElseIf (Block(my_Level + 1).Tag = cnt * 2 Or Block(my_Level + 1).Tag = cnt * 3 Or Block(my_Level + 1).Tag = cnt * 4 Or Block(my_Level + 1).Tag = cnt * 5) And Block(my_Level + 1).Tag <> my_Level + 1 Then '右
Except = 4
ExceptExt = 0
ElseIf (Block(my_Level + 1).Tag = 1 + cnt * 1 Or Block(my_Level + 1).Tag = 1 + cnt * 2 Or Block(my_Level + 1).Tag = 1 + cnt * 3 Or Block(my_Level + 1).Tag = 1 + cnt * 4) And Block(my_Level + 1).Tag <> (my_Level + 1) - cnt + 1 Then '左
Except = 2
ExceptExt = 0
Else '其它情况
Except = 0
ExceptExt = 0
End If
LEDTime.Tag = Except '暂存
LEDCount.Tag = ExceptExt '暂存
For i = 1 To 4 '上,下,左,右 四状态
down: '进入最佳状态
If pre = i Then
GoTo line 'continue
ElseIf Except = i Then
If ExceptExt Then
Except = ExceptExt
ExceptExt = 0
Else
Except = 0
End If
GoTo line 'continue
End If
Select Case i
Case 1 '上
j = my_Sign(my_Level + 1, Block(my_Level + 1).Tag - cnt)
Case 2 '左
j = my_Sign(my_Level + 1, Block(my_Level + 1).Tag - 1)
Case 3 '下
j = my_Sign(my_Level + 1, Block(my_Level + 1).Tag + cnt)
Case 4 '右
j = my_Sign(my_Level + 1, Block(my_Level + 1).Tag + 1)
End Select
'''''''''''''''''''''''''''''''''''临时交换'''''''''''''''''''''''''''''''''''''''''
Call my_AXSwap(Block(j), Block(my_Level + 1)) '交换--容器
Call my_NumSwap(Block(j), Block(my_Level + 1)) '交换--标志
If gotoflag Then
If i <= 2 Then '上、左 + 2 = 下、右
pre = i + 2
Else
pre = i - 2
End If
Exit For
End If
If my_Check(my_Level + 1) = 0 Then
If Opt(70).Checked Then Effect.Command = "close"
Effect.FileName = App.Path & "\Effect\End.wav" '电脑演示完毕音效
If Opt(70).Checked Then
Effect.Command = "open"
Effect.Command = "play"
End If
Block(my_Level + 1).Picture = LoadPicture(my_Path & my_Level + 1 & ".jpg") '用图填补空格
my_Done = True '游戏已经结束
For j = 1 To 11
If j <> 10 Then ToolButton(j).Enabled = True
Next
Opt(50).Enabled = False
ToolButton(2).Enabled = Opt(50).Enabled
ClickButton.Enabled = True
Timer1.Enabled = False
MsgBox "电脑自动演示完毕...", vbExclamation, "提示" '自动演示完毕
Exit Sub
ElseIf my_Min > my_Check(my_Level + 1) Then
my_Count = my_Count + 1
my_Min = my_Check(my_Level + 1)
temp = i
End If
'''''''''''''''''''''''''''''''''''还原交换'''''''''''''''''''''''''''''''''''''''''
Call my_AXSwap(Block(j), Block(my_Level + 1)) '交换--容器
Call my_NumSwap(Block(j), Block(my_Level + 1)) '交换--标志
line: '作用:continue
Next
If i = 5 Then '四状态均已测试
If my_Count > 1 Then
i = temp
Else
Do
i = Int((4 - 1 + 1) * Rnd + 1) 'Int((最大值-最小值+1)*Rnd+最小值)
If i <> pre And i <> LEDTime.Tag And i <> LEDCount.Tag Then Exit Do
Loop
End If
gotoflag = True
GoTo down '进入最佳状态
End If
DoEvents '转让控制权，以便让操作系统处理其它的事件
If my_Hang Then Exit Sub
Call Sleep(SysForm.my_Delay) '延时时间
Wend
End Sub
Private Function my_Sign(puzzle As Integer, Num As Integer) As Integer '穷举--找出对应值
Dim i As Integer
For i = 1 To puzzle
If Num = Block(i).Tag Then Exit For
Next
my_Sign = i
End Function
Private Function my_Check(puzzle As Integer) '判断是否达到目标状态
Dim i As Integer, sum As Integer
For i = 1 To puzzle
If Block(i).Index <> Block(i).Tag Then sum = sum + 1 '算 c1(x)+1----因为把空格计算在内了(第i格中不是数字i的格子的数量)
Next
my_Check = sum
End Function
Private Sub BackgroundMusic_Click(Index As Integer)
Call my_ClickWav
Select Case Index
Case 0 '播放&暂停
If BackgroundMusic(Index).Caption = "暂停(&P)" Then
BackgroundMusic(Index).Caption = "播放(&P)"
BkMusic.Command = "stop"
Timer2.Enabled = False
ToolButton(7).Check = False
ToolButton(7).ToolTipText = "背景音乐--开(F3)"
Else
BackgroundMusic(Index).Caption = "暂停(&P)"
BkMusic.Command = "open"
BkMusic.Command = "play"
Timer2.Enabled = True
ToolButton(7).Check = True
ToolButton(7).ToolTipText = "背景音乐--关(F3)"
End If
Case 10 '停止
BkMusic.Command = "close"
BackgroundMusic(Index).Checked = True
BackgroundMusic(0).Caption = "播放(&P)"
ToolButton(7).Check = False
ToolButton(7).ToolTipText = "背景音乐--开(F3)"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -