From 7b25cc179de9aa1aa5915593e039bff3489e5de4 Mon Sep 17 00:00:00 2001 From: Dnomd343 Date: Wed, 15 Apr 2020 01:20:11 +0800 Subject: [PATCH] v2.0 --- Form_Classic_Cases.frm | 51 ++- Form_Classic_Cases.frx | Bin 0 -> 4 bytes Form_Creator.frm | 858 ++++++++++++++++++----------------------- Form_Detail.frm | 40 +- Form_Favourite.frm | 110 +++++- Form_Favourite_Add.frm | 34 +- Form_Game.frm | 545 +++++++++++++------------- Form_Rand_Case.frm | 62 +-- Form_Solution.frm | 37 +- Form_Start.frm | 91 +++++ HRD_Game.vbp | 7 +- HRD_Game.vbw | 3 +- Module.bas | 29 +- 13 files changed, 964 insertions(+), 903 deletions(-) create mode 100644 Form_Classic_Cases.frx create mode 100644 Form_Start.frm diff --git a/Form_Classic_Cases.frm b/Form_Classic_Cases.frm index 795d536..8fa5117 100644 --- a/Form_Classic_Cases.frm +++ b/Form_Classic_Cases.frm @@ -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) @@ -186,10 +182,10 @@ Private Sub Get_Cases(index As Integer) Line Input #1, temp If temp = "[Cases]" Then If num = index Then - Line Input #1, temp - Line Input #1, temp - tip = Right(temp, Len(temp) - 4) - Text_Tip = tip + Line Input #1, temp + Line Input #1, temp + tip = Right(temp, Len(temp) - 4) + Text_Tip = tip reinput: If EOF(1) = False Then Line Input #1, 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 - diff --git a/Form_Classic_Cases.frx b/Form_Classic_Cases.frx new file mode 100644 index 0000000000000000000000000000000000000000..593f4708db84ac8fd0f5cc47c634f38c013fe9e4 GIT binary patch literal 4 LcmZQzU|;|M00aO5 literal 0 HcmV?d00001 diff --git a/Form_Creator.frm b/Form_Creator.frm index ebb94d7..a2c5fdd 100644 --- a/Form_Creator.frm +++ b/Form_Creator.frm @@ -3,39 +3,47 @@ Begin VB.Form Form_Creator AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = "自定义华容道布局" - ClientHeight = 8115 + ClientHeight = 6675 ClientLeft = 45 ClientTop = 390 - ClientWidth = 5655 + ClientWidth = 4590 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False - ScaleHeight = 8115 - ScaleWidth = 5655 + ScaleHeight = 6675 + ScaleWidth = 4590 StartUpPosition = 2 '屏幕中心 Begin VB.CommandButton Command_Confirm Caption = "确定" Height = 495 - Left = 4080 + Left = 3240 TabIndex = 5 - Top = 7440 - Width = 1335 + Top = 6030 + Width = 1215 + End + Begin VB.CommandButton Command_Print + Caption = "解析编码" + Height = 495 + Left = 3240 + TabIndex = 2 + Top = 5550 + Width = 1215 End Begin VB.CommandButton Command_Clear Caption = "清除" Height = 495 - Left = 1560 + Left = 1320 TabIndex = 4 - Top = 7440 - Width = 2535 + Top = 6030 + Width = 1935 End Begin VB.CommandButton Command_Mirror Caption = "镜像" Height = 495 - Left = 240 + Left = 120 TabIndex = 3 - Top = 7440 - Width = 1335 + Top = 6030 + Width = 1215 End Begin VB.TextBox Text_Code Alignment = 2 'Center @@ -48,27 +56,20 @@ Begin VB.Form Form_Creator Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 495 - Left = 1560 + Height = 570 + Left = 1320 + MaxLength = 10 TabIndex = 0 - Top = 6960 - Width = 2535 + Top = 5550 + Width = 1935 End Begin VB.CommandButton Command_Get_Code Caption = "生成编码" Height = 495 - Left = 240 + Left = 120 TabIndex = 1 - Top = 6960 - Width = 1335 - End - Begin VB.CommandButton Command_Print - Caption = "解析编码" - Height = 495 - Left = 4080 - TabIndex = 2 - Top = 6960 - Width = 1335 + Top = 5550 + Width = 1215 End Begin VB.Timer Timer_Debug Interval = 200 @@ -76,12 +77,12 @@ Begin VB.Form Form_Creator Top = 0 End Begin VB.TextBox Text_Debug - Height = 7760 - Left = 5650 + Height = 6405 + Left = 4590 MultiLine = -1 'True TabIndex = 6 - Top = 180 - Width = 3495 + Top = 135 + Width = 3615 End End Attribute VB_Name = "Form_Creator" @@ -90,25 +91,27 @@ 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 print_now As Boolean -Dim click_x As Integer, click_y As Integer -Dim click_block_x As Integer, click_block_y As Integer -Dim block_start_x As Integer, block_start_y As Integer, block_width As Integer, block_height 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, print_now As Boolean +Dim delta_x As Integer, delta_y As Integer, locked_x As Integer, locked_y As Integer Private Sub Form_Load() + start_x = 165 + start_y = 150 + square_width = 930 + gap = 105 + print_now = False + Text_Code = "UnFinished" If debug_mode = True Then - Form_Creator.width = 9400 + Form_Creator.width = 8415 Text_Debug.Visible = True Else - Form_Creator.width = 5745 + Form_Creator.width = 4680 Text_Debug.Visible = False End If If on_top = True Then @@ -117,51 +120,66 @@ Private Sub Form_Load() SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2 End If Call init - Call mark -End Sub -Private Sub Form_DblClick() - Cls - Call mark - Call Output_Graph -End Sub -Private Sub init() - Cls - start_x = 200 - start_y = 200 - square_width = 1170 - gap = 120 Call Case_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 - x_split(3) = start_x + gap / 2 + (square_width + gap) * 3 - x_split(4) = start_x + gap + (square_width + gap) * 4 - y_split(0) = start_y - y_split(1) = start_y + gap / 2 + square_width + gap - y_split(2) = start_y + gap / 2 + (square_width + gap) * 2 - 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 + Call Text_Code_Change End Sub -Private Sub Command_Clear_Click() - Call Case_init - Call init - Cls - Call mark +Private Sub Text_Code_Change() + If print_now = True Then Exit Sub + Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color + If Len(Text_Code) = 7 Then + Call Analyse(UCase(Text_Code)) + If Check = True Then + Text_Code = UCase(Text_Code) + Call Output_Graph + End If + End If +End Sub +Private Sub Text_Code_KeyPress(KeyAscii As Integer) + If KeyAscii = 13 Then Call Command_Print_Click End Sub Private Sub Command_Confirm_Click() - change_case = True - change_case_title = "自定义" - change_case_code = Text_Code - Unload Form_Creator + If Text_Code = "UnFinished" Then + MsgBox "还没完成呢", , "> _ <" + Else + Call Analyse(UCase(Text_Code)) + If Check = True Then + change_case = True + change_case_title = "自定义" + change_case_code = Text_Code + Unload Form_Creator + Else + MsgBox "编码错误哦", , "> _ <" + Text_Code.SetFocus + Call Command_Clear_Click + End If + End If +End Sub +Private Sub Command_Print_Click() + If Text_Code = "UnFinished" Then + MsgBox "还没完成呢", , "> _ <" + Else + Call Analyse(UCase(Text_Code)) + If Check = True Then + Text_Code = UCase(Text_Code) + Call Output_Graph + Else + MsgBox "编码错误哦", , "> _ <" + Text_Code.SetFocus + Call Command_Clear_Click + End If + End If End Sub Private Sub Command_Get_Code_Click() - If Check_Compete = False Then MsgBox "UnFinished": Exit Sub + If Check_Compete = False Then MsgBox "还没完成呢", , "> _ <": Exit Sub Text_Code = Get_Code End Sub +Private Sub Command_Clear_Click() + Call Case_init + Cls + 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 Command_Mirror_Click() - Dim i As Integer, addr As Integer - Dim temp As Integer, temp_b As Boolean + Dim i As Integer, addr As Integer, temp As Integer, temp_b As Boolean For i = 0 To 9 addr = Block(i).address If Not addr = 25 Then @@ -196,62 +214,63 @@ Private Sub Command_Mirror_Click() Cls Call Output_Graph End Sub -Private Sub Command_Print_Click() - If Text_Code = "UnFinished" Then - MsgBox "UnFinished" - Else - Text_Code = UCase(Text_Code) - Analyse (Text_Code) - If Check = True Then - Call Output_Graph - Else - MsgBox "Error Code!" - Call Command_Clear_Click - End If - End If -End Sub -Private Sub Text_Code_Change() - If Text_Code = "UnFinished" Then Exit Sub - If Len(Text_Code) = 7 Then - Analyse (UCase(Text_Code)) - If Check = True Then - Call Output_Graph - Text_Code = UCase(Text_Code) - Else - Call Command_Clear_Click - End If - Else - Call Command_Clear_Click +Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + click_mouse_x = X + click_mouse_y = Y + click_x = Get_block_x(Int(X)) + click_y = Get_block_y(Int(Y)) + If click_x = 0 Or click_x = 5 Then Exit Sub + If click_y = 0 Or click_y = 6 Then Exit Sub + If Exist(click_x, click_y) = True Then + Call Clear_Block(Block_index(click_x, click_y)) + Text_Code = "UnFinished" + Call Output_Graph + Exit Sub End If + If Not Button = 1 Then Exit Sub + Call check_limit(click_x, click_y) + print_now = True + Call Form_MouseMove(Button, Shift, X, Y) End Sub -Private Sub Text_Code_KeyPress(KeyAscii As Integer) - If KeyAscii = 13 Then Call Command_Print_Click -End Sub -Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) - If Button = 1 And print_now = False Then - click_x = x - click_y = y - print_now = False - If click_x > start_x And click_x < start_x + square_width * 4 + gap * 5 Then - If click_y > start_y And click_y < start_y + square_width * 5 + gap * 6 Then - print_now = True - End If +Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) + Dim print_x As Integer, print_y As Integer, print_width As Integer, print_height As Integer + If print_now = True Then + delta_x = Get_Signed(Get_block_x(Int(X)) - click_x) + delta_y = Get_Signed(Get_block_y(Int(Y)) - click_y) + If delta_x = 0 And delta_y = 0 Then + locked_x = click_x + locked_y = click_y + ElseIf Abs(delta_x) = 1 And Abs(delta_y) = 1 Then + locked_x = click_x + delta_x + locked_y = click_y + delta_y + If limit(delta_x, delta_y) = True And limit(delta_x, 0) = False And limit(0, delta_y) = False Then + If Abs(click_mouse_x - X) < Abs(click_mouse_y - Y) Then locked_x = click_x Else locked_y = click_y + End If + If limit(delta_x, 0) = True Then locked_x = click_x + If limit(0, delta_y) = True Then locked_y = click_y + ElseIf Abs(delta_x) = 1 And Abs(delta_y) = 0 Then + locked_y = click_y + If limit(delta_x, delta_y) = True Then locked_x = click_x Else locked_x = click_x + delta_x + ElseIf Abs(delta_x) = 0 And Abs(delta_y) = 1 Then + locked_x = click_x + If limit(delta_x, delta_y) = True Then locked_y = click_y Else locked_y = click_y + delta_y End If - If print_now = True Then - click_block_x = Get_block_x(click_x) - click_block_y = Get_block_y(click_y) - If Exist(click_block_x, click_block_y) = True Then print_now = False - End If - Call Form_MouseMove(Button, Shift, x + 1, y + 1) - ElseIf Button = 2 Then - Dim m As Integer - m = Block_index(Get_block_x(Int(x)), Get_block_y(Int(y))) - If m <> 10 Then Call Clear_Block(m): Text_Code = "UnFinished" + print_x = Get_Min(click_x, locked_x) * (square_width + gap) - square_width + start_x + print_y = Get_Min(click_y, locked_y) * (square_width + gap) - square_width + start_y + If locked_x = click_x Then print_width = square_width Else print_width = square_width * 2 + gap + If locked_y = click_y Then print_height = square_width Else print_height = square_width * 2 + gap + Call Output_Graph + Print_Block print_x, print_y, print_width, print_height, block_line_width, block_color, block_line_color End If End Sub -Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) - Dim m As Integer, addr As Integer - If Button = 1 And print_now = True Then +Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) + Dim block_start_x As Integer, block_start_y As Integer, block_width As Integer, block_height As Integer + Dim addr As Integer, m As Integer + If print_now = True Then + block_start_x = Get_Min(click_x, locked_x) + block_start_y = Get_Min(click_y, locked_y) + block_width = Abs(click_x - locked_x) + 1 + block_height = Abs(click_y - locked_y) + 1 addr = (block_start_y - 1) * 4 + block_start_x - 1 If block_width = 2 And block_height = 2 Then If Block(0).address = 25 Then @@ -304,250 +323,120 @@ Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As End If Next m End If - If Check_Compete = True Then Call Command_Get_Code_Click Else Text_Code = "UnFinished" + Text_Code = "" + Call Output_Graph + If Check_Compete = True Then + Text_Code = Get_Code + Else + Text_Code = "UnFinished" + End If + print_now = False End If - Call Output_Graph - print_now = False End Sub -Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) - Dim output_x As Integer, output_y As Integer, output_width As Integer, output_height As Integer, locked_x As Integer, locked_y As Integer - If Button = 1 And print_now = True Then - Call Output_Graph - If x >= click_x Then - output_x = start_x + click_block_x * gap + (click_block_x - 1) * square_width - output_width = x - output_x - locked_x = x - If x > start_x + square_width * 4 + gap * 4 Then locked_x = start_x + square_width * 4 + gap * 4: output_width = locked_x - output_x - If output_width > square_width * 2 + gap Then output_width = square_width * 2 + gap: locked_x = output_x + output_width - block_start_x = click_block_x - block_width = Get_block_x(locked_x) - block_start_x + 1 - End If - If x < click_x Then - output_x = x - output_width = (start_x + click_block_x * gap + click_block_x * square_width) - x - locked_x = x - If x < start_x + gap Then output_width = (click_block_x - 1) * gap + click_block_x * square_width: locked_x = start_x + gap: output_x = locked_x - If output_width > square_width * 2 + gap Then locked_x = start_x + (click_block_x - 1) * gap + (click_block_x - 2) * square_width: output_width = square_width * 2 + gap: output_x = locked_x - block_start_x = Get_block_x(locked_x) - block_width = Get_block_x(click_x) - block_start_x + 1 - End If - If y >= click_y Then - output_y = start_y + click_block_y * gap + (click_block_y - 1) * square_width - output_height = y - output_y - locked_y = y - If y > start_y + square_width * 5 + gap * 5 Then locked_y = start_y + square_width * 5 + gap * 5: output_height = locked_y - output_y - If output_height > square_width * 2 + gap Then output_height = square_width * 2 + gap: locked_y = output_y + output_height - block_start_y = click_block_y - block_height = Get_block_y(locked_y) - block_start_y + 1 - End If - If y < click_y Then - output_y = y - output_height = (start_y + click_block_y * gap + click_block_y * square_width) - y - locked_y = y - If y < start_y + gap Then output_height = (click_block_y - 1) * gap + click_block_y * square_width: locked_y = start_y + gap: output_y = locked_y - If output_height > square_width * 2 + gap Then locked_y = start_y + (click_block_y - 1) * gap + (click_block_y - 2) * square_width: output_height = square_width * 2 + gap: output_y = locked_y - block_start_y = Get_block_y(locked_y) - block_height = Get_block_y(click_y) - block_start_y + 1 - End If - - Dim x_limit As Boolean, y_limit As Boolean, xy_limit As Boolean - If x >= click_x And y >= click_y Then - x_limit = False: y_limit = False: xy_limit = False - If block_start_x < 4 Then - If Exist(block_start_x + 1, block_start_y) = True Then x_limit = True - Else - x_limit = True - End If - If block_start_y < 5 Then - If Exist(block_start_x, block_start_y + 1) = True Then y_limit = True - Else - y_limit = True - End If - If block_start_x < 4 And block_start_y < 5 Then - If Exist(block_start_x + 1, block_start_y + 1) = True Then xy_limit = True - End If - If x_limit = True Then - If output_width > square_width Then output_width = square_width - If block_width = 2 Then block_width = 1 - End If - If y_limit = True Then - If output_height > square_width Then output_height = square_width - If block_height = 2 Then block_height = 1 - End If - If xy_limit = True And x_limit = False And y_limit = False Then - If output_width < output_height Then - If output_width > square_width Then output_width = square_width - If block_width = 2 Then block_width = 1 - Else - If output_height > square_width Then output_height = square_width - If block_height = 2 Then block_height = 1 - End If - End If +Private Sub check_limit(X As Integer, Y As Integer) + Dim i As Integer, j As Integer + For i = -1 To 1 + For j = -1 To 1 + limit(i, j) = False + Next j + Next i + If X = 1 Then + limit(-1, -1) = True: limit(-1, 0) = True: limit(-1, 1) = True + Else + If Exist(X - 1, Y) = True Then limit(-1, -1) = True: limit(-1, 0) = True: limit(-1, 1) = True + If Not Y = 1 Then + If Exist(X - 1, Y - 1) = True Then limit(-1, -1) = True End If - - If x >= click_x And y < click_y Then - x_limit = False: y_limit = False: xy_limit = False - If block_start_x < 4 Then - If Exist(block_start_x + 1, block_start_y + block_height - 1) = True Then x_limit = True - Else - x_limit = True - End If - If block_start_y + block_height - 1 > 1 Then - If Exist(block_start_x, block_start_y + block_height - 2) = True Then y_limit = True - Else - y_limit = True - End If - If block_start_x < 4 And block_start_y + block_height - 1 > 1 Then - If Exist(block_start_x + 1, block_start_y + block_height - 2) = True Then xy_limit = True - End If - If x_limit = True Then - If output_width > square_width Then output_width = square_width - If block_width = 2 Then block_width = 1 - End If - If y_limit = True Then - If output_height > square_width Then - output_y = output_y + output_height - square_width - output_height = square_width - End If - If block_height = 2 Then block_height = 1: block_start_y = block_start_y + 1 - End If - If xy_limit = True And x_limit = False And y_limit = False Then - If output_width < output_height Then - If output_width > square_width Then output_width = square_width - If block_width = 2 Then block_width = 1 - Else - If output_height > square_width Then output_y = output_y + output_height - square_width: output_height = square_width - If block_height = 2 Then block_height = 1: block_start_y = block_start_y + 1 - End If - End If + If Not Y = 5 Then + If Exist(X - 1, Y + 1) = True Then limit(-1, 1) = True End If - - If x < click_x And y >= click_y Then - x_limit = False: y_limit = False: xy_limit = False - If block_start_x + block_width - 1 > 1 Then - If Exist(block_start_x + block_width - 2, block_start_y) = True Then x_limit = True - Else - x_limit = True - End If - If block_start_y < 5 Then - If Exist(block_start_x + block_width - 1, block_start_y + 1) = True Then y_limit = True - Else - y_limit = True - End If - If block_start_x + block_width - 1 > 1 And block_start_y < 5 Then - If Exist(block_start_x + block_width - 2, block_start_y + 1) = True Then xy_limit = True - End If - If x_limit = True Then - If output_width > square_width Then - output_x = output_x + output_width - square_width - output_width = square_width - End If - If block_width = 2 Then block_width = 1: block_start_x = block_start_x + 1 - End If - If y_limit = True Then - If output_height > square_width Then output_height = square_width - If block_height = 2 Then block_height = 1 - End If - If xy_limit = True And x_limit = False And y_limit = False Then - If output_width < output_height Then - If output_width > square_width Then output_x = output_x + output_width - square_width: output_width = square_width - If block_width = 2 Then block_width = 1: block_start_x = block_start_x + 1 - Else - If output_height > square_width Then output_height = square_width - If block_height = 2 Then block_height = 1 - End If - End If + End If + If X = 4 Then + limit(1, -1) = True: limit(1, 0) = True: limit(1, 1) = True + Else + If Exist(X + 1, Y) = True Then limit(1, -1) = True: limit(1, 0) = True: limit(1, 1) = True + If Not Y = 1 Then + If Exist(X + 1, Y - 1) = True Then limit(1, -1) = True End If - - If x < click_x And y < click_y Then - x_limit = False: y_limit = False: xy_limit = False - If block_start_x + block_width - 1 > 1 Then - If Exist(block_start_x + block_width - 2, block_start_y + block_height - 1) = True Then x_limit = True - Else - x_limit = True - End If - If block_start_y + block_height - 1 > 1 Then - If Exist(block_start_x + block_width - 1, block_start_y + block_height - 2) = True Then y_limit = True - Else - y_limit = True - End If - If block_start_x + block_width - 1 > 1 And block_start_y < 5 Then - If Exist(block_start_x + block_width - 2, block_start_y + block_height - 2) = True Then xy_limit = True - End If - If x_limit = True Then - If output_width > square_width Then - output_x = output_x + output_width - square_width - output_width = square_width - End If - If block_width = 2 Then block_width = 1: block_start_x = block_start_x + 1 - End If - If y_limit = True Then - If output_height > square_width Then - output_y = output_y + output_height - square_width - output_height = square_width - End If - If block_height = 2 Then block_height = 1: block_start_y = block_start_y + 1 - End If - If xy_limit = True And x_limit = False And y_limit = False Then - If output_width < output_height Then - If output_width > square_width Then output_x = output_x + output_width - square_width: output_width = square_width - If block_width = 2 Then block_width = 1: block_start_x = block_start_x + 1 - Else - If output_height > square_width Then - output_y = output_y + output_height - square_width - output_height = square_width - End If - If block_height = 2 Then block_height = 1: block_start_y = block_start_y + 1 - End If - End If + If Not Y = 5 Then + If Exist(X + 1, Y + 1) = True Then limit(1, 1) = True End If - Print_Block output_x, output_y, output_width, output_height, block_line_width, block_color, block_line_color End If + If Y = 1 Then + limit(-1, -1) = True: limit(0, -1) = True: limit(1, -1) = True + Else + If Exist(X, Y - 1) = True Then limit(-1, -1) = True: limit(0, -1) = True: limit(1, -1) = True + If Not X = 1 Then + If Exist(X - 1, Y - 1) = True Then limit(-1, -1) = True + End If + If Not X = 4 Then + If Exist(X + 1, Y - 1) = True Then limit(1, -1) = True + End If + End If + If Y = 5 Then + limit(-1, 1) = True: limit(0, 1) = True: limit(1, 1) = True + Else + If Exist(X, Y + 1) = True Then limit(-1, 1) = True: limit(0, 1) = True: limit(1, 1) = True + If Not X = 1 Then + If Exist(X - 1, Y + 1) = True Then limit(-1, 1) = True + End If + If Not X = 4 Then + If Exist(X + 1, Y + 1) = True Then limit(1, 1) = True + End If + End If + If Not Block(0).address = 25 Then limit(-1, -1) = True: limit(-1, 1) = True: limit(1, -1) = True: limit(1, 1) = True End Sub -Private Function Get_block_x(x As Integer) As Integer +Private Function Get_Min(num_1 As Integer, num_2 As Integer) As Integer + If num_1 < num_2 Then Get_Min = num_1 Else Get_Min = num_2 +End Function +Private Function Get_Signed(num As Integer) As Integer + If num > 0 Then Get_Signed = 1 + If num = 0 Then Get_Signed = 0 + If num < 0 Then Get_Signed = -1 +End Function +Private Function Get_block_x(X As Integer) As Integer Dim i As Integer For i = 1 To 4 - If x > x_split(i - 1) And x < x_split(i) Then + If X >= x_split(i - 1) And X <= x_split(i) Then Get_block_x = i Exit For End If Next i + If X < x_split(0) Then Get_block_x = 0 + If X > x_split(4) Then Get_block_x = 5 End Function -Private Function Get_block_y(y As Integer) As Integer +Private Function Get_block_y(Y As Integer) As Integer Dim i As Integer For i = 1 To 5 - If y > y_split(i - 1) And y < y_split(i) Then + If Y >= y_split(i - 1) And Y <= y_split(i) Then Get_block_y = i Exit For End If Next i + If Y < y_split(0) Then Get_block_y = 0 + If Y > y_split(5) Then Get_block_y = 6 End Function -Private Sub mark() - Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color - If debug_mode = True Then - Dim i As Integer, j As Integer - DrawWidth = 1 - For i = 1 To 3 - Line (start_x + gap / 2 + (square_width + gap) * i, start_y)-(start_x + gap / 2 + (square_width + gap) * i, start_y + square_width * 5 + gap * 6) - Next i - For i = 1 To 4 - Line (start_x, start_y + gap / 2 + (square_width + gap) * i)-(start_x + square_width * 4 + gap * 5, start_y + gap / 2 + (square_width + gap) * i) - Next i - For i = 0 To 3 - For j = 0 To 4 - Line (start_x + square_width * i + gap * (i + 1), start_y + square_width * j + gap * (j + 1))-(start_x + square_width * (i + 1) + gap * (i + 1), start_y + square_width * (j + 1) + gap * (j + 1)), , B - Next j - Next i - End If +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 + x_split(3) = start_x + gap / 2 + (square_width + gap) * 3 + x_split(4) = start_x + gap + (square_width + gap) * 4 + y_split(0) = start_y + y_split(1) = start_y + gap / 2 + square_width + gap + y_split(2) = start_y + gap / 2 + (square_width + gap) * 2 + 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 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 - Call mark + 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 @@ -558,7 +447,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 @@ -582,6 +471,11 @@ Private Sub Case_init() Block_index(i, j) = 10 Next j Next i + For i = -1 To 1 + For j = -1 To 1 + limit(i, j) = False + Next j + Next i End Sub Private Function Check_Compete() Dim m As Integer @@ -594,45 +488,101 @@ Private Function Check_Compete() Check_Compete = True End Function Private Sub Clear_Block(m As Integer) - Dim x As Integer, y As Integer, addr As Integer + Dim X As Integer, Y As Integer, addr As Integer, style As Integer addr = Block(m).address - y = Int(addr / 4) + 1 - x = addr - (y - 1) * 4 + 1 - If Block(m).style = 0 Then - Exist(x, y) = False - Exist(x, y + 1) = False - Exist(x + 1, y) = False - Exist(x + 1, y + 1) = False - Block_index(x, y) = 10 - Block_index(x, y + 1) = 10 - Block_index(x + 1, y) = 10 - Block_index(x + 1, y + 1) = 10 + style = Block(m).style + Block(m).address = 25 + Block(m).style = 4 + Y = Int(addr / 4) + 1 + X = addr - (Y - 1) * 4 + 1 + If style = 0 Then + Exist(X, Y) = False + Exist(X, Y + 1) = False + Exist(X + 1, Y) = False + Exist(X + 1, Y + 1) = False + Block_index(X, Y) = 10 + Block_index(X, Y + 1) = 10 + Block_index(X + 1, Y) = 10 + Block_index(X + 1, Y + 1) = 10 End If - If Block(m).style = 1 Then - Exist(x, y) = False - Exist(x + 1, y) = False - Block_index(x, y) = 10 - Block_index(x + 1, y) = 10 + If style = 1 Then + Exist(X, Y) = False + Exist(X + 1, Y) = False + Block_index(X, Y) = 10 + Block_index(X + 1, Y) = 10 End If - If Block(m).style = 2 Then - Exist(x, y) = False - Exist(x, y + 1) = False - Block_index(x, y) = 10 - Block_index(x, y + 1) = 10 + If style = 2 Then + Exist(X, Y) = False + Exist(X, Y + 1) = False + Block_index(X, Y) = 10 + Block_index(X, Y + 1) = 10 End If - If Block(m).style = 3 Then - Exist(x, y) = False - Block_index(x, y) = 10 + If style = 3 Then + Exist(X, Y) = False + Block_index(X, Y) = 10 End If - Block(m).address = 25 - Block(m).style = 4 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: GoTo check_err + Else + addr = Block(0).address + 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 + temp(addr + 5) = True + End If + For i = 1 To 5 + If Block(i).address > 20 Or Block(i).address < 0 Then + Check = False: GoTo check_err + ElseIf Block(i).style <> 1 And Block(i).style <> 2 Then + 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: 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: 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 + 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: GoTo check_err + Else + addr = Block(i).address + 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 + j = 0 + For i = 0 To 19 + If temp(i) = False Then j = j + 1 + Next i + If j <> 2 Then Check = False: GoTo check_err +check_err: +End Function Private Function Get_Code() As String On Error Resume Next Dim temp(20) As Boolean Dim Table(20) As Integer Dim dat(1 To 12) As Integer - Dim Code As String + Dim code As String Dim i As Integer, addr As Integer, style As Integer, num As Integer For i = 0 To 19 temp(i) = False @@ -659,9 +609,9 @@ Private Function Get_Code() As String temp(Block(0).address + 4) = True temp(Block(0).address + 5) = True If Block(0).address < 10 Then - Code = Code & Block(0).address + code = code & Block(0).address Else - Code = Code & Chr(Block(0).address + 55) + code = code & Chr(Block(0).address + 55) End If addr = 0 num = 1 @@ -695,105 +645,52 @@ Private Function Get_Code() As String For i = 1 To 6 num = dat(i * 2 - 1) * 4 + dat(i * 2) If num < 10 Then - Code = Code & num + code = code & num Else - Code = Code & Chr(num + 55) + code = code & Chr(num + 55) End If Next i - Get_Code = Code + Get_Code = code 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) - For x = 1 To 4 - For y = 1 To 5 - Block_index(x, y) = 10 - Exist(x, y) = False - Next y - Next x +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 + Exist(X, Y) = False + Next Y + Next X For m = 0 To 9 addr = Block(m).address - y = Int(addr / 4) + 1 - x = addr - (y - 1) * 4 + 1 + Y = Int(addr / 4) + 1 + X = addr - (Y - 1) * 4 + 1 If Block(m).style = 0 Then - Block_index(x, y) = 0 - Block_index(x, y + 1) = 0 - Block_index(x + 1, y) = 0 - Block_index(x + 1, y + 1) = 0 + Block_index(X, Y) = 0 + Block_index(X, Y + 1) = 0 + Block_index(X + 1, Y) = 0 + Block_index(X + 1, Y + 1) = 0 End If If Block(m).style = 1 Then - Block_index(x, y) = m - Block_index(x + 1, y) = m + Block_index(X, Y) = m + Block_index(X + 1, Y) = m End If If Block(m).style = 2 Then - Block_index(x, y) = m - Block_index(x, y + 1) = m + Block_index(X, Y) = m + Block_index(X, Y + 1) = m End If If Block(m).style = 3 Then - Block_index(x, y) = m + Block_index(X, Y) = m End If Next m - For x = 1 To 4 - For y = 1 To 5 - If Block_index(x, y) <> 10 Then Exist(x, y) = True - Next y - Next x + For X = 1 To 4 + For Y = 1 To 5 + If Block_index(X, Y) <> 10 Then Exist(X, Y) = True + 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) +Private Sub Analyse_Code(code As String) On Error Resume Next Dim temp(1 To 12) As Integer Dim i, addr, style As Integer @@ -802,7 +699,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 @@ -818,7 +715,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 @@ -864,13 +761,14 @@ Private Sub Analyse_Code(Code As String) err: End Sub Private Sub Timer_Debug_Timer() - Dim i As Integer, j As Integer, m As Integer, debug_dat As String + Dim debug_dat As String + Dim i As Integer, j As Integer, m As Integer For m = 0 To 9 debug_dat = debug_dat & "Block[" & m & "] -> address = " & Block(m).address & " style = " & Block(m).style If m <> 9 Then debug_dat = debug_dat & vbCrLf Next m debug_dat = debug_dat & vbCrLf & vbCrLf - debug_dat = debug_dat & " exist block_index" & vbCrLf + debug_dat = debug_dat & " exist block_index limit" & vbCrLf For j = 1 To 5 For i = 1 To 4 If Exist(i, j) Then @@ -879,7 +777,7 @@ Private Sub Timer_Debug_Timer() debug_dat = debug_dat & "[] " End If Next i - debug_dat = debug_dat & " " + debug_dat = debug_dat & " " For i = 1 To 4 If Block_index(i, j) = 10 Then debug_dat = debug_dat & "A " @@ -887,25 +785,33 @@ Private Sub Timer_Debug_Timer() debug_dat = debug_dat & Trim(Block_index(i, j)) & " " End If Next i + debug_dat = debug_dat & " " + If j <= 3 Then + For i = -1 To 1 + If limit(i, j - 2) = True Then + debug_dat = debug_dat & "$$ " + Else + debug_dat = debug_dat & "[] " + End If + Next i + End If debug_dat = debug_dat & vbCrLf & vbCrLf Next j - debug_dat = debug_dat & "print_now = " & print_now & vbCrLf & "debug_mode = " & debug_mode - debug_dat = debug_dat & vbCrLf & vbCrLf - debug_dat = debug_dat & "click_x = " & click_x & vbCrLf & "click_y = " & click_y & vbCrLf - debug_dat = debug_dat & "click_block_x = " & click_block_x & vbCrLf & "click_block_y = " & click_block_y & vbCrLf - debug_dat = debug_dat & "block_start_x = " & block_start_x & vbCrLf & "block_start_y = " & block_start_y & vbCrLf & "block_width = " & block_width & vbCrLf & "block_height = " & block_height - debug_dat = debug_dat & vbCrLf & vbCrLf - debug_dat = debug_dat & "start_x = " & start_x & vbCrLf & "start_y = " & start_y & vbCrLf & "gap = " & gap & vbCrLf & "square_width = " & square_width - debug_dat = debug_dat & vbCrLf & "x_split: " + debug_dat = debug_dat & vbCrLf + debug_dat = debug_dat & "click_mouse_x=" & click_mouse_x & vbCrLf & "click_mouse_y=" & click_mouse_y & vbCrLf & vbCrLf + debug_dat = debug_dat & "click_x=" & click_x & " " & "click_y=" & click_y & vbCrLf + debug_dat = debug_dat & "delta_x=" & delta_x & " " & "delta_y=" & delta_y & vbCrLf + debug_dat = debug_dat & "locked_x=" & locked_x & " " & "locked_y=" & locked_y & vbCrLf + debug_dat = debug_dat & "print_now=" & print_now & vbCrLf + debug_dat = debug_dat & vbCrLf & "x_split:" For m = 0 To 4 debug_dat = debug_dat & x_split(m) If m <> 4 Then debug_dat = debug_dat & "|" Next m - debug_dat = debug_dat & vbCrLf & "y_split: " + debug_dat = debug_dat & vbCrLf & "y_split:" For m = 0 To 5 debug_dat = debug_dat & y_split(m) If m <> 5 Then debug_dat = debug_dat & "|" Next m Text_Debug = debug_dat End Sub - diff --git a/Form_Detail.frm b/Form_Detail.frm index db82a91..c2cd1d1 100644 --- a/Form_Detail.frm +++ b/Form_Detail.frm @@ -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 diff --git a/Form_Favourite.frm b/Form_Favourite.frm index ad9ea6e..ead4c1a 100644 --- a/Form_Favourite.frm +++ b/Form_Favourite.frm @@ -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 diff --git a/Form_Favourite_Add.frm b/Form_Favourite_Add.frm index 0117fa8..89a4080 100644 --- a/Form_Favourite_Add.frm +++ b/Form_Favourite_Add.frm @@ -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 diff --git a/Form_Game.frm b/Form_Game.frm index 5f6fb12..7253ce8 100644 --- a/Form_Game.frm +++ b/Form_Game.frm @@ -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.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 - TabIndex = 14 - Top = 4440 - Width = 1335 - End - Begin VB.CommandButton Command_Solution - Caption = "最少步解法" - Height = 495 - Left = 5760 - TabIndex = 13 + Begin VB.Frame Frame_Analyse + Caption = "分析" + Height = 1335 + Left = 5640 + TabIndex = 3 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 - Begin VB.CommandButton Command_Add_Favourite - Caption = "加入收藏" - Height = 495 - Left = 5760 - TabIndex = 12 - Top = 2640 - Width = 1335 + 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 = 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 - Begin VB.CommandButton Command_Favourite - Caption = "我的收藏" - Height = 495 - Left = 5760 - TabIndex = 11 + Begin VB.Frame Frame_Favourite + Caption = "收藏" + Height = 1335 + Left = 5640 + TabIndex = 1 Top = 1920 - Width = 1335 - End - Begin VB.CommandButton Command_Reduction_Snapshot - Caption = "还原快照" - Height = 495 - Left = 5760 - TabIndex = 10 - Top = 3840 - Width = 1335 - End - Begin VB.CommandButton Command_Create_Snapshot - Caption = "创建快照" - Height = 495 - Left = 5760 - TabIndex = 9 - Top = 3240 - Width = 1335 - 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 + 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.CommandButton Command_Create_Case - Caption = "自定义布局" - Height = 495 - Left = 5760 - TabIndex = 6 - Top = 120 - Width = 1335 + 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 = 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 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 - 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 + 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 + 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 + diff --git a/Form_Rand_Case.frm b/Form_Rand_Case.frm index 0cf565d..f32fe61 100644 --- a/Form_Rand_Case.frm +++ b/Form_Rand_Case.frm @@ -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 diff --git a/Form_Solution.frm b/Form_Solution.frm index 1371239..1a2e00f 100644 --- a/Form_Solution.frm +++ b/Form_Solution.frm @@ -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 diff --git a/Form_Start.frm b/Form_Start.frm new file mode 100644 index 0000000..0501cdc --- /dev/null +++ b/Form_Start.frm @@ -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 diff --git a/HRD_Game.vbp b/HRD_Game.vbp index 55b32df..682685e 100644 --- a/HRD_Game.vbp +++ b/HRD_Game.vbp @@ -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 diff --git a/HRD_Game.vbw b/HRD_Game.vbw index 9620525..413783d 100644 --- a/HRD_Game.vbw +++ b/HRD_Game.vbw @@ -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 diff --git a/Module.bas b/Module.bas index 5679489..3fe5098 100644 --- a/Module.bas +++ b/Module.bas @@ -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