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
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 43
      Form_Classic_Cases.frm
  2. BIN
      Form_Classic_Cases.frx
  3. 816
      Form_Creator.frm
  4. 40
      Form_Detail.frm
  5. 110
      Form_Favourite.frm
  6. 34
      Form_Favourite_Add.frm
  7. 459
      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

43
Form_Classic_Cases.frm
View File

@ -25,7 +25,7 @@ Begin VB.Form Form_Classic_Cases
Alignment = 2 'Center
BeginProperty Font
Name = "΢ÈíÑźÚ"
Size = 15.75
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
@ -43,14 +43,14 @@ Begin VB.Form Form_Classic_Cases
Caption = "ËÑË÷"
Height = 255
Left = 2280
TabIndex = 3
TabIndex = 2
Top = 480
Width = 735
End
Begin VB.TextBox Text_Search
Height = 270
Left = 120
TabIndex = 2
TabIndex = 1
Top = 480
Width = 2055
End
@ -70,14 +70,16 @@ Begin VB.Form Form_Classic_Cases
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 1
TabIndex = 0
Top = 120
Width = 2895
End
Begin VB.ListBox List_Cases
Height = 3840
ItemData = "Form_Classic_Cases.frx":0000
Left = 120
TabIndex = 0
List = "Form_Classic_Cases.frx":0002
TabIndex = 3
Top = 840
Width = 2895
End
@ -88,12 +90,8 @@ 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 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
Private Sub Form_Load()
start_x = 3200
@ -115,17 +113,14 @@ Private Sub Command_Confirm_Click()
Unload Form_Classic_Cases
End Sub
Private Sub List_Cases_Click()
Dim temp As String
Text_Tip = "(" & List_Cases.ListIndex + 1 & "/" & List_Cases.ListCount & ")"
temp = List_Cases.List(List_Cases.ListIndex)
Text_Code = Mid(temp, Len(temp) - 7, 7)
Text_Code = Mid(List_Cases.List(List_Cases.ListIndex), Len(List_Cases.List(List_Cases.ListIndex)) - 7, 7)
Call Analyse_Code(Text_Code)
Call Output_Graph
End Sub
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 searching As Boolean
ReDim temp(0)
If Text_Search = "" Then Exit Sub
last_select = Combo_Cases.ListIndex
@ -144,6 +139,7 @@ Private Sub Command_Search_Click()
End If
Next i
Next j
If debug_mode = True Then MsgBox "last_select=" & last_select & vbCrLf & "searching=" & searching & vbCrLf & "temp->" & UBound(temp), , "Debug"
List_Cases.Clear
Combo_Cases.AddItem "ËÑË÷½á¹û"
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.ListIndex = last_select
End If
MsgBox "No Result!"
MsgBox "ÕÒ²»µ½ÍÛ", , "> _ <"
Exit Sub
End If
For i = 1 To UBound(temp)
@ -217,13 +213,13 @@ Private Sub Get_Cases_title()
Close #1
End Sub
Private Sub Output_Graph()
Dim m, x, y As Integer
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
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
@ -234,7 +230,7 @@ Private Sub Output_Graph()
Else
height = square_width
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
Next m
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_line_color, B
End Sub
Private Sub Analyse_Code(Code As String)
Private Sub Analyse_Code(code As String)
On Error Resume Next
Dim temp(1 To 12) 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 dat As String
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) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
b1 = num Mod 4
@ -271,7 +267,7 @@ Private Sub Analyse_Code(Code As String)
Block(i).address = 69
Block(i).style = 69
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) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
Block(0).address = num
@ -316,4 +312,3 @@ Private Sub Analyse_Code(Code As String)
Next i
err:
End Sub

BIN
Form_Classic_Cases.frx
View File

Binary file not shown.

816
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 = "全局溯源分析"
Height = 300
Left = 2520
TabIndex = 4
TabIndex = 3
Top = 120
Width = 1695
End
@ -30,7 +30,7 @@ Begin VB.Form Form_Detail
Height = 4380
Left = 7960
MultiLine = -1 'True
TabIndex = 3
TabIndex = 4
Top = 120
Width = 2415
End
@ -52,7 +52,7 @@ Begin VB.Form Form_Detail
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 1
TabIndex = 0
Top = 120
Width = 2295
End
@ -61,7 +61,7 @@ Begin VB.Form Form_Detail
ItemData = "Form_Detail.frx":0004
Left = 120
List = "Form_Detail.frx":0006
TabIndex = 0
TabIndex = 1
Top = 480
Width = 2295
End
@ -72,19 +72,11 @@ 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
Private Type Layer_struct
size As Integer
layer_dat() As String
End Type
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 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()
start_x = 4350
start_y = 135
@ -106,7 +98,7 @@ Private Sub Form_Load()
ReDim min_solutions(0)
ReDim farthest_cases(0)
ReDim solutions(0)
ReDim layers(0)
ReDim list_dat(0)
ReDim layer(0 To 0)
Combo_Detail.AddItem "最少步解"
Combo_Detail.AddItem "所有的解"
@ -114,7 +106,7 @@ Private Sub Form_Load()
Combo_Detail.AddItem "各步数的布局"
wait_file_name = 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
waiting = True
wait_data = True
@ -200,7 +192,7 @@ Private Sub Get_Data(file_name As String)
ReDim min_solutions(0)
ReDim farthest_cases(0)
ReDim solutions(0)
ReDim layers(0)
ReDim list_dat(0)
Open file_name For Input As #1
Line Input #1, temp: Line Input #1, temp
group_size = temp
@ -228,8 +220,8 @@ Private Sub Get_Data(file_name As String)
Wend
Line Input #1, temp
While (temp <> "[Layer]")
ReDim Preserve layers(UBound(layers) + 1)
layers(UBound(layers)) = temp
ReDim Preserve list_dat(UBound(list_dat) + 1)
list_dat(UBound(list_dat)) = temp
Line Input #1, temp
Wend
Close #1
@ -237,10 +229,10 @@ Private Sub Get_Data(file_name As String)
End Sub
Private Sub split_layer()
Dim i As Long, code As String, num As Integer, index As Integer
For i = 1 To UBound(layers)
code = Mid(layers(i), InStr(1, layers(i), ">") + 2, 7)
num = Mid(layers(i), InStr(1, layers(i), "(") + 1, InStr(1, layers(i), ",") - InStr(1, layers(i), "(") - 1)
index = Mid(layers(i), InStr(1, layers(i), ",") + 1, Len(layers(i)) - InStr(1, layers(i), ",") - 1)
For i = 1 To UBound(list_dat)
code = Mid(list_dat(i), InStr(1, list_dat(i), ">") + 2, 7)
num = Mid(list_dat(i), InStr(1, list_dat(i), "(") + 1, InStr(1, list_dat(i), ",") - InStr(1, list_dat(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(num).layer_dat(0 To index)
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 & "farthest_cases->" & UBound(farthest_cases) & 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
Text_Debug = debug_dat
End Sub

110
Form_Favourite.frm
View File

@ -6,13 +6,26 @@ Begin VB.Form Form_Favourite
ClientHeight = 4590
ClientLeft = 45
ClientTop = 390
ClientWidth = 6765
ClientWidth = 6750
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4590
ScaleWidth = 6765
ScaleWidth = 6750
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
Alignment = 2 'Center
BeginProperty Font
@ -27,44 +40,60 @@ Begin VB.Form Form_Favourite
Height = 495
Left = 3720
Locked = -1 'True
TabIndex = 5
Top = 3960
TabIndex = 7
Top = 3975
Width = 1935
End
Begin VB.CommandButton Command_Confirm
Caption = "确定"
Height = 495
Left = 5640
TabIndex = 4
Top = 3960
TabIndex = 6
Top = 3975
Width = 975
End
Begin VB.CommandButton Command_Delete
Caption = "删除"
Height = 495
Height = 480
Left = 5640
TabIndex = 3
Top = 3480
TabIndex = 5
Top = 3510
Width = 975
End
Begin VB.CommandButton Command_Modify
Caption = "修改"
Height = 495
Height = 480
Left = 4680
TabIndex = 2
Top = 3480
TabIndex = 4
Top = 3510
Width = 975
End
Begin VB.CommandButton Command_Add
Caption = "添加"
Height = 495
Height = 480
Left = 3720
TabIndex = 1
Top = 3480
TabIndex = 3
Top = 3510
Width = 975
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
Height = 3300
Height = 2940
ItemData = "Form_Favourite.frx":0000
Left = 3720
List = "Form_Favourite.frx":0002
@ -84,18 +113,21 @@ 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 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
Private Sub Form_Load()
start_x = 135
start_y = 135
square_width = 770
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
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
Else
@ -114,6 +146,28 @@ Private Sub Command_Confirm_Click()
change_case = True
Unload Form_Favourite
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()
change_mode = False
favourite_add_save = False
@ -286,3 +340,17 @@ Private Sub Analyse_Code(code As String)
Next i
err:
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_Exposed = False
Option Explicit
Private Type Case_Block
address As Integer
style As Integer
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 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 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_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 limit(-1 To 1, -1 To 1) As Boolean
Private Sub Form_Load()
start_x = 120
start_y = 120
@ -485,10 +481,10 @@ Private Function Check() As Boolean
Next i
Check = True
If Block(0).style <> 0 Or Block(0).address > 20 Or Block(0).address < 0 Then
Check = False
Check = False: GoTo check_err
Else
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 + 1) = True
temp(addr + 4) = True
@ -496,20 +492,20 @@ Private Function Check() As Boolean
End If
For i = 1 To 5
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
Check = False
Check = False: GoTo check_err
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
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: GoTo check_err
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
If addr > 15 Then Check = False: GoTo check_err
If temp(addr) = True Or temp(addr + 4) = True Then Check = False: GoTo check_err
temp(addr) = True
temp(addr + 4) = True
End If
@ -517,11 +513,11 @@ Private Function Check() As Boolean
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
Check = False: GoTo check_err
Else
addr = Block(i).address
If addr > 19 Then Check = False
If temp(addr) = True Then Check = False
If addr > 19 Then Check = False: GoTo check_err
If temp(addr) = True Then Check = False: GoTo check_err
temp(addr) = True
End If
Next i
@ -529,7 +525,8 @@ Private Function Check() As Boolean
For i = 0 To 19
If temp(i) = False Then j = j + 1
Next i
If j <> 2 Then Check = False
If j <> 2 Then Check = False: GoTo check_err
check_err:
End Function
Private Function Get_Code() As String
On Error Resume Next
@ -609,6 +606,7 @@ End Function
Private Sub Analyse(code As String)
Dim m As Integer, addr As Integer, X As Integer, Y As Integer
Call Analyse_Code(code)
If Check = False Then Call Case_init: Exit Sub
For X = 1 To 4
For Y = 1 To 5
Block_index(X, Y) = 10

459
Form_Game.frm
View File

@ -2,7 +2,7 @@ VERSION 5.00
Begin VB.Form Form_Game
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "HRD Game v1.9 by Dnomd343"
Caption = "HRD Game v2.0 by Dnomd343"
ClientHeight = 7305
ClientLeft = 45
ClientTop = 690
@ -15,100 +15,132 @@ Begin VB.Form Form_Game
ScaleHeight = 7305
ScaleWidth = 7290
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame_Analyse
Caption = "分析"
Height = 1335
Left = 5640
TabIndex = 3
Top = 5760
Width = 1575
Begin VB.CommandButton Command_Detail
Caption = "详细解析"
Height = 495
Left = 5760
TabIndex = 15
Top = 6360
Width = 1335
End
Begin VB.CommandButton Command_Prompt
Caption = "提示下一步"
Height = 495
Left = 5760
Left = 120
TabIndex = 14
Top = 4440
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Solution
Caption = "最少步解法"
Height = 495
Left = 5760
Left = 120
TabIndex = 13
Top = 5760
Top = 240
Width = 1335
End
Begin VB.CommandButton Command_Add_Favourite
Caption = "加入收藏"
End
Begin VB.Frame Frame_Game
Caption = "游戏"
Height = 2295
Left = 5640
TabIndex = 2
Top = 3360
Width = 1575
Begin VB.CommandButton Command_Reset
Caption = "重新开始"
Height = 495
Left = 5760
Left = 120
TabIndex = 12
Top = 2640
Top = 1680
Width = 1335
End
Begin VB.CommandButton Command_Favourite
Caption = "我的收藏"
Begin VB.CommandButton Command_Prompt
Caption = "提示下一步"
Height = 495
Left = 5760
Left = 120
TabIndex = 11
Top = 1920
Top = 1200
Width = 1335
End
Begin VB.CommandButton Command_Reduction_Snapshot
Caption = "还原快照"
Height = 495
Left = 5760
Left = 120
TabIndex = 10
Top = 3840
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Create_Snapshot
Caption = "创建快照"
Height = 495
Left = 5760
Left = 120
TabIndex = 9
Top = 3240
Top = 240
Width = 1335
End
End
Begin VB.Frame Frame_Favourite
Caption = "收藏"
Height = 1335
Left = 5640
TabIndex = 1
Top = 1920
Width = 1575
Begin VB.CommandButton Command_Add_Favourite
Caption = "加入收藏"
Height = 495
Left = 120
TabIndex = 8
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Favourite
Caption = "我的收藏"
Height = 495
Left = 120
TabIndex = 7
Top = 240
Width = 1335
End
End
Begin VB.Frame Frame_Start
Caption = "开始"
Height = 1815
Left = 5640
TabIndex = 0
Top = 0
Width = 1575
Begin VB.CommandButton Command_Rand_Case
Caption = "随机生成布局"
Height = 495
Left = 5760
TabIndex = 8
Top = 1320
Left = 120
TabIndex = 6
Top = 1200
Width = 1335
End
Begin VB.CommandButton Command_Select_Case
Caption = "选择经典布局"
Height = 495
Left = 5760
TabIndex = 7
Left = 120
TabIndex = 5
Top = 720
Width = 1335
End
Begin VB.CommandButton Command_Create_Case
Caption = "自定义布局"
Height = 495
Left = 5760
TabIndex = 6
Top = 120
Left = 120
TabIndex = 4
Top = 240
Width = 1335
End
End
Begin VB.Timer Timer_Layout
Interval = 300
Left = 0
Top = 0
End
Begin VB.CommandButton Command_Reset
Caption = "重新开始"
Height = 495
Left = 5760
TabIndex = 1
Top = 5040
Width = 1335
End
Begin VB.Timer Timer_Get_Time
Begin VB.Timer Timer_Timing
Enabled = 0 'False
Interval = 50
Left = 0
@ -120,18 +152,18 @@ Begin VB.Form Form_Game
Top = 0
End
Begin VB.TextBox Text_Debug
Height = 6855
Height = 6975
Left = 7320
MultiLine = -1 'True
TabIndex = 0
Top = 240
Width = 3735
TabIndex = 15
Top = 120
Width = 3855
End
Begin VB.Label Label_Code
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 5
TabIndex = 19
Top = 7000
Width = 90
End
@ -139,7 +171,7 @@ Begin VB.Form Form_Game
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 4
TabIndex = 18
Top = 7000
Width = 90
End
@ -148,7 +180,7 @@ Begin VB.Form Form_Game
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 3
TabIndex = 17
Top = 45
Width = 105
End
@ -156,7 +188,7 @@ Begin VB.Form Form_Game
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 2
TabIndex = 16
Top = 7000
Width = 90
End
@ -193,15 +225,11 @@ 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
Private Type Block_Address
X As Integer
Y As Integer
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 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
@ -213,10 +241,6 @@ Dim last_move As Integer, move_times As Integer
Dim total_steps As Long, total_time As Long
Dim snapshot_code As String, snapshot_step As Long
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()
block_line_width = 1
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
End If
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()
Me.Icon = Me.MouseIcon
debug_mode = False
on_top = True
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)
playing = False
solve_compete = False
start_x = 180
start_y = 300
gap = 105
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 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
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
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_y < start_y Or mouse_y > start_y + square_width * 5 + gap * 6 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))
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
X = Block(m).address - (Y - 1) * 4 + 1
If m = last_move Then
@ -380,12 +415,13 @@ Private Sub Form_Click()
Label_Step = "步数: " & total_steps
Label_Code = Get_Code()
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
If Block(0).address = 13 Then Call case_solve_compete
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_Create_Case_Click()
Form_Creator.Show 1
@ -400,18 +436,42 @@ Private Sub Command_Favourite_Click()
favourite_add_confirm = False
Form_Favourite.Show 1
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()
favourite_add_save = True
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
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()
If solve_compete = True 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_Code = snapshot_code
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
wait_cancel = False
waiting = True
prompt_wait_data = True
Form_Wait.Show 1
End Sub
Private Sub Command_Reset_Click()
total_steps = 0
Private Sub start_playing()
playing = True
total_time = 0
Timer_Get_Time.Enabled = False
Call init
Label_Step = "步数: 0"
Label_Code = start_code
Label_Time = "用时: 0:00:00"
Call Analyse(start_code)
Call Output_Graph
total_steps = 0
Timer_Timing.Enabled = True
End Sub
Private Sub init()
Private Sub case_solve_compete()
Timer_Timing = False
playing = False
solve_compete = False
Timer_Get_Time.Enabled = False
snapshot_step = -1
solve_compete = True
MsgBox "恭喜你成功完成！" & vbCrLf & "编码: " & start_code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "（>__<）"
End Sub
Private Sub change_start_case(title As String, code As String)
Label_Title.Caption = title & "(" & code & ")"
start_code = code
Call Command_Reset_Click
End Sub
Private Sub prompt_output()
Dim temp As String
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
move_times = 0
total_steps = 0
total_time = 0
start_x = 180
start_y = 300
gap = 105
square_width = 1200
Call Case_init
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(1) = start_x + gap / 2 + square_width + gap
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(4) = start_y + gap / 2 + (square_width + gap) * 4
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
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
@ -872,60 +935,6 @@ Private Sub Analyse(code As String)
Next Y
Next X
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)
On Error Resume Next
Dim temp(1 To 12) As Integer
@ -996,7 +1005,7 @@ Private Sub Analyse_Code(code As String)
Next i
err:
End Sub
Private Sub Timer_Get_Time_Timer()
Private Sub Timer_Timing_Timer()
Static temp As Integer
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)
@ -1007,6 +1016,27 @@ Private Sub Timer_Get_Time_Timer()
If Len(time_minute) = 1 Then time_minute = "0" & time_minute
Label_Time = "用时: " & time_hour & ":" & time_minute & ":" & time_second
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()
Dim i As Integer, j As Integer, m As Integer, debug_dat As String
For m = 0 To 9
@ -1033,79 +1063,22 @@ Private Sub Timer_Debug_Timer()
Next i
debug_dat = debug_dat & vbCrLf & vbCrLf
Next j
debug_dat = debug_dat & "dir_x1=" & dir_x1 & " dir_y1=" & dir_y1 & vbCrLf
debug_dat = debug_dat & "dir_x2=" & dir_x2 & " dir_y2=" & dir_y2 & 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 & "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(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 & "last_move=" & last_move & vbCrLf
debug_dat = debug_dat & "move_times=" & move_times & vbCrLf
debug_dat = debug_dat & "mouse_x=" & mouse_x & " mouse_y=" & mouse_y & " mouse_button=" & mouse_button & vbCrLf
debug_dat = debug_dat & "move_max_step=" & move_max_step & " last_move=" & last_move & " move_times=" & move_times & vbCrLf
debug_dat = debug_dat & vbCrLf
debug_dat = debug_dat & "total_steps=" & total_steps & vbCrLf
debug_dat = debug_dat & "total_time=" & total_time & vbCrLf
debug_dat = debug_dat & "total_steps=" & total_steps & " 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
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 '屏幕中心
Begin VB.CommandButton Command_Confirm
Caption = "确定"
Height = 495
Height = 505
Left = 3960
TabIndex = 9
Top = 4230
TabIndex = 10
Top = 4210
Width = 1335
End
Begin VB.CommandButton Command_Create
Caption = "生成"
Height = 495
Height = 505
Left = 3960
TabIndex = 8
Top = 3600
TabIndex = 7
Top = 2580
Width = 1335
End
Begin VB.TextBox Text_Step
@ -43,8 +43,8 @@ Begin VB.Form Form_Rand_Case
Height = 375
Left = 3960
Locked = -1 'True
TabIndex = 7
Top = 3080
TabIndex = 9
Top = 3720
Width = 1335
End
Begin VB.TextBox Text_Code
@ -61,8 +61,8 @@ Begin VB.Form Form_Rand_Case
Height = 375
Left = 3960
Locked = -1 'True
TabIndex = 6
Top = 2560
TabIndex = 8
Top = 3240
Width = 1335
End
Begin VB.Frame Frame
@ -72,20 +72,29 @@ Begin VB.Form Form_Rand_Case
TabIndex = 0
Top = 120
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
Caption = "骨灰"
Height = 255
Height = 180
Left = 240
TabIndex = 5
Top = 1800
Top = 1560
Width = 735
End
Begin VB.OptionButton Option_Difficulty_4
Caption = "困难"
Height = 255
Height = 180
Left = 240
TabIndex = 4
Top = 1440
Top = 1240
Width = 735
End
Begin VB.OptionButton Option_Difficulty_3
@ -93,7 +102,7 @@ Begin VB.Form Form_Rand_Case
Height = 180
Left = 240
TabIndex = 3
Top = 1080
Top = 920
Width = 735
End
Begin VB.OptionButton Option_Difficulty_2
@ -101,7 +110,7 @@ Begin VB.Form Form_Rand_Case
Height = 180
Left = 240
TabIndex = 2
Top = 720
Top = 600
Width = 735
End
Begin VB.OptionButton Option_Difficulty_1
@ -109,7 +118,7 @@ Begin VB.Form Form_Rand_Case
Height = 180
Left = 240
TabIndex = 1
Top = 360
Top = 280
Width = 735
End
End
@ -120,11 +129,7 @@ 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 Block(0 To 9) As Case_Block
Dim Block(0 To 9) As Block_struct
Dim Rand_Cases(1 To 8000) As String
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load()
@ -155,12 +160,12 @@ End Sub
Private Sub Command_Create_Click()
Dim min_step As Integer, max_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_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_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_Rand.Value = True Then min_step = 0: max_step = 138
Randomize
retry:
index = Int(Rnd * 8000) + 1
@ -187,6 +192,9 @@ End Sub
Private Sub Option_Difficulty_5_Click()
Call Command_Create_Click
End Sub
Private Sub Option_Difficulty_Rand_Click()
Call Command_Create_Click
End Sub
Private Sub Get_Rand_Data()
Dim i As Long
Dim temp As String
@ -199,13 +207,13 @@ Private Sub Get_Rand_Data()
Close #1
End Sub
Private Sub Output_Graph()
Dim m, x, y As Integer
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
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
@ -216,7 +224,7 @@ Private Sub Output_Graph()
Else
height = square_width
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
Next m
End Sub

37
Form_Solution.frm
View File

@ -13,6 +13,14 @@ Begin VB.Form Form_Solution
ScaleHeight = 5145
ScaleWidth = 5295
StartUpPosition = 2 '亅躉笢陑
Begin VB.CommandButton Command_Output
Caption = "µ¼³öÊý¾Ý"
Height = 470
Left = 3720
TabIndex = 7
Top = 4560
Width = 1455
End
Begin VB.Timer Timer_Play
Enabled = 0 'False
Interval = 1000
@ -23,7 +31,7 @@ Begin VB.Form Form_Solution
Caption = "ˇ佛"
Height = 470
Left = 3000
TabIndex = 5
TabIndex = 6
Top = 4560
Width = 615
End
@ -31,7 +39,7 @@ Begin VB.Form Form_Solution
Caption = "ˇ"
Height = 470
Left = 2400
TabIndex = 4
TabIndex = 5
Top = 4560
Width = 615
End
@ -39,7 +47,7 @@ Begin VB.Form Form_Solution
Caption = "畦溫"
Height = 470
Left = 1320
TabIndex = 3
TabIndex = 4
Top = 4560
Width = 1095
End
@ -47,7 +55,7 @@ Begin VB.Form Form_Solution
Caption = "ˉ"
Height = 470
Left = 720
TabIndex = 2
TabIndex = 3
Top = 4560
Width = 615
End
@ -55,17 +63,17 @@ Begin VB.Form Form_Solution
Caption = "佛ˉ"
Height = 470
Left = 120
TabIndex = 1
TabIndex = 2
Top = 4560
Width = 615
End
Begin VB.ListBox List_Solution
Height = 4740
Height = 4200
ItemData = "Form_Solution.frx":0000
Left = 3720
List = "Form_Solution.frx":0002
TabIndex = 0
Top = 290
TabIndex = 1
Top = 285
Width = 1455
End
Begin VB.Timer Timer_Get_Data
@ -77,7 +85,7 @@ Begin VB.Form Form_Solution
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 6
TabIndex = 0
Top = 80
Width = 90
End
@ -88,12 +96,8 @@ 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 Block(0 To 9) As Block_struct
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Private Sub Form_Load()
start_x = 135
@ -107,7 +111,7 @@ Private Sub Form_Load()
End If
wait_file_name = 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
waiting = True
wait_data = True
@ -161,6 +165,9 @@ Private Sub Timer_Get_Data_Timer()
End If
End If
End Sub
Private Sub Command_Output_Click()
MsgBox "»¹Ã»×öºÃÄØQAQ", , "> _ <"
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

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_Wait.frm
Form=Form_Detail.frm
Form=Form_Start.frm
IconForm="Form_Game"
Startup="Form_Game"
Startup="Sub Main"
HelpFile=""
Title="HRD_Game"
ExeName32="HRD_Game.exe"
@ -19,8 +20,8 @@ Command32=""
Name="HRD_Game"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=9
MajorVer=2
MinorVer=0
RevisionVer=0
AutoIncrementVer=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,
Form_Classic_Cases = 104, 104, 891, 531, , 104, 104, 937, 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_Wait = 104, 104, 862, 531, , 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
dwHighDateTime As Long
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_CURRENT_CONFIG = &H80000005
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_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_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_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 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)
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
@ -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"
Next i
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