dnomd343
/
HRD_Game
mirror of https://github.com/dnomd343/HRD_Game
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

v2.0

master v2.0
Dnomd343 5 years ago
parent
2b16affa19
commit
7b25cc179d
13 changed files with 964 additions and 903 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 51
      Form_Classic_Cases.frm
  2. BIN
      Form_Classic_Cases.frx
  3. 858
      Form_Creator.frm
  4. 40
      Form_Detail.frm
  5. 110
      Form_Favourite.frm
  6. 34
      Form_Favourite_Add.frm
  7. 545
      Form_Game.frm
  8. 62
      Form_Rand_Case.frm
  9. 37
      Form_Solution.frm
  10. 91
      Form_Start.frm
  11. 7
      HRD_Game.vbp
  12. 3
      HRD_Game.vbw
  13. 29
      Module.bas

51
Form_Classic_Cases.frm
View File

@ -25,7 +25,7 @@ Begin VB.Form Form_Classic_Cases
Alignment = 2 'Center Alignment = 2 'Center
BeginProperty Font BeginProperty Font
Name = "΢ÈíÑźÚ" Name = "΢ÈíÑźÚ"
Size = 15.75 Size = 18
Charset = 134 Charset = 134
Weight = 400 Weight = 400
Underline = 0 'False Underline = 0 'False
@ -43,14 +43,14 @@ Begin VB.Form Form_Classic_Cases
Caption = "ËÑË÷" Caption = "ËÑË÷"
Height = 255 Height = 255
Left = 2280 Left = 2280
TabIndex = 3 TabIndex = 2
Top = 480 Top = 480
Width = 735 Width = 735
End End
Begin VB.TextBox Text_Search Begin VB.TextBox Text_Search
Height = 270 Height = 270
Left = 120 Left = 120
TabIndex = 2 TabIndex = 1
Top = 480 Top = 480
Width = 2055 Width = 2055
End End
@ -70,14 +70,16 @@ Begin VB.Form Form_Classic_Cases
Height = 300 Height = 300
Left = 120 Left = 120
Style = 2 'Dropdown List Style = 2 'Dropdown List
TabIndex = 1 TabIndex = 0
Top = 120 Top = 120
Width = 2895 Width = 2895
End End
Begin VB.ListBox List_Cases Begin VB.ListBox List_Cases
Height = 3840 Height = 3840
ItemData = "Form_Classic_Cases.frx":0000
Left = 120 Left = 120
TabIndex = 0 List = "Form_Classic_Cases.frx":0002
TabIndex = 3
Top = 840 Top = 840
Width = 2895 Width = 2895
End End
@ -88,12 +90,8 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block
address As Integer
style As Integer
End Type
Dim tip As String Dim tip As String
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Block_struct
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load() Private Sub Form_Load()
start_x = 3200 start_x = 3200
@ -115,17 +113,14 @@ Private Sub Command_Confirm_Click()
Unload Form_Classic_Cases Unload Form_Classic_Cases
End Sub End Sub
Private Sub List_Cases_Click() Private Sub List_Cases_Click()
Dim temp As String
Text_Tip = "(" & List_Cases.ListIndex + 1 & "/" & List_Cases.ListCount & ")" Text_Tip = "(" & List_Cases.ListIndex + 1 & "/" & List_Cases.ListCount & ")"
temp = List_Cases.List(List_Cases.ListIndex) Text_Code = Mid(List_Cases.List(List_Cases.ListIndex), Len(List_Cases.List(List_Cases.ListIndex)) - 7, 7)
Text_Code = Mid(temp, Len(temp) - 7, 7)
Call Analyse_Code(Text_Code) Call Analyse_Code(Text_Code)
Call Output_Graph Call Output_Graph
End Sub End Sub
Private Sub Command_Search_Click() Private Sub Command_Search_Click()
Dim i As Integer, j As Integer, last_select As Integer Dim i As Integer, j As Integer, last_select As Integer, searching As Boolean
Dim temp() As String Dim temp() As String
Dim searching As Boolean
ReDim temp(0) ReDim temp(0)
If Text_Search = "" Then Exit Sub If Text_Search = "" Then Exit Sub
last_select = Combo_Cases.ListIndex last_select = Combo_Cases.ListIndex
@ -144,6 +139,7 @@ Private Sub Command_Search_Click()
End If End If
Next i Next i
Next j Next j
If debug_mode = True Then MsgBox "last_select=" & last_select & vbCrLf & "searching=" & searching & vbCrLf & "temp->" & UBound(temp), , "Debug"
List_Cases.Clear List_Cases.Clear
Combo_Cases.AddItem "ËÑË÷½á¹û" Combo_Cases.AddItem "ËÑË÷½á¹û"
Combo_Cases.ListIndex = Combo_Cases.ListCount - 1 Combo_Cases.ListIndex = Combo_Cases.ListCount - 1
@ -154,7 +150,7 @@ Private Sub Command_Search_Click()
Combo_Cases.RemoveItem Combo_Cases.ListCount - 1 Combo_Cases.RemoveItem Combo_Cases.ListCount - 1
Combo_Cases.ListIndex = last_select Combo_Cases.ListIndex = last_select
End If End If
MsgBox "No Result!" MsgBox "ÕÒ²»µ½ÍÛ", , "> _ <"
Exit Sub Exit Sub
End If End If
For i = 1 To UBound(temp) For i = 1 To UBound(temp)
@ -186,10 +182,10 @@ Private Sub Get_Cases(index As Integer)
Line Input #1, temp Line Input #1, temp
If temp = "[Cases]" Then If temp = "[Cases]" Then
If num = index Then If num = index Then
Line Input #1, temp Line Input #1, temp
Line Input #1, temp Line Input #1, temp
tip = Right(temp, Len(temp) - 4) tip = Right(temp, Len(temp) - 4)
Text_Tip = tip Text_Tip = tip
reinput: reinput:
If EOF(1) = False Then If EOF(1) = False Then
Line Input #1, temp Line Input #1, temp
@ -217,13 +213,13 @@ Private Sub Get_Cases_title()
Close #1 Close #1
End Sub End Sub
Private Sub Output_Graph() Private Sub Output_Graph()
Dim m, x, y As Integer Dim m, X, Y As Integer
Dim width As Integer, height 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 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 For m = 0 To 9
If Block(m).address <> 25 Then If Block(m).address <> 25 Then
x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x X = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y Y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
If Block(m).style = 0 Or Block(m).style = 1 Then If Block(m).style = 0 Or Block(m).style = 1 Then
width = square_width * 2 + gap width = square_width * 2 + gap
Else Else
@ -234,7 +230,7 @@ Private Sub Output_Graph()
Else Else
height = square_width height = square_width
End If End If
Print_Block x, y, width, height, block_line_width, block_color, block_line_color Print_Block X, Y, width, height, block_line_width, block_color, block_line_color
End If End If
Next m Next m
End Sub End Sub
@ -246,7 +242,7 @@ Private Sub Print_Block(print_start_x, print_start_y, print_width, print_height,
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_color, B
Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_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 End Sub
Private Sub Analyse_Code(Code As String) Private Sub Analyse_Code(code As String)
On Error Resume Next On Error Resume Next
Dim temp(1 To 12) As Integer Dim temp(1 To 12) As Integer
Dim i, addr, style As Integer Dim i, addr, style As Integer
@ -255,7 +251,7 @@ Private Sub Analyse_Code(Code As String)
Dim num As Integer, b1 As Integer, b2 As Integer Dim num As Integer, b1 As Integer, b2 As Integer
Dim dat As String Dim dat As String
For i = 1 To 6 For i = 1 To 6
dat = Mid(Code, i + 1, 1) dat = Mid(code, i + 1, 1)
If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat) 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 If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
b1 = num Mod 4 b1 = num Mod 4
@ -271,7 +267,7 @@ Private Sub Analyse_Code(Code As String)
Block(i).address = 69 Block(i).address = 69
Block(i).style = 69 Block(i).style = 69
Next i Next i
dat = Left(Code, 1) dat = Left(code, 1)
If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat) 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 If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
Block(0).address = num Block(0).address = num
@ -316,4 +312,3 @@ Private Sub Analyse_Code(Code As String)
Next i Next i
err: err:
End Sub End Sub

BIN
Form_Classic_Cases.frx
View File

Binary file not shown.

858
Form_Creator.frm
View File

File diff suppressed because it is too large

40
Form_Detail.frm
View File

@ -17,7 +17,7 @@ Begin VB.Form Form_Detail
Caption = "全局溯源分析" Caption = "全局溯源分析"
Height = 300 Height = 300
Left = 2520 Left = 2520
TabIndex = 4 TabIndex = 3
Top = 120 Top = 120
Width = 1695 Width = 1695
End End
@ -30,7 +30,7 @@ Begin VB.Form Form_Detail
Height = 4380 Height = 4380
Left = 7960 Left = 7960
MultiLine = -1 'True MultiLine = -1 'True
TabIndex = 3 TabIndex = 4
Top = 120 Top = 120
Width = 2415 Width = 2415
End End
@ -52,7 +52,7 @@ Begin VB.Form Form_Detail
Height = 300 Height = 300
Left = 120 Left = 120
Style = 2 'Dropdown List Style = 2 'Dropdown List
TabIndex = 1 TabIndex = 0
Top = 120 Top = 120
Width = 2295 Width = 2295
End End
@ -61,7 +61,7 @@ Begin VB.Form Form_Detail
ItemData = "Form_Detail.frx":0004 ItemData = "Form_Detail.frx":0004
Left = 120 Left = 120
List = "Form_Detail.frx":0006 List = "Form_Detail.frx":0006
TabIndex = 0 TabIndex = 1
Top = 480 Top = 480
Width = 2295 Width = 2295
End End
@ -72,19 +72,11 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block
address As Integer
style As Integer
End Type
Private Type Layer_struct
size As Integer
layer_dat() As String
End Type
Dim wait_data As Boolean, loading As Boolean Dim wait_data As Boolean, loading As Boolean
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Block_struct
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Dim group_size As Long, min_steps As Integer, farthest_steps As Integer Dim group_size As Long, min_steps As Integer, farthest_steps As Integer
Dim min_solutions() As String, farthest_cases() As String, solutions() As String, layers() As String, layer() As Layer_struct Dim min_solutions() As String, farthest_cases() As String, solutions() As String, list_dat() As String
Private Sub Form_Load() Private Sub Form_Load()
start_x = 4350 start_x = 4350
start_y = 135 start_y = 135
@ -106,7 +98,7 @@ Private Sub Form_Load()
ReDim min_solutions(0) ReDim min_solutions(0)
ReDim farthest_cases(0) ReDim farthest_cases(0)
ReDim solutions(0) ReDim solutions(0)
ReDim layers(0) ReDim list_dat(0)
ReDim layer(0 To 0) ReDim layer(0 To 0)
Combo_Detail.AddItem "最少步解" Combo_Detail.AddItem "最少步解"
Combo_Detail.AddItem "所有的解" Combo_Detail.AddItem "所有的解"
@ -114,7 +106,7 @@ Private Sub Form_Load()
Combo_Detail.AddItem "各步数的布局" Combo_Detail.AddItem "各步数的布局"
wait_file_name = start_code & ".txt" wait_file_name = start_code & ".txt"
If Dir(start_code & ".txt") <> "" Then Kill start_code & ".txt" If Dir(start_code & ".txt") <> "" Then Kill start_code & ".txt"
Shell "Engine.exe -a " & start_code Shell "Engine.exe -a " & start_code, vbHide
wait_cancel = False wait_cancel = False
waiting = True waiting = True
wait_data = True wait_data = True
@ -200,7 +192,7 @@ Private Sub Get_Data(file_name As String)
ReDim min_solutions(0) ReDim min_solutions(0)
ReDim farthest_cases(0) ReDim farthest_cases(0)
ReDim solutions(0) ReDim solutions(0)
ReDim layers(0) ReDim list_dat(0)
Open file_name For Input As #1 Open file_name For Input As #1
Line Input #1, temp: Line Input #1, temp Line Input #1, temp: Line Input #1, temp
group_size = temp group_size = temp
@ -228,8 +220,8 @@ Private Sub Get_Data(file_name As String)
Wend Wend
Line Input #1, temp Line Input #1, temp
While (temp <> "[Layer]") While (temp <> "[Layer]")
ReDim Preserve layers(UBound(layers) + 1) ReDim Preserve list_dat(UBound(list_dat) + 1)
layers(UBound(layers)) = temp list_dat(UBound(list_dat)) = temp
Line Input #1, temp Line Input #1, temp
Wend Wend
Close #1 Close #1
@ -237,10 +229,10 @@ Private Sub Get_Data(file_name As String)
End Sub End Sub
Private Sub split_layer() Private Sub split_layer()
Dim i As Long, code As String, num As Integer, index As Integer Dim i As Long, code As String, num As Integer, index As Integer
For i = 1 To UBound(layers) For i = 1 To UBound(list_dat)
code = Mid(layers(i), InStr(1, layers(i), ">") + 2, 7) code = Mid(list_dat(i), InStr(1, list_dat(i), ">") + 2, 7)
num = Mid(layers(i), InStr(1, layers(i), "(") + 1, InStr(1, layers(i), ",") - InStr(1, layers(i), "(") - 1) num = Mid(list_dat(i), InStr(1, list_dat(i), "(") + 1, InStr(1, list_dat(i), ",") - InStr(1, list_dat(i), "(") - 1)
index = Mid(layers(i), InStr(1, layers(i), ",") + 1, Len(layers(i)) - InStr(1, layers(i), ",") - 1) index = Mid(list_dat(i), InStr(1, list_dat(i), ",") + 1, Len(list_dat(i)) - InStr(1, list_dat(i), ",") - 1)
ReDim Preserve layer(0 To num) ReDim Preserve layer(0 To num)
ReDim Preserve layer(num).layer_dat(0 To index) ReDim Preserve layer(num).layer_dat(0 To index)
layer(num).layer_dat(index) = code layer(num).layer_dat(index) = code
@ -356,7 +348,7 @@ Private Sub Timer_Debug_Timer()
debug_dat = debug_dat & "min_solutions->" & UBound(min_solutions) & vbCrLf debug_dat = debug_dat & "min_solutions->" & UBound(min_solutions) & vbCrLf
debug_dat = debug_dat & "farthest_cases->" & UBound(farthest_cases) & vbCrLf debug_dat = debug_dat & "farthest_cases->" & UBound(farthest_cases) & vbCrLf
debug_dat = debug_dat & "solutions->" & UBound(solutions) & vbCrLf debug_dat = debug_dat & "solutions->" & UBound(solutions) & vbCrLf
debug_dat = debug_dat & "layers->" & UBound(layers) & vbCrLf debug_dat = debug_dat & "list_dat->" & UBound(list_dat) & vbCrLf
debug_dat = debug_dat & "layer->" & UBound(layer) & vbCrLf debug_dat = debug_dat & "layer->" & UBound(layer) & vbCrLf
Text_Debug = debug_dat Text_Debug = debug_dat
End Sub End Sub

110
Form_Favourite.frm
View File

@ -6,13 +6,26 @@ Begin VB.Form Form_Favourite
ClientHeight = 4590 ClientHeight = 4590
ClientLeft = 45 ClientLeft = 45
ClientTop = 390 ClientTop = 390
ClientWidth = 6765 ClientWidth = 6750
LinkTopic = "Form1" LinkTopic = "Form1"
MaxButton = 0 'False MaxButton = 0 'False
MinButton = 0 'False MinButton = 0 'False
ScaleHeight = 4590 ScaleHeight = 4590
ScaleWidth = 6765 ScaleWidth = 6750
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer_Debug
Interval = 200
Left = 0
Top = 0
End
Begin VB.TextBox Text_Debug
Height = 4365
Left = 6750
MultiLine = -1 'True
TabIndex = 8
Top = 120
Width = 2895
End
Begin VB.TextBox Text_Code Begin VB.TextBox Text_Code
Alignment = 2 'Center Alignment = 2 'Center
BeginProperty Font BeginProperty Font
@ -27,44 +40,60 @@ Begin VB.Form Form_Favourite
Height = 495 Height = 495
Left = 3720 Left = 3720
Locked = -1 'True Locked = -1 'True
TabIndex = 5 TabIndex = 7
Top = 3960 Top = 3975
Width = 1935 Width = 1935
End End
Begin VB.CommandButton Command_Confirm Begin VB.CommandButton Command_Confirm
Caption = "确定" Caption = "确定"
Height = 495 Height = 495
Left = 5640 Left = 5640
TabIndex = 4 TabIndex = 6
Top = 3960 Top = 3975
Width = 975 Width = 975
End End
Begin VB.CommandButton Command_Delete Begin VB.CommandButton Command_Delete
Caption = "删除" Caption = "删除"
Height = 495 Height = 480
Left = 5640 Left = 5640
TabIndex = 3 TabIndex = 5
Top = 3480 Top = 3510
Width = 975 Width = 975
End End
Begin VB.CommandButton Command_Modify Begin VB.CommandButton Command_Modify
Caption = "修改" Caption = "修改"
Height = 495 Height = 480
Left = 4680 Left = 4680
TabIndex = 2 TabIndex = 4
Top = 3480 Top = 3510
Width = 975 Width = 975
End End
Begin VB.CommandButton Command_Add Begin VB.CommandButton Command_Add
Caption = "添加" Caption = "添加"
Height = 495 Height = 480
Left = 3720 Left = 3720
TabIndex = 1 TabIndex = 3
Top = 3480 Top = 3510
Width = 975 Width = 975
End End
Begin VB.CommandButton Command_Down
Caption = "ÏÂÒÆ"
Height = 465
Left = 5160
TabIndex = 2
Top = 3060
Width = 1455
End
Begin VB.CommandButton Command_Up
Caption = "ÉÏÒÆ"
Height = 465
Left = 3720
TabIndex = 1
Top = 3060
Width = 1455
End
Begin VB.ListBox List_Favourite Begin VB.ListBox List_Favourite
Height = 3300 Height = 2940
ItemData = "Form_Favourite.frx":0000 ItemData = "Form_Favourite.frx":0000
Left = 3720 Left = 3720
List = "Form_Favourite.frx":0002 List = "Form_Favourite.frx":0002
@ -84,18 +113,21 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block
address As Integer
style As Integer
End Type
Dim change_mode As Boolean Dim change_mode As Boolean
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Block_struct
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load() Private Sub Form_Load()
start_x = 135 start_x = 135
start_y = 135 start_y = 135
square_width = 770 square_width = 770
gap = 75 gap = 75
If debug_mode = True Then
Form_Favourite.width = 9860
Text_Debug.Visible = True
Else
Form_Favourite.width = 6845
Text_Debug.Visible = False
End If
If on_top = True Then If on_top = True Then
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2 SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
Else Else
@ -114,6 +146,28 @@ Private Sub Command_Confirm_Click()
change_case = True change_case = True
Unload Form_Favourite Unload Form_Favourite
End Sub End Sub
Private Sub Command_Up_Click()
Dim temp As String, num As Integer
If List_Favourite.ListCount <= 1 Then Exit Sub
If List_Favourite.ListIndex = 0 Then Exit Sub
num = List_Favourite.ListIndex
temp = List_Favourite.List(num)
List_Favourite.RemoveItem num
List_Favourite.AddItem temp, num - 1
List_Favourite.ListIndex = num - 1
Call Save_Data
End Sub
Private Sub Command_Down_Click()
Dim temp As String, num As Integer
If List_Favourite.ListCount <= 1 Then Exit Sub
If List_Favourite.ListIndex = List_Favourite.ListCount - 1 Then Exit Sub
num = List_Favourite.ListIndex
temp = List_Favourite.List(num)
List_Favourite.RemoveItem num
List_Favourite.AddItem temp, num + 1
List_Favourite.ListIndex = num + 1
Call Save_Data
End Sub
Private Sub Command_Add_Click() Private Sub Command_Add_Click()
change_mode = False change_mode = False
favourite_add_save = False favourite_add_save = False
@ -286,3 +340,17 @@ Private Sub Analyse_Code(code As String)
Next i Next i
err: err:
End Sub End Sub
Private Sub Timer_Debug_Timer()
Dim debug_dat As String
debug_dat = debug_dat & "Favourite_Cases_name->" & UBound(Favourite_Cases_name) & vbCrLf
debug_dat = debug_dat & "Favourite_Cases_code->" & UBound(Favourite_Cases_code) & vbCrLf
debug_dat = debug_dat & vbCrLf
debug_dat = debug_dat & "favourite_add_name" & vbCrLf & "=" & favourite_add_name & vbCrLf & vbCrLf
debug_dat = debug_dat & "favourite_add_code" & vbCrLf & "=" & favourite_add_code & vbCrLf & vbCrLf
debug_dat = debug_dat & "favourite_add_init_name" & vbCrLf & "=" & favourite_add_init_name & vbCrLf & vbCrLf
debug_dat = debug_dat & "favourite_add_init_code" & vbCrLf & "=" & favourite_add_init_code & vbCrLf & vbCrLf
debug_dat = debug_dat & "favourite_add_confirm=" & favourite_add_confirm & vbCrLf & vbCrLf
debug_dat = debug_dat & "favourite_add_save=" & favourite_add_save & vbCrLf & vbCrLf
debug_dat = debug_dat & "change_mode=" & change_mode & vbCrLf
Text_Debug = debug_dat
End Sub

34
Form_Favourite_Add.frm
View File

@ -83,19 +83,15 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block Dim Block(0 To 9) As Block_struct
address As Integer
style As Integer
End Type
Dim Block(0 To 9) As Case_Block
Dim Exist(1 To 4, 1 To 5) As Boolean Dim Exist(1 To 4, 1 To 5) As Boolean
Dim Block_index(1 To 4, 1 To 5) As Integer Dim Block_index(1 To 4, 1 To 5) As Integer
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Dim x_split(0 To 4) As Integer, y_split(0 To 5) As Integer Dim x_split(0 To 4) As Integer, y_split(0 To 5) As Integer
Dim limit(-1 To 1, -1 To 1) As Boolean
Dim click_mouse_x As Integer, click_mouse_y As Integer 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
Private Sub Form_Load() Private Sub Form_Load()
start_x = 120 start_x = 120
start_y = 120 start_y = 120
@ -485,10 +481,10 @@ Private Function Check() As Boolean
Next i Next i
Check = True Check = True
If Block(0).style <> 0 Or Block(0).address > 20 Or Block(0).address < 0 Then If Block(0).style <> 0 Or Block(0).address > 20 Or Block(0).address < 0 Then
Check = False Check = False: GoTo check_err
Else Else
addr = Block(0).address addr = Block(0).address
If addr > 14 Or (addr Mod 4 = 3) Then Check = False If addr > 14 Or (addr Mod 4 = 3) Then Check = False: GoTo check_err
temp(addr) = True temp(addr) = True
temp(addr + 1) = True temp(addr + 1) = True
temp(addr + 4) = True temp(addr + 4) = True
@ -496,20 +492,20 @@ Private Function Check() As Boolean
End If End If
For i = 1 To 5 For i = 1 To 5
If Block(i).address > 20 Or Block(i).address < 0 Then If Block(i).address > 20 Or Block(i).address < 0 Then
Check = False Check = False: GoTo check_err
ElseIf Block(i).style <> 1 And Block(i).style <> 2 Then ElseIf Block(i).style <> 1 And Block(i).style <> 2 Then
Check = False Check = False: GoTo check_err
Else Else
addr = Block(i).address addr = Block(i).address
If Block(i).style = 1 Then If Block(i).style = 1 Then
If addr > 18 Or (addr Mod 4 = 3) Then Check = False If addr > 18 Or (addr Mod 4 = 3) Then Check = False: GoTo check_err
If temp(addr) = True Or temp(addr + 1) = True Then Check = False If temp(addr) = True Or temp(addr + 1) = True Then Check = False: GoTo check_err
temp(addr) = True temp(addr) = True
temp(addr + 1) = True temp(addr + 1) = True
End If End If
If Block(i).style = 2 Then If Block(i).style = 2 Then
If addr > 15 Then Check = False If addr > 15 Then Check = False: GoTo check_err
If temp(addr) = True Or temp(addr + 4) = True Then Check = False If temp(addr) = True Or temp(addr + 4) = True Then Check = False: GoTo check_err
temp(addr) = True temp(addr) = True
temp(addr + 4) = True temp(addr + 4) = True
End If End If
@ -517,11 +513,11 @@ Private Function Check() As Boolean
Next i Next i
For i = 6 To 9 For i = 6 To 9
If Block(i).style <> 3 Or Block(i).address > 20 Or Block(i).address < 0 Then If Block(i).style <> 3 Or Block(i).address > 20 Or Block(i).address < 0 Then
Check = False Check = False: GoTo check_err
Else Else
addr = Block(i).address addr = Block(i).address
If addr > 19 Then Check = False If addr > 19 Then Check = False: GoTo check_err
If temp(addr) = True Then Check = False If temp(addr) = True Then Check = False: GoTo check_err
temp(addr) = True temp(addr) = True
End If End If
Next i Next i
@ -529,7 +525,8 @@ Private Function Check() As Boolean
For i = 0 To 19 For i = 0 To 19
If temp(i) = False Then j = j + 1 If temp(i) = False Then j = j + 1
Next i Next i
If j <> 2 Then Check = False If j <> 2 Then Check = False: GoTo check_err
check_err:
End Function End Function
Private Function Get_Code() As String Private Function Get_Code() As String
On Error Resume Next On Error Resume Next
@ -609,6 +606,7 @@ End Function
Private Sub Analyse(code As String) Private Sub Analyse(code As String)
Dim m As Integer, addr As Integer, X As Integer, Y As Integer Dim m As Integer, addr As Integer, X As Integer, Y As Integer
Call Analyse_Code(code) Call Analyse_Code(code)
If Check = False Then Call Case_init: Exit Sub
For X = 1 To 4 For X = 1 To 4
For Y = 1 To 5 For Y = 1 To 5
Block_index(X, Y) = 10 Block_index(X, Y) = 10

545
Form_Game.frm
View File

@ -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.9 by Dnomd343" Caption = "HRD Game v2.0 by Dnomd343"
ClientHeight = 7305 ClientHeight = 7305
ClientLeft = 45 ClientLeft = 45
ClientTop = 690 ClientTop = 690
@ -15,100 +15,132 @@ Begin VB.Form Form_Game
ScaleHeight = 7305 ScaleHeight = 7305
ScaleWidth = 7290 ScaleWidth = 7290
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command_Detail Begin VB.Frame Frame_Analyse
Caption = "详细解析" Caption = "分析"
Height = 495 Height = 1335
Left = 5760 Left = 5640
TabIndex = 15 TabIndex = 3
Top = 6360
Width = 1335
End
Begin VB.CommandButton Command_Prompt
Caption = "提示下一步"
Height = 495
Left = 5760
TabIndex = 14
Top = 4440
Width = 1335
End
Begin VB.CommandButton Command_Solution
Caption = "最少步解法"
Height = 495
Left = 5760
TabIndex = 13
Top = 5760 Top = 5760
Width = 1335 Width = 1575
Begin VB.CommandButton Command_Detail
Caption = "详细解析"
Height = 495
Left = 120
TabIndex = 14
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Solution
Caption = "最少步解法"
Height = 495
Left = 120
TabIndex = 13
Top = 240
Width = 1335
End
End End
Begin VB.CommandButton Command_Add_Favourite Begin VB.Frame Frame_Game
Caption = "加入收藏" Caption = "游戏"
Height = 495 Height = 2295
Left = 5760 Left = 5640
TabIndex = 12 TabIndex = 2
Top = 2640 Top = 3360
Width = 1335 Width = 1575
Begin VB.CommandButton Command_Reset
Caption = "重新开始"
Height = 495
Left = 120
TabIndex = 12
Top = 1680
Width = 1335
End
Begin VB.CommandButton Command_Prompt
Caption = "提示下一步"
Height = 495
Left = 120
TabIndex = 11
Top = 1200
Width = 1335
End
Begin VB.CommandButton Command_Reduction_Snapshot
Caption = "还原快照"
Height = 495
Left = 120
TabIndex = 10
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Create_Snapshot
Caption = "创建快照"
Height = 495
Left = 120
TabIndex = 9
Top = 240
Width = 1335
End
End End
Begin VB.CommandButton Command_Favourite Begin VB.Frame Frame_Favourite
Caption = "我的收藏" Caption = "收藏"
Height = 495 Height = 1335
Left = 5760 Left = 5640
TabIndex = 11 TabIndex = 1
Top = 1920 Top = 1920
Width = 1335 Width = 1575
End Begin VB.CommandButton Command_Add_Favourite
Begin VB.CommandButton Command_Reduction_Snapshot Caption = "加入收藏"
Caption = "还原快照" Height = 495
Height = 495 Left = 120
Left = 5760 TabIndex = 8
TabIndex = 10 Top = 720
Top = 3840 Width = 1335
Width = 1335 End
End Begin VB.CommandButton Command_Favourite
Begin VB.CommandButton Command_Create_Snapshot Caption = "我的收藏"
Caption = "创建快照" Height = 495
Height = 495 Left = 120
Left = 5760 TabIndex = 7
TabIndex = 9 Top = 240
Top = 3240 Width = 1335
Width = 1335 End
End
Begin VB.CommandButton Command_Rand_Case
Caption = "随机生成布局"
Height = 495
Left = 5760
TabIndex = 8
Top = 1320
Width = 1335
End
Begin VB.CommandButton Command_Select_Case
Caption = "选择经典布局"
Height = 495
Left = 5760
TabIndex = 7
Top = 720
Width = 1335
End End
Begin VB.CommandButton Command_Create_Case Begin VB.Frame Frame_Start
Caption = "自定义布局" Caption = "开始"
Height = 495 Height = 1815
Left = 5760 Left = 5640
TabIndex = 6 TabIndex = 0
Top = 120 Top = 0
Width = 1335 Width = 1575
Begin VB.CommandButton Command_Rand_Case
Caption = "随机生成布局"
Height = 495
Left = 120
TabIndex = 6
Top = 1200
Width = 1335
End
Begin VB.CommandButton Command_Select_Case
Caption = "选择经典布局"
Height = 495
Left = 120
TabIndex = 5
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Create_Case
Caption = "自定义布局"
Height = 495
Left = 120
TabIndex = 4
Top = 240
Width = 1335
End
End End
Begin VB.Timer Timer_Layout Begin VB.Timer Timer_Layout
Interval = 300 Interval = 300
Left = 0 Left = 0
Top = 0 Top = 0
End End
Begin VB.CommandButton Command_Reset Begin VB.Timer Timer_Timing
Caption = "重新开始"
Height = 495
Left = 5760
TabIndex = 1
Top = 5040
Width = 1335
End
Begin VB.Timer Timer_Get_Time
Enabled = 0 'False Enabled = 0 'False
Interval = 50 Interval = 50
Left = 0 Left = 0
@ -120,18 +152,18 @@ Begin VB.Form Form_Game
Top = 0 Top = 0
End End
Begin VB.TextBox Text_Debug Begin VB.TextBox Text_Debug
Height = 6855 Height = 6975
Left = 7320 Left = 7320
MultiLine = -1 'True MultiLine = -1 'True
TabIndex = 0 TabIndex = 15
Top = 240 Top = 120
Width = 3735 Width = 3855
End End
Begin VB.Label Label_Code Begin VB.Label Label_Code
AutoSize = -1 'True AutoSize = -1 'True
Height = 180 Height = 180
Left = 0 Left = 0
TabIndex = 5 TabIndex = 19
Top = 7000 Top = 7000
Width = 90 Width = 90
End End
@ -139,7 +171,7 @@ Begin VB.Form Form_Game
AutoSize = -1 'True AutoSize = -1 'True
Height = 180 Height = 180
Left = 0 Left = 0
TabIndex = 4 TabIndex = 18
Top = 7000 Top = 7000
Width = 90 Width = 90
End End
@ -148,7 +180,7 @@ Begin VB.Form Form_Game
AutoSize = -1 'True AutoSize = -1 'True
Height = 180 Height = 180
Left = 0 Left = 0
TabIndex = 3 TabIndex = 17
Top = 45 Top = 45
Width = 105 Width = 105
End End
@ -156,7 +188,7 @@ Begin VB.Form Form_Game
AutoSize = -1 'True AutoSize = -1 'True
Height = 180 Height = 180
Left = 0 Left = 0
TabIndex = 2 TabIndex = 16
Top = 7000 Top = 7000
Width = 90 Width = 90
End End
@ -193,15 +225,11 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block
address As Integer
style As Integer
End Type
Private Type Block_Address Private Type Block_Address
X As Integer X As Integer
Y As Integer Y As Integer
End Type End Type
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Block_struct
Dim Exist(1 To 4, 1 To 5) As Boolean Dim Exist(1 To 4, 1 To 5) As Boolean
Dim Block_index(1 To 4, 1 To 5) As Integer Dim Block_index(1 To 4, 1 To 5) As Integer
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
@ -213,10 +241,6 @@ 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 snapshot_code As String, snapshot_step As Long Dim snapshot_code As String, snapshot_step As Long
Dim prompt_wait_data As Boolean Dim prompt_wait_data As Boolean
Private Sub Menu_Debug_Mode_Click()
Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked
If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False
End Sub
Private Sub Menu_Exterior_White_Click() Private Sub Menu_Exterior_White_Click()
block_line_width = 1 block_line_width = 1
case_line_width = 2 case_line_width = 2
@ -278,17 +302,33 @@ Private Sub Menu_On_Top_Click()
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2 SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
End If End If
End Sub End Sub
Private Sub Menu_Debug_Mode_Click()
Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked
If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False
End Sub
Private Sub Form_Load() Private Sub Form_Load()
Me.Icon = Me.MouseIcon Me.Icon = Me.MouseIcon
debug_mode = False debug_mode = False
on_top = True on_top = True
block_line_width = 1 playing = False
case_line_width = 2 solve_compete = False
block_line_color = RGB(0, 158, 240) start_x = 180
case_line_color = RGB(0, 158, 240) start_y = 300
block_color = RGB(225, 245, 255) gap = 105
case_color = RGB(248, 254, 255) square_width = 1200
snapshot_step = -1
last_move = 10
move_times = 0
total_steps = 0
total_time = 0
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
Call init Call init
Call Case_init
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
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)
mouse_button = Button mouse_button = Button
@ -303,14 +343,9 @@ Private Sub Form_Click()
If mouse_x < start_x Or mouse_x > start_x + square_width * 4 + gap * 5 Then Exit Sub If mouse_x < start_x Or mouse_x > start_x + square_width * 4 + gap * 5 Then Exit Sub
If mouse_y < start_y Or mouse_y > start_y + square_width * 5 + gap * 6 Then Exit Sub If mouse_y < start_y Or mouse_y > start_y + square_width * 5 + gap * 6 Then Exit Sub
If solve_compete = True Then Exit Sub If solve_compete = True Then Exit Sub
If Block_index(Get_block_x(mouse_x), Get_block_y(mouse_y)) = 10 Then Exit Sub
If playing = False Then Call start_playing
m = Block_index(Get_block_x(mouse_x), Get_block_y(mouse_y)) m = Block_index(Get_block_x(mouse_x), Get_block_y(mouse_y))
If m = 10 Then Exit Sub
If playing = False Then
playing = True
total_time = 0
total_steps = 0
Timer_Get_Time.Enabled = True
End If
Y = Int(Block(m).address / 4) + 1 Y = Int(Block(m).address / 4) + 1
X = Block(m).address - (Y - 1) * 4 + 1 X = Block(m).address - (Y - 1) * 4 + 1
If m = last_move Then If m = last_move Then
@ -380,12 +415,13 @@ Private Sub Form_Click()
Label_Step = "步数: " & total_steps Label_Step = "步数: " & total_steps
Label_Code = Get_Code() Label_Code = Get_Code()
Call Output_Graph Call Output_Graph
If Block(0).address = 13 Then If Block(0).address = 13 Then Call case_solve_compete
Timer_Get_Time = False End Sub
playing = False Private Sub Command_Solution_Click()
solve_compete = True Form_Solution.Show 1
MsgBox "恭喜你成功完成！" & vbCrLf & "编码: " & start_code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "（>__<）" End Sub
End If Private Sub Command_Detail_Click()
Form_Detail.Show 1
End Sub End Sub
Private Sub Command_Create_Case_Click() Private Sub Command_Create_Case_Click()
Form_Creator.Show 1 Form_Creator.Show 1
@ -400,18 +436,42 @@ 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_Detail_Click()
Form_Detail.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
If playing = False And solve_compete = False Then favourite_add_init_name = Left(Label_Title, Len(Label_Title) - 9) Else favourite_add_init_name = "" If playing = False And solve_compete = False Then
favourite_add_init_name = Left(Label_Title, Len(Label_Title) - 9)
Else
favourite_add_init_name = ""
End If
Form_Favourite_Add.Show 1 Form_Favourite_Add.Show 1
End Sub End Sub
Private Sub Command_Prompt_Click()
If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
wait_file_name = Label_Code & ".txt"
If Dir(Label_Code & ".txt") <> "" Then Kill Label_Code & ".txt"
Shell "Engine.exe -q " & Label_Code, vbHide
wait_cancel = False
waiting = True
prompt_wait_data = True
Form_Wait.Show 1
End Sub
Private Sub Command_Reset_Click()
total_steps = 0
total_time = 0
last_move = 10
move_times = 0
snapshot_step = -1
playing = False
solve_compete = False
Timer_Timing.Enabled = False
Call Case_init
Label_Step = "步数: 0"
Label_Code = start_code
Label_Time = "用时: 0:00:00"
Call Analyse(start_code)
Call Output_Graph
End Sub
Private Sub Command_Create_Snapshot_Click() Private Sub Command_Create_Snapshot_Click()
If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
@ -431,41 +491,46 @@ Private Sub Command_Reduction_Snapshot_Click()
Label_Step = "步数: " & total_steps Label_Step = "步数: " & total_steps
Label_Code = snapshot_code Label_Code = snapshot_code
End Sub End Sub
Private Sub Command_Prompt_Click() Private Sub start_playing()
If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub playing = True
wait_file_name = Label_Code & ".txt"
If Dir(Label_Code & ".txt") <> "" Then Kill Label_Code & ".txt"
Shell "Engine.exe -q " & Label_Code
wait_cancel = False
waiting = True
prompt_wait_data = True
Form_Wait.Show 1
End Sub
Private Sub Command_Reset_Click()
total_steps = 0
total_time = 0 total_time = 0
Timer_Get_Time.Enabled = False total_steps = 0
Call init Timer_Timing.Enabled = True
Label_Step = "步数: 0"
Label_Code = start_code
Label_Time = "用时: 0:00:00"
Call Analyse(start_code)
Call Output_Graph
End Sub End Sub
Private Sub init() Private Sub case_solve_compete()
Timer_Timing = False
playing = False playing = False
solve_compete = False solve_compete = True
Timer_Get_Time.Enabled = False MsgBox "恭喜你成功完成！" & vbCrLf & "编码: " & start_code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "（>__<）"
snapshot_step = -1 End Sub
last_move = 10 Private Sub change_start_case(title As String, code As String)
move_times = 0 Label_Title.Caption = title & "(" & code & ")"
total_steps = 0 start_code = code
total_time = 0 Call Command_Reset_Click
start_x = 180 End Sub
start_y = 300 Private Sub prompt_output()
gap = 105 Dim temp As String
square_width = 1200 prompt_wait_data = False
Call Case_init If wait_cancel = True Then Exit Sub
Open Label_Code.Caption & ".txt" For Input As #1
Line Input #1, temp
If temp = "No Solution" Then
MsgBox "无解", , "> _ <"
Else
Line Input #1, temp
Line Input #1, temp
last_move = 10
If total_steps = 0 Then playing = True: Timer_Timing.Enabled = True
total_steps = total_steps + 1
Label_Step = "步数: " & total_steps
Label_Code = temp
Call Analyse(temp)
Call Output_Graph
If Block(0).address = 13 Then Call case_solve_compete
End If
Close #1
End Sub
Private Sub init()
x_split(0) = start_x x_split(0) = start_x
x_split(1) = start_x + gap / 2 + square_width + gap x_split(1) = start_x + gap / 2 + square_width + gap
x_split(2) = start_x + gap / 2 + (square_width + gap) * 2 x_split(2) = start_x + gap / 2 + (square_width + gap) * 2
@ -477,8 +542,6 @@ 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
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
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
@ -872,60 +935,6 @@ Private Sub Analyse(code As String)
Next Y Next Y
Next X Next X
End Sub End Sub
Private Function Check() As Boolean
Dim temp(0 To 19) As Boolean
Dim addr As Integer, i As Integer, j As Integer
For i = 0 To 19
temp(i) = False
Next i
Check = True
If Block(0).style <> 0 Or Block(0).address > 20 Or Block(0).address < 0 Then
Check = False
Else
addr = Block(0).address
If addr > 14 Or (addr Mod 4 = 3) Then Check = False
temp(addr) = True
temp(addr + 1) = True
temp(addr + 4) = True
temp(addr + 5) = True
End If
For i = 1 To 5
If Block(i).address > 20 Or Block(i).address < 0 Then
Check = False
ElseIf Block(i).style <> 1 And Block(i).style <> 2 Then
Check = False
Else
addr = Block(i).address
If Block(i).style = 1 Then
If addr > 18 Or (addr Mod 4 = 3) Then Check = False
If temp(addr) = True Or temp(addr + 1) = True Then Check = False
temp(addr) = True
temp(addr + 1) = True
End If
If Block(i).style = 2 Then
If addr > 15 Then Check = False
If temp(addr) = True Or temp(addr + 4) = True Then Check = False
temp(addr) = True
temp(addr + 4) = True
End If
End If
Next i
For i = 6 To 9
If Block(i).style <> 3 Or Block(i).address > 20 Or Block(i).address < 0 Then
Check = False
Else
addr = Block(i).address
If addr > 19 Then Check = False
If temp(addr) = True Then Check = False
temp(addr) = True
End If
Next i
j = 0
For i = 0 To 19
If temp(i) = False Then j = j + 1
Next i
If j <> 2 Then Check = False
End Function
Private Sub Analyse_Code(code As String) Private Sub Analyse_Code(code As String)
On Error Resume Next On Error Resume Next
Dim temp(1 To 12) As Integer Dim temp(1 To 12) As Integer
@ -996,7 +1005,7 @@ Private Sub Analyse_Code(code As String)
Next i Next i
err: err:
End Sub End Sub
Private Sub Timer_Get_Time_Timer() Private Sub Timer_Timing_Timer()
Static temp As Integer Static temp As Integer
Dim time_hour As String, time_minute As String, time_second As String Dim time_hour As String, time_minute As String, time_second As String
If Not temp = Second(Time) Then total_time = total_time + 1: temp = Second(Time) If Not temp = Second(Time) Then total_time = total_time + 1: temp = Second(Time)
@ -1007,6 +1016,27 @@ Private Sub Timer_Get_Time_Timer()
If Len(time_minute) = 1 Then time_minute = "0" & time_minute If Len(time_minute) = 1 Then time_minute = "0" & time_minute
Label_Time = "用时: " & time_hour & ":" & time_minute & ":" & time_second Label_Time = "用时: " & time_hour & ":" & time_minute & ":" & time_second
End Sub End Sub
Private Sub Timer_Layout_Timer()
Dim width As Integer, temp As String
width = gap * 5 + square_width * 4
Label_Title.Top = 45
Label_Code.Top = 7000
Label_Step.Top = 7000
Label_Time.Top = 7000
Label_Title.Left = (width - Label_Title.width) / 2 + start_x
Label_Code.Left = (width - Label_Code.width) / 2 + start_x
Label_Step.Left = start_x
Label_Time.Left = start_x + width - Label_Time.width
If debug_mode = True Then
Form_Game.width = 11460
Text_Debug.Visible = True
Else
Form_Game.width = 7380
Text_Debug.Visible = False
End If
If prompt_wait_data = True And waiting = False Then Call prompt_output
If change_case = True Then change_case = False: Call change_start_case(change_case_title, change_case_code)
End Sub
Private Sub Timer_Debug_Timer() Private Sub Timer_Debug_Timer()
Dim i As Integer, j As Integer, m As Integer, debug_dat As String Dim i As Integer, j As Integer, m As Integer, debug_dat As String
For m = 0 To 9 For m = 0 To 9
@ -1033,79 +1063,22 @@ Private Sub Timer_Debug_Timer()
Next i Next i
debug_dat = debug_dat & vbCrLf & vbCrLf debug_dat = debug_dat & vbCrLf & vbCrLf
Next j Next j
debug_dat = debug_dat & "dir_x1=" & dir_x1 & " dir_y1=" & dir_y1 & vbCrLf debug_dat = debug_dat & "dir_x1=" & dir_x1 & " dir_y1=" & dir_y1 & " dir_x2=" & dir_x2 & " dir_y2=" & dir_y2 & vbCrLf
debug_dat = debug_dat & "dir_x2=" & dir_x2 & " dir_y2=" & dir_y2 & vbCrLf
debug_dat = debug_dat & "block_addr(0)=(" & block_addr(0).X & "," & block_addr(0).Y & ")" & vbCrLf debug_dat = debug_dat & "block_addr(0)=(" & block_addr(0).X & "," & block_addr(0).Y & ")" & vbCrLf
debug_dat = debug_dat & "block_addr(1)=(" & block_addr(1).X & "," & block_addr(1).Y & ")" & vbCrLf debug_dat = debug_dat & "block_addr(1)=(" & block_addr(1).X & "," & block_addr(1).Y & ")" & vbCrLf
debug_dat = debug_dat & "block_addr(2)=(" & block_addr(2).X & "," & block_addr(2).Y & ")" & vbCrLf debug_dat = debug_dat & "block_addr(2)=(" & block_addr(2).X & "," & block_addr(2).Y & ")" & vbCrLf
debug_dat = debug_dat & "move_max_step=" & move_max_step & vbCrLf debug_dat = debug_dat & "mouse_x=" & mouse_x & " mouse_y=" & mouse_y & " mouse_button=" & mouse_button & vbCrLf
debug_dat = debug_dat & "last_move=" & last_move & vbCrLf debug_dat = debug_dat & "move_max_step=" & move_max_step & " last_move=" & last_move & " move_times=" & move_times & vbCrLf
debug_dat = debug_dat & "move_times=" & move_times & vbCrLf
debug_dat = debug_dat & vbCrLf debug_dat = debug_dat & vbCrLf
debug_dat = debug_dat & "total_steps=" & total_steps & vbCrLf debug_dat = debug_dat & "total_steps=" & total_steps & " total_time=" & total_time & vbCrLf
debug_dat = debug_dat & "total_time=" & total_time & vbCrLf debug_dat = debug_dat & "snapshot_code=" & snapshot_code & " snapshot_step=" & snapshot_step & vbCrLf
debug_dat = debug_dat & "playing=" & playing & " solve_compete=" & solve_compete & vbCrLf
debug_dat = debug_dat & "start_code=" & start_code & vbCrLf
debug_dat = debug_dat & "debug_mode=" & debug_mode & " on_top=" & on_top & vbCrLf
debug_dat = debug_dat & "prompt_wait_data=" & prompt_wait_data & vbCrLf
debug_dat = debug_dat & "change_case=" & change_case & vbCrLf
debug_dat = debug_dat & "change_case_title=" & change_case_title & vbCrLf
debug_dat = debug_dat & "change_case_code=" & change_case_code & vbCrLf
Text_Debug = debug_dat Text_Debug = debug_dat
End Sub End Sub
Private Sub Timer_Layout_Timer()
Dim width As Integer, temp As String
width = gap * 5 + square_width * 4
Label_Title.Top = 45
Label_Code.Top = 7000
Label_Step.Top = 7000
Label_Time.Top = 7000
Label_Title.Left = (width - Label_Title.width) / 2 + start_x
Label_Code.Left = (width - Label_Code.width) / 2 + start_x
Label_Step.Left = start_x
Label_Time.Left = start_x + width - Label_Time.width
If debug_mode = True Then
Form_Game.width = 11355
Form_Game.height = 8040
Text_Debug.Visible = True
Timer_Debug.Enabled = True
Else
Form_Game.width = 7380
Form_Game.height = 8040
Text_Debug.Visible = False
Timer_Debug.Enabled = False
End If
If change_case = True Then
change_case = False
Label_Title.Caption = change_case_title & "(" & change_case_code & ")"
Call init
start_code = change_case_code
Label_Step = "步数: 0"
Label_Code = start_code
Label_Time = "用时: 0:00:00"
Call Analyse(start_code)
Call Output_Graph
End If
If prompt_wait_data = True And waiting = False Then
prompt_wait_data = False
If wait_cancel = True Then Exit Sub
Open Label_Code.Caption & ".txt" For Input As #1
Line Input #1, temp
If temp = "No Solution" Then
MsgBox "无解", , "> _ <"
Else
Line Input #1, temp
Line Input #1, temp
last_move = 10
If total_steps = 0 Then
playing = True
Timer_Get_Time.Enabled = True
End If
total_steps = total_steps + 1
Label_Step = "步数: " & total_steps
Label_Code = temp
Call Analyse(temp)
Call Output_Graph
If Block(0).address = 13 Then
Timer_Get_Time = False
playing = False
solve_compete = True
MsgBox "恭喜你成功完成！" & vbCrLf & "编码: " & start_code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "（>__<）"
End If
End If
Close #1
End If
End Sub

62
Form_Rand_Case.frm
View File

@ -15,18 +15,18 @@ Begin VB.Form Form_Rand_Case
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command_Confirm Begin VB.CommandButton Command_Confirm
Caption = "确定" Caption = "确定"
Height = 495 Height = 505
Left = 3960 Left = 3960
TabIndex = 9 TabIndex = 10
Top = 4230 Top = 4210
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Create Begin VB.CommandButton Command_Create
Caption = "生成" Caption = "生成"
Height = 495 Height = 505
Left = 3960 Left = 3960
TabIndex = 8 TabIndex = 7
Top = 3600 Top = 2580
Width = 1335 Width = 1335
End End
Begin VB.TextBox Text_Step Begin VB.TextBox Text_Step
@ -43,8 +43,8 @@ Begin VB.Form Form_Rand_Case
Height = 375 Height = 375
Left = 3960 Left = 3960
Locked = -1 'True Locked = -1 'True
TabIndex = 7 TabIndex = 9
Top = 3080 Top = 3720
Width = 1335 Width = 1335
End End
Begin VB.TextBox Text_Code Begin VB.TextBox Text_Code
@ -61,8 +61,8 @@ Begin VB.Form Form_Rand_Case
Height = 375 Height = 375
Left = 3960 Left = 3960
Locked = -1 'True Locked = -1 'True
TabIndex = 6 TabIndex = 8
Top = 2560 Top = 3240
Width = 1335 Width = 1335
End End
Begin VB.Frame Frame Begin VB.Frame Frame
@ -72,20 +72,29 @@ Begin VB.Form Form_Rand_Case
TabIndex = 0 TabIndex = 0
Top = 120 Top = 120
Width = 1335 Width = 1335
Begin VB.OptionButton Option_Difficulty_Rand
Caption = "Ëæ»ú"
Height = 180
Left = 240
TabIndex = 6
Top = 1880
Value = -1 'True
Width = 735
End
Begin VB.OptionButton Option_Difficulty_5 Begin VB.OptionButton Option_Difficulty_5
Caption = "骨灰" Caption = "骨灰"
Height = 255 Height = 180
Left = 240 Left = 240
TabIndex = 5 TabIndex = 5
Top = 1800 Top = 1560
Width = 735 Width = 735
End End
Begin VB.OptionButton Option_Difficulty_4 Begin VB.OptionButton Option_Difficulty_4
Caption = "困难" Caption = "困难"
Height = 255 Height = 180
Left = 240 Left = 240
TabIndex = 4 TabIndex = 4
Top = 1440 Top = 1240
Width = 735 Width = 735
End End
Begin VB.OptionButton Option_Difficulty_3 Begin VB.OptionButton Option_Difficulty_3
@ -93,7 +102,7 @@ Begin VB.Form Form_Rand_Case
Height = 180 Height = 180
Left = 240 Left = 240
TabIndex = 3 TabIndex = 3
Top = 1080 Top = 920
Width = 735 Width = 735
End End
Begin VB.OptionButton Option_Difficulty_2 Begin VB.OptionButton Option_Difficulty_2
@ -101,7 +110,7 @@ Begin VB.Form Form_Rand_Case
Height = 180 Height = 180
Left = 240 Left = 240
TabIndex = 2 TabIndex = 2
Top = 720 Top = 600
Width = 735 Width = 735
End End
Begin VB.OptionButton Option_Difficulty_1 Begin VB.OptionButton Option_Difficulty_1
@ -109,7 +118,7 @@ Begin VB.Form Form_Rand_Case
Height = 180 Height = 180
Left = 240 Left = 240
TabIndex = 1 TabIndex = 1
Top = 360 Top = 280
Width = 735 Width = 735
End End
End End
@ -120,11 +129,7 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block Dim Block(0 To 9) As Block_struct
address As Integer
style As Integer
End Type
Dim Block(0 To 9) As Case_Block
Dim Rand_Cases(1 To 8000) As String Dim Rand_Cases(1 To 8000) As String
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load() Private Sub Form_Load()
@ -155,12 +160,12 @@ End Sub
Private Sub Command_Create_Click() Private Sub Command_Create_Click()
Dim min_step As Integer, max_step As Integer Dim min_step As Integer, max_step As Integer
Dim index As Long, code As String, step As Integer Dim index As Long, code As String, step As Integer
If Option_Difficulty_1.Value = False And Option_Difficulty_2.Value = False And Option_Difficulty_3.Value = False And Option_Difficulty_4.Value = False And Option_Difficulty_5.Value = False Then min_step = 0: max_step = 138
If Option_Difficulty_1.Value = True Then min_step = 0: max_step = 20 If Option_Difficulty_1.Value = True Then min_step = 0: max_step = 20
If Option_Difficulty_2.Value = True Then min_step = 21: max_step = 50 If Option_Difficulty_2.Value = True Then min_step = 21: max_step = 50
If Option_Difficulty_3.Value = True Then min_step = 51: max_step = 80 If Option_Difficulty_3.Value = True Then min_step = 51: max_step = 80
If Option_Difficulty_4.Value = True Then min_step = 81: max_step = 100 If Option_Difficulty_4.Value = True Then min_step = 81: max_step = 100
If Option_Difficulty_5.Value = True Then min_step = 101: max_step = 138 If Option_Difficulty_5.Value = True Then min_step = 101: max_step = 138
If Option_Difficulty_Rand.Value = True Then min_step = 0: max_step = 138
Randomize Randomize
retry: retry:
index = Int(Rnd * 8000) + 1 index = Int(Rnd * 8000) + 1
@ -187,6 +192,9 @@ End Sub
Private Sub Option_Difficulty_5_Click() Private Sub Option_Difficulty_5_Click()
Call Command_Create_Click Call Command_Create_Click
End Sub End Sub
Private Sub Option_Difficulty_Rand_Click()
Call Command_Create_Click
End Sub
Private Sub Get_Rand_Data() Private Sub Get_Rand_Data()
Dim i As Long Dim i As Long
Dim temp As String Dim temp As String
@ -199,13 +207,13 @@ Private Sub Get_Rand_Data()
Close #1 Close #1
End Sub End Sub
Private Sub Output_Graph() Private Sub Output_Graph()
Dim m, x, y As Integer Dim m, X, Y As Integer
Dim width As Integer, height 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 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 For m = 0 To 9
If Block(m).address <> 25 Then If Block(m).address <> 25 Then
x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x X = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y Y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
If Block(m).style = 0 Or Block(m).style = 1 Then If Block(m).style = 0 Or Block(m).style = 1 Then
width = square_width * 2 + gap width = square_width * 2 + gap
Else Else
@ -216,7 +224,7 @@ Private Sub Output_Graph()
Else Else
height = square_width height = square_width
End If End If
Print_Block x, y, width, height, block_line_width, block_color, block_line_color Print_Block X, Y, width, height, block_line_width, block_color, block_line_color
End If End If
Next m Next m
End Sub End Sub

37
Form_Solution.frm
View File

@ -13,6 +13,14 @@ Begin VB.Form Form_Solution
ScaleHeight = 5145 ScaleHeight = 5145
ScaleWidth = 5295 ScaleWidth = 5295
StartUpPosition = 2 '亅躉笢陑 StartUpPosition = 2 '亅躉笢陑
Begin VB.CommandButton Command_Output
Caption = "µ¼³öÊý¾Ý"
Height = 470
Left = 3720
TabIndex = 7
Top = 4560
Width = 1455
End
Begin VB.Timer Timer_Play Begin VB.Timer Timer_Play
Enabled = 0 'False Enabled = 0 'False
Interval = 1000 Interval = 1000
@ -23,7 +31,7 @@ Begin VB.Form Form_Solution
Caption = "ˇ佛" Caption = "ˇ佛"
Height = 470 Height = 470
Left = 3000 Left = 3000
TabIndex = 5 TabIndex = 6
Top = 4560 Top = 4560
Width = 615 Width = 615
End End
@ -31,7 +39,7 @@ Begin VB.Form Form_Solution
Caption = "ˇ" Caption = "ˇ"
Height = 470 Height = 470
Left = 2400 Left = 2400
TabIndex = 4 TabIndex = 5
Top = 4560 Top = 4560
Width = 615 Width = 615
End End
@ -39,7 +47,7 @@ Begin VB.Form Form_Solution
Caption = "畦溫" Caption = "畦溫"
Height = 470 Height = 470
Left = 1320 Left = 1320
TabIndex = 3 TabIndex = 4
Top = 4560 Top = 4560
Width = 1095 Width = 1095
End End
@ -47,7 +55,7 @@ Begin VB.Form Form_Solution
Caption = "ˉ" Caption = "ˉ"
Height = 470 Height = 470
Left = 720 Left = 720
TabIndex = 2 TabIndex = 3
Top = 4560 Top = 4560
Width = 615 Width = 615
End End
@ -55,17 +63,17 @@ Begin VB.Form Form_Solution
Caption = "佛ˉ" Caption = "佛ˉ"
Height = 470 Height = 470
Left = 120 Left = 120
TabIndex = 1 TabIndex = 2
Top = 4560 Top = 4560
Width = 615 Width = 615
End End
Begin VB.ListBox List_Solution Begin VB.ListBox List_Solution
Height = 4740 Height = 4200
ItemData = "Form_Solution.frx":0000 ItemData = "Form_Solution.frx":0000
Left = 3720 Left = 3720
List = "Form_Solution.frx":0002 List = "Form_Solution.frx":0002
TabIndex = 0 TabIndex = 1
Top = 290 Top = 285
Width = 1455 Width = 1455
End End
Begin VB.Timer Timer_Get_Data Begin VB.Timer Timer_Get_Data
@ -77,7 +85,7 @@ Begin VB.Form Form_Solution
AutoSize = -1 'True AutoSize = -1 'True
Height = 180 Height = 180
Left = 0 Left = 0
TabIndex = 6 TabIndex = 0
Top = 80 Top = 80
Width = 90 Width = 90
End End
@ -88,12 +96,8 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Type Case_Block
address As Integer
style As Integer
End Type
Dim wait_data As Boolean Dim wait_data As Boolean
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Block_struct
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load() Private Sub Form_Load()
start_x = 135 start_x = 135
@ -107,7 +111,7 @@ Private Sub Form_Load()
End If End If
wait_file_name = start_code & ".txt" wait_file_name = start_code & ".txt"
If Dir(start_code & ".txt") <> "" Then Kill start_code & ".txt" If Dir(start_code & ".txt") <> "" Then Kill start_code & ".txt"
Shell "Engine.exe -q " & start_code Shell "Engine.exe -q " & start_code, vbHide
wait_cancel = False wait_cancel = False
waiting = True waiting = True
wait_data = True wait_data = True
@ -161,6 +165,9 @@ Private Sub Timer_Get_Data_Timer()
End If End If
End If End If
End Sub End Sub
Private Sub Command_Output_Click()
MsgBox "»¹Ã»×öºÃÄØQAQ", , "> _ <"
End Sub
Private Sub Get_Data(file_name As String) Private Sub Get_Data(file_name As String)
Dim temp As String, i As Integer, num As Integer Dim temp As String, i As Integer, num As Integer
Open file_name For Input As #1 Open file_name For Input As #1

91
Form_Start.frm
View File

@ -0,0 +1,91 @@
VERSION 5.00
Begin VB.Form Form_Start
BorderStyle = 1 'Fixed Single
Caption = "选择初始布局"
ClientHeight = 2145
ClientLeft = 45
ClientTop = 390
ClientWidth = 3585
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2145
ScaleWidth = 3585
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer
Interval = 100
Left = 0
Top = 0
End
Begin VB.TextBox Text
Height = 270
Left = 0
TabIndex = 0
Top = 2300
Width = 180
End
Begin VB.CommandButton Command_Favourite
Caption = "收藏的布局"
Height = 1095
Left = 1800
TabIndex = 4
Top = 1080
Width = 1815
End
Begin VB.CommandButton Command_Rand_Case
Caption = "随机生成布局"
Height = 1095
Left = 0
TabIndex = 3
Top = 1080
Width = 1815
End
Begin VB.CommandButton Command_Select_Case
Caption = "选择经典布局"
Height = 1095
Left = 1800
TabIndex = 2
Top = 0
Width = 1815
End
Begin VB.CommandButton Command_Create_Case
Caption = "自定义布局"
Height = 1095
Left = 0
TabIndex = 1
Top = 0
Width = 1815
End
End
Attribute VB_Name = "Form_Start"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
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
End Sub
Private Sub Command_Create_Case_Click()
Form_Creator.Show 1
End Sub
Private Sub Command_Select_Case_Click()
Form_Classic_Cases.Show 1
End Sub
Private Sub Command_Rand_Case_Click()
Form_Rand_Case.Show 1
End Sub
Private Sub Command_Favourite_Click()
favourite_add_confirm = False
Form_Favourite.Show 1
End Sub
Private Sub Timer_Timer()
If change_case = True Then
Form_Game.Show
Unload Form_Start
End If
End Sub

7
HRD_Game.vbp
View File

@ -10,8 +10,9 @@ Form=Form_Favourite_Add.frm
Form=Form_Solution.frm Form=Form_Solution.frm
Form=Form_Wait.frm Form=Form_Wait.frm
Form=Form_Detail.frm Form=Form_Detail.frm
Form=Form_Start.frm
IconForm="Form_Game" IconForm="Form_Game"
Startup="Form_Game" Startup="Sub Main"
HelpFile="" HelpFile=""
Title="HRD_Game" Title="HRD_Game"
ExeName32="HRD_Game.exe" ExeName32="HRD_Game.exe"
@ -19,8 +20,8 @@ Command32=""
Name="HRD_Game" Name="HRD_Game"
HelpContextID="0" HelpContextID="0"
CompatibleMode="0" CompatibleMode="0"
MajorVer=1 MajorVer=2
MinorVer=9 MinorVer=0
RevisionVer=0 RevisionVer=0
AutoIncrementVer=0 AutoIncrementVer=0
ServerSupportFiles=0 ServerSupportFiles=0

3
HRD_Game.vbw
View File

@ -1,4 +1,4 @@
Form_Game = 52, 51, 883, 479, Z, 26, 28, 857, 453, C Form_Game = 52, 51, 883, 479, , 26, 28, 857, 453, C
Module = 52, 52, 883, 479, Module = 52, 52, 883, 479,
Form_Classic_Cases = 104, 104, 891, 531, , 104, 104, 937, 531, C Form_Classic_Cases = 104, 104, 891, 531, , 104, 104, 937, 531, C
Form_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, C Form_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, C
@ -8,3 +8,4 @@ Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C
Form_Solution = 104, 104, 862, 531, , 0, 0, 758, 427, C Form_Solution = 104, 104, 862, 531, , 0, 0, 758, 427, C
Form_Wait = 104, 104, 862, 531, , 78, 78, 836, 505, C Form_Wait = 104, 104, 862, 531, , 78, 78, 836, 505, C
Form_Detail = 26, 26, 784, 453, , 78, 78, 836, 505, C Form_Detail = 26, 26, 784, 453, , 78, 78, 836, 505, C
Form_Start = 130, 130, 888, 557, Z, 104, 104, 862, 531, C

29
Module.bas
View File

@ -10,6 +10,15 @@ Public Type FILETIME
dwLowDateTime As Long dwLowDateTime As Long
dwHighDateTime As Long dwHighDateTime As Long
End Type End Type
Public Type Block_struct
address As Integer
style As Integer
End Type
Public Type Layer_struct
size As Integer
layer_dat() As String
End Type
Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_CURRENT_USER = &H80000001
@ -17,15 +26,18 @@ Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003 Public Const HKEY_USERS = &H80000003
Public debug_mode As Boolean, on_top As Boolean, playing As Boolean, solve_compete As Boolean Public debug_mode As Boolean, on_top As Boolean
Public playing As Boolean, solve_compete As Boolean
Public block_line_width As Integer, case_line_width As Integer Public block_line_width As Integer, case_line_width As Integer
Public block_color, block_line_color, case_color, case_line_color Public block_color, block_line_color, case_color, case_line_color
Public change_case As Boolean, change_case_title As String, change_case_code As String
Public change_case As Boolean, change_case_title As String, change_case_code As String, start_code As String
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 wait_file_name As String, wait_cancel As Boolean, waiting As Boolean
Public start_code As String Public layer() As Layer_struct
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
@ -75,5 +87,14 @@ Public Sub Save_Favourite_Cases()
w.regWrite "HKEY_CURRENT_USER\Software\HRD_Game\Favourite\" & temp & "." & Favourite_Cases_name(i) & "\", Favourite_Cases_code(i), "REG_SZ" w.regWrite "HKEY_CURRENT_USER\Software\HRD_Game\Favourite\" & temp & "." & Favourite_Cases_name(i) & "\", Favourite_Cases_code(i), "REG_SZ"
Next i Next i
End Sub End Sub
Sub main()
block_line_width = 1
case_line_width = 2
block_line_color = RGB(0, 158, 240)
case_line_color = RGB(0, 158, 240)
block_color = RGB(225, 245, 255)
case_color = RGB(248, 254, 255)
'Form_Game.Show
Form_Start.Show
End Sub

Write Preview
Loading…
Cancel
Save