Browse Source

v1.6

master v1.6
Dnomd343 5 years ago
parent
commit
8e30f52858
  1. BIN
      Engine.exe
  2. 44
      Form_Favourite_Add.frm
  3. 50
      Form_Game.frm
  4. 278
      Form_Solution.frm
  5. BIN
      Form_Solution.frx
  6. 94
      Form_Wait.frm
  7. 4
      HRD_Game.vbp
  8. 2
      HRD_Game.vbw
  9. 2
      Module.bas

BIN
Engine.exe

Binary file not shown.

44
Form_Favourite_Add.frm

@ -96,15 +96,6 @@ Dim click_mouse_x As Integer, click_mouse_y As Integer
Dim click_x As Integer, click_y As Integer, mouse_button As Integer, print_now As Boolean Dim click_x As Integer, click_y As Integer, mouse_button As Integer, print_now As Boolean
Dim delta_x As Integer, delta_y As Integer, locked_x As Integer, locked_y As Integer Dim delta_x As Integer, delta_y As Integer, locked_x As Integer, locked_y As Integer
Dim limit(-1 To 1, -1 To 1) As Boolean Dim limit(-1 To 1, -1 To 1) As Boolean
Private Sub Form_DblClick()
If mouse_button = 2 Then
Call Case_init
Call Output_Graph
Text_Code = ""
End If
End Sub
Private Sub Form_Load() Private Sub Form_Load()
start_x = 120 start_x = 120
start_y = 120 start_y = 120
@ -130,10 +121,20 @@ Private Sub Form_Load()
Text_Code = favourite_add_init_code Text_Code = favourite_add_init_code
Call Text_Code_Change Call Text_Code_Change
End Sub End Sub
Private Sub Form_Unload(Cancel As Integer)
favourite_add_save = False
End Sub
Private Sub Form_DblClick()
If mouse_button = 2 Then
Call Case_init
Call Output_Graph
Text_Code = ""
End If
End Sub
Private Sub Command_Confirm_Click() Private Sub Command_Confirm_Click()
If Text_Name = "" Then MsgBox "你还没有填名称喔", , "(⊙-⊙)": Exit Sub If Text_Name = "" Then MsgBox "你还没有填名称喔", , "(⊙-⊙)": Text_Name.SetFocus: Exit Sub
Call Analyse(UCase(Text_Code)) Call Analyse(UCase(Text_Code))
If Check = False Then MsgBox "编码出错啦", , "(⊙-⊙)": Exit Sub If Check = False Then MsgBox "编码出错啦", , "(⊙-⊙)": Text_Code.SetFocus: Exit Sub
favourite_add_confirm = True favourite_add_confirm = True
favourite_add_name = Text_Name favourite_add_name = Text_Name
favourite_add_code = Text_Code favourite_add_code = Text_Code
@ -148,18 +149,6 @@ Private Sub Command_Confirm_Click()
End If End If
Unload Form_Favourite_Add Unload Form_Favourite_Add
End Sub End Sub
Private Sub Form_Unload(Cancel As Integer)
favourite_add_save = False
End Sub
Private Sub Label_Name_Click()
Text_Name.SetFocus
End Sub
Private Sub Label_Code_Click()
Text_Code.SetFocus
End Sub
Private Sub Text_Code_Change() Private Sub Text_Code_Change()
If print_now = True Then Exit Sub If print_now = True Then Exit Sub
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
@ -171,13 +160,18 @@ Private Sub Text_Code_Change()
End If End If
End If End If
End Sub End Sub
Private Sub Label_Name_Click()
Text_Name.SetFocus
End Sub
Private Sub Label_Code_Click()
Text_Code.SetFocus
End Sub
Private Sub Text_Code_KeyPress(KeyAscii As Integer) Private Sub Text_Code_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command_Confirm_Click If KeyAscii = 13 Then Call Command_Confirm_Click
End Sub End Sub
Private Sub Text_Name_KeyPress(KeyAscii As Integer) Private Sub Text_Name_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_Code.SetFocus If KeyAscii = 13 Then Text_Code.SetFocus
End Sub End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
click_mouse_x = X click_mouse_x = X
click_mouse_y = Y click_mouse_y = Y
@ -197,7 +191,6 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A
print_now = True print_now = True
Call Form_MouseMove(Button, Shift, X, Y) Call Form_MouseMove(Button, Shift, X, Y)
End Sub End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim print_x As Integer, print_y As Integer, print_width As Integer, print_height As Integer Dim print_x As Integer, print_y As Integer, print_width As Integer, print_height As Integer
If print_now = True Then If print_now = True Then
@ -720,7 +713,6 @@ Private Sub Analyse_Code(code As String)
Next i Next i
err: err:
End Sub End Sub
Private Sub Timer_Debug_Timer() Private Sub Timer_Debug_Timer()
Dim debug_dat As String Dim debug_dat As String
Dim i As Integer, j As Integer, m As Integer Dim i As Integer, j As Integer, m As Integer

50
Form_Game.frm

@ -2,7 +2,7 @@ VERSION 5.00
Begin VB.Form Form_Game Begin VB.Form Form_Game
AutoRedraw = -1 'True AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single BorderStyle = 1 'Fixed Single
Caption = "HRD Game v1.5 by Dnomd343" Caption = "HRD Game v1.6 by Dnomd343"
ClientHeight = 7305 ClientHeight = 7305
ClientLeft = 45 ClientLeft = 45
ClientTop = 690 ClientTop = 690
@ -14,12 +14,20 @@ Begin VB.Form Form_Game
ScaleHeight = 7305 ScaleHeight = 7305
ScaleWidth = 7290 ScaleWidth = 7290
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command_Solution
Caption = "最少步解法"
Height = 495
Left = 5760
TabIndex = 13
Top = 5520
Width = 1335
End
Begin VB.CommandButton Command_Add_Favourite Begin VB.CommandButton Command_Add_Favourite
Caption = "加入收藏" Caption = "加入收藏"
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 12 TabIndex = 12
Top = 3480 Top = 3000
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Favourite Begin VB.CommandButton Command_Favourite
@ -27,7 +35,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 11 TabIndex = 11
Top = 2760 Top = 2280
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Reduction_Snapshot Begin VB.CommandButton Command_Reduction_Snapshot
@ -35,7 +43,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 10 TabIndex = 10
Top = 4680 Top = 4200
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Create_Snapshot Begin VB.CommandButton Command_Create_Snapshot
@ -43,7 +51,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 9 TabIndex = 9
Top = 4080 Top = 3600
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Rand_Case Begin VB.CommandButton Command_Rand_Case
@ -51,7 +59,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 8 TabIndex = 8
Top = 2160 Top = 1680
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Select_Case Begin VB.CommandButton Command_Select_Case
@ -59,7 +67,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 7 TabIndex = 7
Top = 1560 Top = 1080
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Create_Case Begin VB.CommandButton Command_Create_Case
@ -67,7 +75,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 6 TabIndex = 6
Top = 960 Top = 480
Width = 1335 Width = 1335
End End
Begin VB.Timer Timer_Layout Begin VB.Timer Timer_Layout
@ -80,7 +88,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 1 TabIndex = 1
Top = 5280 Top = 4800
Width = 1335 Width = 1335
End End
Begin VB.Timer Timer_Get_Time Begin VB.Timer Timer_Get_Time
@ -138,7 +146,8 @@ Begin VB.Form Form_Game
Begin VB.Menu Menu_Setting Begin VB.Menu Menu_Setting
Caption = "设置" Caption = "设置"
Begin VB.Menu Menu_On_Top Begin VB.Menu Menu_On_Top
Caption = "窗口保持最前" Caption = "保持窗口最前"
Checked = -1 'True
End End
Begin VB.Menu Menu_Debug_Mode Begin VB.Menu Menu_Debug_Mode
Caption = "Debug模式" Caption = "Debug模式"
@ -169,10 +178,7 @@ Dim block_addr(0 To 2) As Block_Address, move_max_step As Integer
Dim mouse_x As Long, mouse_y As Long, mouse_button As Integer Dim mouse_x As Long, mouse_y As Long, mouse_button As Integer
Dim last_move As Integer, move_times As Integer Dim last_move As Integer, move_times As Integer
Dim total_steps As Long, total_time As Long Dim total_steps As Long, total_time As Long
Dim Start_Code As String
Dim snapshot_code As String, snapshot_step As Long Dim snapshot_code As String, snapshot_step As Long
Private Sub Menu_Debug_Mode_Click() Private Sub Menu_Debug_Mode_Click()
Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked
If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False
@ -187,6 +193,8 @@ Private Sub Menu_On_Top_Click()
End If End If
End Sub End Sub
Private Sub Form_Load() Private Sub Form_Load()
debug_mode = False
on_top = True
Call init Call init
End Sub End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
@ -283,7 +291,7 @@ Private Sub Form_Click()
Timer_Get_Time = False Timer_Get_Time = False
playing = False playing = False
solve_compete = True solve_compete = True
MsgBox "恭喜你成功完成!" & vbCrLf & "编码: " & Start_Code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "(>__<)" MsgBox "恭喜你成功完成!" & vbCrLf & "编码: " & start_code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "(>__<)"
End If End If
End Sub End Sub
Private Sub Command_Create_Case_Click() Private Sub Command_Create_Case_Click()
@ -299,6 +307,9 @@ Private Sub Command_Favourite_Click()
favourite_add_confirm = False favourite_add_confirm = False
Form_Favourite.Show 1 Form_Favourite.Show 1
End Sub End Sub
Private Sub Command_Solution_Click()
Form_Solution.Show 1
End Sub
Private Sub Command_Add_Favourite_Click() Private Sub Command_Add_Favourite_Click()
favourite_add_save = True favourite_add_save = True
favourite_add_init_code = Label_Code favourite_add_init_code = Label_Code
@ -330,9 +341,9 @@ Private Sub Command_Reset_Click()
Timer_Get_Time.Enabled = False Timer_Get_Time.Enabled = False
Call init Call init
Label_Step = "步数: 0" Label_Step = "步数: 0"
Label_Code = Start_Code Label_Code = start_code
Label_Time = "用时: 0:00:00" Label_Time = "用时: 0:00:00"
Call Analyse(Start_Code) Call Analyse(start_code)
Call Output_Graph Call Output_Graph
End Sub End Sub
Private Sub init() Private Sub init()
@ -366,6 +377,7 @@ Private Sub init()
y_split(3) = start_y + gap / 2 + (square_width + gap) * 3 y_split(3) = start_y + gap / 2 + (square_width + gap) * 3
y_split(4) = start_y + gap / 2 + (square_width + gap) * 4 y_split(4) = start_y + gap / 2 + (square_width + gap) * 4
y_split(5) = start_y + gap + (square_width + gap) * 5 y_split(5) = start_y + gap + (square_width + gap) * 5
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
End Sub End Sub
Private Sub Move_Block(m As Integer, dir_x As Integer, dir_y As Integer) Private Sub Move_Block(m As Integer, dir_x As Integer, dir_y As Integer)
Dim addr As Integer, style As Integer, X As Integer, Y As Integer Dim addr As Integer, style As Integer, X As Integer, Y As Integer
@ -959,11 +971,11 @@ Private Sub Timer_Layout_Timer()
change_case = False change_case = False
Label_Title.Caption = change_case_title & "(" & change_case_code & ")" Label_Title.Caption = change_case_title & "(" & change_case_code & ")"
Call init Call init
Start_Code = change_case_code start_code = change_case_code
Label_Step = "步数: 0" Label_Step = "步数: 0"
Label_Code = Start_Code Label_Code = start_code
Label_Time = "用时: 0:00:00" Label_Time = "用时: 0:00:00"
Call Analyse(Start_Code) Call Analyse(start_code)
Call Output_Graph Call Output_Graph
End If End If
End Sub End Sub

278
Form_Solution.frm

@ -0,0 +1,278 @@
VERSION 5.00
Begin VB.Form Form_Solution
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "最少步解法"
ClientHeight = 5145
ClientLeft = 45
ClientTop = 390
ClientWidth = 5295
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5145
ScaleWidth = 5295
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer_Play
Enabled = 0 'False
Interval = 1000
Left = 0
Top = 0
End
Begin VB.CommandButton Command_Last
Caption = ">︱"
Height = 470
Left = 3000
TabIndex = 5
Top = 4560
Width = 615
End
Begin VB.CommandButton Command_Next
Caption = ">"
Height = 470
Left = 2400
TabIndex = 4
Top = 4560
Width = 615
End
Begin VB.CommandButton Command_Pause
Caption = "播放"
Height = 470
Left = 1320
TabIndex = 3
Top = 4560
Width = 1095
End
Begin VB.CommandButton Command_Previous
Caption = "<"
Height = 470
Left = 720
TabIndex = 2
Top = 4560
Width = 615
End
Begin VB.CommandButton Command_First
Caption = "︱<"
Height = 470
Left = 120
TabIndex = 1
Top = 4560
Width = 615
End
Begin VB.ListBox List_Solution
Height = 4560
ItemData = "Form_Solution.frx":0000
Left = 3720
List = "Form_Solution.frx":0002
TabIndex = 0
Top = 360
Width = 1455
End
Begin VB.Timer Timer_Get_Data
Interval = 50
Left = 0
Top = 0
End
Begin VB.Label Label_Index
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 6
Top = 120
Width = 90
End
End
Attribute VB_Name = "Form_Solution"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type Case_Block
address As Integer
style As Integer
End Type
Dim wait_data As Boolean
Dim Block(0 To 9) As Case_Block
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load()
start_x = 135
start_y = 135
square_width = 770
gap = 75
If on_top = True Then
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
Else
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
End If
wait_file_name = start_code & ".txt"
If Dir(start_code & ".txt") <> "" Then Kill start_code & ".txt"
Shell "Engine.exe -q " & start_code
wait_cancel = False
waiting = True
wait_data = True
Form_Wait.Show 1
End Sub
Private Sub Command_First_Click()
List_Solution.ListIndex = 0
End Sub
Private Sub Command_Last_Click()
List_Solution.ListIndex = List_Solution.ListCount - 1
End Sub
Private Sub Command_Previous_Click()
If List_Solution.ListIndex > 0 Then
List_Solution.ListIndex = List_Solution.ListIndex - 1
End If
End Sub
Private Sub Command_Next_Click()
If List_Solution.ListIndex < List_Solution.ListCount - 1 Then
List_Solution.ListIndex = List_Solution.ListIndex + 1
End If
End Sub
Private Sub Command_Pause_Click()
If Timer_Play.Enabled = False Then
Command_Pause.Caption = "暂停"
Timer_Play.Enabled = True
Else
Command_Pause.Caption = "播放"
Timer_Play.Enabled = False
End If
End Sub
Private Sub List_Solution_Click()
If Not Label_Index = "无解" Then Label_Index = "(" & List_Solution.ListIndex & "/" & List_Solution.ListCount - 1 & ")"
Label_Index.Left = List_Solution.Left + (List_Solution.width - Label_Index.width) / 2
Call Analyse_Code(List_Solution.List(List_Solution.ListIndex))
Call Output_Graph
End Sub
Private Sub Timer_Play_Timer()
If List_Solution.ListIndex = List_Solution.ListCount - 1 Then
Command_Pause.Caption = "播放"
Timer_Play.Enabled = False
End If
Call Command_Next_Click
End Sub
Private Sub Timer_Get_Data_Timer()
If wait_data = True And waiting = False Then
wait_data = False
Call Get_Data(start_code & ".txt")
End If
End Sub
Private Sub Get_Data(file_name As String)
Dim temp As String, i As Integer, num As Integer
Open file_name For Input As #1
Line Input #1, temp
If temp = "No Solution" Then
MsgBox "无解啊啊啊", , "> _ <"
Label_Index.Caption = "无解"
List_Solution.AddItem start_code
Else
num = Int(temp)
MsgBox "只要" & num & "步就行啦", , "> _ <"
For i = 0 To num
Line Input #1, temp
List_Solution.AddItem temp
Next i
End If
Close #1
List_Solution.ListIndex = 0
End Sub
Private Sub Output_Graph()
Dim m, X, Y As Integer
Dim width As Integer, height As Integer
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
For m = 0 To 9
If Block(m).address <> 25 Then
X = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
Y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
If Block(m).style = 0 Or Block(m).style = 1 Then
width = square_width * 2 + gap
Else
width = square_width
End If
If Block(m).style = 0 Or Block(m).style = 2 Then
height = square_width * 2 + gap
Else
height = square_width
End If
Print_Block X, Y, width, height, block_line_width, block_color, block_line_color
End If
Next m
End Sub
Private Sub Print_Block(print_start_x, print_start_y, print_width, print_height, print_line_width, print_color, print_line_color)
If print_width < 0 Or print_height < 0 Then Exit Sub
FillStyle = 0
DrawWidth = print_line_width
FillColor = print_color
Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B
Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B
End Sub
Private Sub Analyse_Code(code As String)
On Error Resume Next
Dim temp(1 To 12) As Integer
Dim i, addr, style As Integer
Dim type_1, type_2, type_3 As Integer
Dim Table(0 To 19) As Integer
Dim num As Integer, b1 As Integer, b2 As Integer
Dim dat As String
For i = 1 To 6
dat = Mid(code, i + 1, 1)
If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat)
If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
b1 = num Mod 4
b2 = (num - b1) / 4 Mod 4
temp(i * 2 - 1) = b2
temp(i * 2) = b1
Next i
type_1 = 0: type_2 = 0: type_3 = 5
For i = 0 To 19
Table(i) = 69
Next i
For i = 0 To 9
Block(i).address = 69
Block(i).style = 69
Next i
dat = Left(code, 1)
If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat)
If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
Block(0).address = num
Block(0).style = 0
If Block(0).address > 14 Then GoTo err
Table(Block(0).address) = 0
Table(Block(0).address + 1) = 0
Table(Block(0).address + 4) = 0
Table(Block(0).address + 5) = 0
addr = 0
For i = 1 To 11
Do While Table(addr) <> 69
If addr < 19 Then
addr = addr + 1
Else
Exit Do
End If
Loop
style = temp(i)
If style = 0 Then
Table(addr) = 10
ElseIf style = 1 Then
If type_2 < 5 Then type_2 = type_2 + 1
If addr > 18 Then GoTo err
Block(type_2).style = 1
Block(type_2).address = addr
Table(addr) = type_2
Table(addr + 1) = type_2
ElseIf style = 2 Then
If type_2 < 5 Then type_2 = type_2 + 1
If addr > 15 Then GoTo err
Block(type_2).style = 2
Block(type_2).address = addr
Table(addr) = type_2
Table(addr + 4) = type_2
ElseIf style = 3 Then
If type_3 < 9 Then type_3 = type_3 + 1
Block(type_3).style = 3
Block(type_3).address = addr
Table(addr) = type_3
End If
Next i
err:
End Sub

BIN
Form_Solution.frx

Binary file not shown.

94
Form_Wait.frm

@ -0,0 +1,94 @@
VERSION 5.00
Begin VB.Form Form_Wait
BorderStyle = 0 'None
ClientHeight = 1140
ClientLeft = 0
ClientTop = 0
ClientWidth = 1920
LinkTopic = "Form1"
ScaleHeight = 1140
ScaleWidth = 1920
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer_Debug
Interval = 100
Left = 0
Top = 0
End
Begin VB.TextBox Text_Debug
Appearance = 0 'Flat
Height = 650
Left = 0
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 1
Top = 480
Width = 1920
End
Begin VB.Timer Timer
Interval = 50
Left = 0
Top = 0
End
Begin VB.Label Label_Wait
AutoSize = -1 'True
Caption = " 请稍等哦... "
BeginProperty Font
Name = "微软雅黑"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 0
TabIndex = 0
Top = 0
Width = 1920
End
End
Attribute VB_Name = "Form_Wait"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
If debug_mode = True Then
Form_Wait.height = 1875
Text_Debug.Visible = True
Else
Form_Wait.height = 465
Text_Debug.Visible = False
End If
If on_top = True Then
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
Else
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
End If
wait_cancel = False
waiting = True
End Sub
Private Sub Label_Wait_DblClick()
If MsgBox("真要取消么?", vbYesNo, "> _ <") = vbNo Then Exit Sub
wait_cancel = True
waiting = False
Unload Form_Wait
End Sub
Private Sub Timer_Timer()
On Error Resume Next
If Dir(wait_file_name) <> "" Then
wait_cancel = False
waiting = False
Unload Form_Wait
End If
End Sub
Private Sub Timer_Debug_Timer()
Dim debug_dat As String
debug_dat = "wait_cancel=" & wait_cancel & vbCrLf
debug_dat = debug_dat & "wait_file_name" & vbCrLf & "=" & wait_file_name & vbCrLf
Text_Debug = debug_dat
End Sub

4
HRD_Game.vbp

@ -7,6 +7,8 @@ Form=Form_Creator.frm
Form=Form_Rand_Case.frm Form=Form_Rand_Case.frm
Form=Form_Favourite.frm Form=Form_Favourite.frm
Form=Form_Favourite_Add.frm Form=Form_Favourite_Add.frm
Form=Form_Solution.frm
Form=Form_Wait.frm
IconForm="Form_Game" IconForm="Form_Game"
Startup="Form_Game" Startup="Form_Game"
HelpFile="" HelpFile=""
@ -17,7 +19,7 @@ Name="HRD_Game"
HelpContextID="0" HelpContextID="0"
CompatibleMode="0" CompatibleMode="0"
MajorVer=1 MajorVer=1
MinorVer=5 MinorVer=6
RevisionVer=0 RevisionVer=0
AutoIncrementVer=0 AutoIncrementVer=0
ServerSupportFiles=0 ServerSupportFiles=0

2
HRD_Game.vbw

@ -5,3 +5,5 @@ Form_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, C
Form_Rand_Case = 78, 78, 855, 505, , 156, 156, 933, 583, C Form_Rand_Case = 78, 78, 855, 505, , 156, 156, 933, 583, C
Form_Favourite = 52, 52, 829, 479, , 26, 26, 803, 453, C Form_Favourite = 52, 52, 829, 479, , 26, 26, 803, 453, C
Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C
Form_Solution = 104, 104, 862, 531, , 0, 0, 758, 427, C
Form_Wait = 104, 104, 862, 531, , 78, 78, 836, 505, C

2
Module.bas

@ -23,6 +23,8 @@ Public change_case As Boolean, change_case_title As String, change_case_code As
Public Favourite_Cases_name() As String, Favourite_Cases_code() As String Public Favourite_Cases_name() As String, Favourite_Cases_code() As String
Public favourite_add_name As String, favourite_add_code As String, favourite_add_confirm As Boolean Public favourite_add_name As String, favourite_add_code As String, favourite_add_confirm As Boolean
Public favourite_add_init_name As String, favourite_add_init_code As String, favourite_add_save As Boolean Public favourite_add_init_name As String, favourite_add_init_code As String, favourite_add_save As Boolean
Public wait_file_name As String, wait_cancel As Boolean, waiting As Boolean
Public start_code As String
Public Sub FindKeys(hkey As Long, SubKey As String) Public Sub FindKeys(hkey As Long, SubKey As String)
Dim phkRet As Long, lRet As Long, index As Long, lName As Long, lReserved As Long, lClass As Long Dim phkRet As Long, lRet As Long, index As Long, lName As Long, lReserved As Long, lClass As Long
Dim name As String, Class As String Dim name As String, Class As String

Loading…
Cancel
Save