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

v1.5

master v1.5
Dnomd343 5 years ago
parent
f220c6ae0c
commit
0472b3d722
6 changed files with 744 additions and 217 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 15
      Form_Favourite.frm
  2. 559
      Form_Favourite_Add.frm
  3. 371
      Form_Game.frm
  4. 2
      HRD_Game.vbp
  5. 2
      HRD_Game.vbw
  6. 12
      Module.bas

15
Form_Favourite.frm
View File

@ -102,6 +102,7 @@ Private Sub Form_Load()
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2 SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
End If End If
Call Get_Data Call Get_Data
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 Not List_Favourite.ListCount = 0 Then List_Favourite.ListIndex = 0 If Not List_Favourite.ListCount = 0 Then List_Favourite.ListIndex = 0
End Sub End Sub
Private Sub Command_Confirm_Click() Private Sub Command_Confirm_Click()
@ -115,6 +116,7 @@ Private Sub Command_Confirm_Click()
End Sub End Sub
Private Sub Command_Add_Click() Private Sub Command_Add_Click()
change_mode = False change_mode = False
favourite_add_save = False
favourite_add_init_name = "" favourite_add_init_name = ""
favourite_add_init_code = "" favourite_add_init_code = ""
Form_Favourite_Add.Show 1 Form_Favourite_Add.Show 1
@ -123,6 +125,7 @@ Private Sub Command_Modify_Click()
Dim temp As String Dim temp As String
If List_Favourite.ListCount = 0 Then Exit Sub If List_Favourite.ListCount = 0 Then Exit Sub
change_mode = True change_mode = True
favourite_add_save = False
temp = List_Favourite.List(List_Favourite.ListIndex) temp = List_Favourite.List(List_Favourite.ListIndex)
favourite_add_init_name = Left(temp, Len(temp) - 9) favourite_add_init_name = Left(temp, Len(temp) - 9)
favourite_add_init_code = Left(Right(temp, 8), 7) favourite_add_init_code = Left(Right(temp, 8), 7)
@ -138,6 +141,10 @@ Private Sub Command_Delete_Click()
Else Else
List_Favourite.ListIndex = temp List_Favourite.ListIndex = temp
End If End If
If List_Favourite.ListCount = 0 Then
Text_Code = ""
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 If
Call Save_Data Call Save_Data
End Sub End Sub
Private Sub List_Favourite_Click() Private Sub List_Favourite_Click()
@ -180,13 +187,13 @@ Private Sub Save_Data()
Call Save_Favourite_Cases Call Save_Favourite_Cases
End Sub End Sub
Private Sub Output_Graph() Private Sub Output_Graph()
Dim m, x, y As Integer Dim m, X, Y As Integer
Dim width As Integer, height As Integer Dim width As Integer, height As Integer
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
For m = 0 To 9 For m = 0 To 9
If Block(m).address <> 25 Then If Block(m).address <> 25 Then
x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x X = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y Y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
If Block(m).style = 0 Or Block(m).style = 1 Then If Block(m).style = 0 Or Block(m).style = 1 Then
width = square_width * 2 + gap width = square_width * 2 + gap
Else Else
@ -197,7 +204,7 @@ Private Sub Output_Graph()
Else Else
height = square_width height = square_width
End If End If
Print_Block x, y, width, height, block_line_width, block_color, block_line_color Print_Block X, Y, width, height, block_line_width, block_color, block_line_color
End If End If
Next m Next m
End Sub End Sub

559
Form_Favourite_Add.frm
View File

@ -13,11 +13,50 @@ Begin VB.Form Form_Favourite_Add
ScaleHeight = 5535 ScaleHeight = 5535
ScaleWidth = 3870 ScaleWidth = 3870
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Label_Code
Appearance = 0 'Flat
BackColor = &H8000000F&
BorderStyle = 0 'None
Height = 270
Left = 120
Locked = -1 'True
MousePointer = 1 'Arrow
TabIndex = 5
Text = "±àÂë:"
Top = 5200
Width = 495
End
Begin VB.TextBox Label_Name
Appearance = 0 'Flat
BackColor = &H8000000F&
BorderStyle = 0 'None
Height = 270
Left = 120
Locked = -1 'True
MousePointer = 1 'Arrow
TabIndex = 4
Text = "Ãû³Æ:"
Top = 4840
Width = 495
End
Begin VB.Timer Timer_Debug
Interval = 100
Left = 0
Top = 0
End
Begin VB.TextBox Text_Debug
Height = 5320
Left = 3880
MultiLine = -1 'True
TabIndex = 3
Top = 100
Width = 3375
End
Begin VB.CommandButton Command_Confirm Begin VB.CommandButton Command_Confirm
Caption = "确认" Caption = "确认"
Height = 615 Height = 615
Left = 2640 Left = 2640
TabIndex = 4 TabIndex = 2
Top = 4800 Top = 4800
Width = 1120 Width = 1120
End End
@ -25,7 +64,7 @@ Begin VB.Form Form_Favourite_Add
Alignment = 2 'Center Alignment = 2 'Center
Height = 270 Height = 270
Left = 600 Left = 600
TabIndex = 3 TabIndex = 1
Top = 5160 Top = 5160
Width = 1935 Width = 1935
End End
@ -33,28 +72,10 @@ Begin VB.Form Form_Favourite_Add
Alignment = 2 'Center Alignment = 2 'Center
Height = 270 Height = 270
Left = 600 Left = 600
TabIndex = 2 TabIndex = 0
Top = 4800 Top = 4800
Width = 1935 Width = 1935
End End
Begin VB.Label Label_Code
AutoSize = -1 'True
Caption = "±àÂë:"
Height = 180
Left = 120
TabIndex = 1
Top = 5200
Width = 450
End
Begin VB.Label Label_Name
AutoSize = -1 'True
Caption = "Ãû³Æ:"
Height = 180
Left = 120
TabIndex = 0
Top = 4840
Width = 450
End
End End
Attribute VB_Name = "Form_Favourite_Add" Attribute VB_Name = "Form_Favourite_Add"
Attribute VB_GlobalNameSpace = False Attribute VB_GlobalNameSpace = False
@ -67,36 +88,83 @@ Private Type Case_Block
style As Integer style As Integer
End Type End Type
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Case_Block
Dim Rand_Cases(1 To 8000) As String 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 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 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_DblClick()
If mouse_button = 2 Then
Call Case_init
Call Output_Graph
Text_Code = ""
End If
End Sub
Private Sub Form_Load() Private Sub Form_Load()
start_x = 120 start_x = 120
start_y = 120 start_y = 120
square_width = 815 square_width = 815
gap = 75 gap = 75
print_now = False
favourite_add_confirm = False favourite_add_confirm = False
If debug_mode = True Then
Form_Favourite_Add.width = 7425
Text_Debug.Visible = True
Else
Form_Favourite_Add.width = 3960
Text_Debug.Visible = False
End If
If on_top = True Then If on_top = True Then
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2 SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
Else Else
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2 SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
End If End If
Call init
Call Case_init
Text_Name = favourite_add_init_name Text_Name = favourite_add_init_name
Text_Code = favourite_add_init_code Text_Code = favourite_add_init_code
Call Text_Code_Change Call Text_Code_Change
End Sub End Sub
Private Sub Command_Confirm_Click() Private Sub Command_Confirm_Click()
If Text_Name = "" Then MsgBox "你还没有填名称喔", , "(⊙-⊙)": Exit Sub If Text_Name = "" Then MsgBox "你还没有填名称喔", , "(⊙-⊙)": Exit Sub
Call Analyse_Code(UCase(Text_Code)) Call Analyse(UCase(Text_Code))
If Check = False Then MsgBox "编码出错啦", , "(⊙-⊙)": Exit Sub If Check = False Then MsgBox "编码出错啦", , "(⊙-⊙)": Exit Sub
favourite_add_confirm = True favourite_add_confirm = True
favourite_add_name = Text_Name favourite_add_name = Text_Name
favourite_add_code = Text_Code favourite_add_code = Text_Code
If favourite_add_save = True Then
favourite_add_save = False
Call Get_Favourite_Cases
ReDim Preserve Favourite_Cases_code(UBound(Favourite_Cases_code) + 1)
ReDim Preserve Favourite_Cases_name(UBound(Favourite_Cases_name) + 1)
Favourite_Cases_code(UBound(Favourite_Cases_code)) = favourite_add_code
Favourite_Cases_name(UBound(Favourite_Cases_name)) = favourite_add_name
Call Save_Favourite_Cases
End If
Unload Form_Favourite_Add Unload Form_Favourite_Add
End Sub End Sub
Private Sub Form_Unload(Cancel As Integer)
favourite_add_save = False
End Sub
Private Sub Label_Name_Click()
Text_Name.SetFocus
End Sub
Private Sub Label_Code_Click()
Text_Code.SetFocus
End Sub
Private Sub Text_Code_Change() Private Sub Text_Code_Change()
If print_now = True Then Exit Sub
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
If Len(Text_Code) = 7 Then If Len(Text_Code) = 7 Then
Call Analyse_Code(UCase(Text_Code)) Call Analyse(UCase(Text_Code))
If Check = True Then If Check = True Then
Text_Code = UCase(Text_Code) Text_Code = UCase(Text_Code)
Call Output_Graph Call Output_Graph
@ -109,14 +177,228 @@ End Sub
Private Sub Text_Name_KeyPress(KeyAscii As Integer) Private Sub Text_Name_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_Code.SetFocus If KeyAscii = 13 Then Text_Code.SetFocus
End Sub End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
click_mouse_x = X
click_mouse_y = Y
click_x = Get_block_x(Int(X))
click_y = Get_block_y(Int(Y))
mouse_button = Button
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 = ""
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 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
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 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
Block(0).address = addr
Block(0).style = 0
Exist(block_start_x, block_start_y) = True
Exist(block_start_x, block_start_y + 1) = True
Exist(block_start_x + 1, block_start_y) = True
Exist(block_start_x + 1, block_start_y + 1) = True
Block_index(block_start_x, block_start_y) = 0
Block_index(block_start_x, block_start_y + 1) = 0
Block_index(block_start_x + 1, block_start_y) = 0
Block_index(block_start_x + 1, block_start_y + 1) = 0
End If
End If
If block_width = 2 And block_height = 1 Then
For m = 1 To 5
If Block(m).address = 25 Then
Block(m).address = addr
Block(m).style = 1
Exist(block_start_x, block_start_y) = True
Exist(block_start_x + 1, block_start_y) = True
Block_index(block_start_x, block_start_y) = m
Block_index(block_start_x + 1, block_start_y) = m
Exit For
End If
Next m
End If
If block_width = 1 And block_height = 2 Then
For m = 1 To 5
If Block(m).address = 25 Then
Block(m).address = addr
Block(m).style = 2
Exist(block_start_x, block_start_y) = True
Exist(block_start_x, block_start_y + 1) = True
Block_index(block_start_x, block_start_y) = m
Block_index(block_start_x, block_start_y + 1) = m
Exit For
End If
Next m
End If
If block_width = 1 And block_height = 1 Then
For m = 6 To 9
If Block(m).address = 25 Then
Block(m).address = addr
Block(m).style = 3
Exist(block_start_x, block_start_y) = True
Block_index(block_start_x, block_start_y) = m
Exit For
End If
Next m
End If
Text_Code = ""
Call Output_Graph
If Check_Compete = True Then Text_Code = Get_Code
print_now = False
End If
End Sub
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 Not Y = 5 Then
If Exist(X - 1, Y + 1) = True Then limit(-1, 1) = True
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 Not Y = 5 Then
If Exist(X + 1, Y + 1) = True Then limit(1, 1) = True
End If
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_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
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
Dim i As Integer
For i = 1 To 5
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 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() Private Sub Output_Graph()
Dim m, x, y As Integer Dim m, X, Y As Integer
Dim width As Integer, height As Integer Dim width As Integer, height As Integer
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
For m = 0 To 9 For m = 0 To 9
If Block(m).address <> 25 Then If Block(m).address <> 25 Then
x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x X = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y Y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
If Block(m).style = 0 Or Block(m).style = 1 Then If Block(m).style = 0 Or Block(m).style = 1 Then
width = square_width * 2 + gap width = square_width * 2 + gap
Else Else
@ -127,7 +409,7 @@ Private Sub Output_Graph()
Else Else
height = square_width height = square_width
End If End If
Print_Block x, y, width, height, block_line_width, block_color, block_line_color Print_Block X, Y, width, height, block_line_width, block_color, block_line_color
End If End If
Next m Next m
End Sub End Sub
@ -139,6 +421,69 @@ Private Sub Print_Block(print_start_x, print_start_y, print_width, print_height,
Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B
Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B
End Sub End Sub
Private Sub Case_init()
Dim i As Integer, j As Integer
For i = 0 To 9
Block(i).address = 25
Block(i).style = 4
Next i
For i = 1 To 4
For j = 1 To 5
Exist(i, j) = False
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
For m = 0 To 9
If Block(m).style = 4 Then
Check_Compete = False
Exit Function
End If
Next m
Check_Compete = True
End Function
Private Sub Clear_Block(m As Integer)
Dim X As Integer, Y As Integer, addr As Integer, style As Integer
addr = Block(m).address
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 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 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 style = 3 Then
Exist(X, Y) = False
Block_index(X, Y) = 10
End If
End Sub
Private Function Check() As Boolean Private Function Check() As Boolean
Dim temp(0 To 19) As Boolean Dim temp(0 To 19) As Boolean
Dim addr As Integer, i As Integer, j As Integer Dim addr As Integer, i As Integer, j As Integer
@ -193,6 +538,118 @@ Private Function Check() As Boolean
Next i Next i
If j <> 2 Then Check = False If j <> 2 Then Check = False
End Function 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 i As Integer, addr As Integer, style As Integer, num As Integer
For i = 0 To 19
temp(i) = False
Table(i) = 10
Next i
For i = 0 To 9
If Block(i).style = 0 Then
Table(Block(i).address) = i
Table(Block(i).address + 1) = i
Table(Block(i).address + 4) = i
Table(Block(i).address + 5) = i
ElseIf Block(i).style = 1 Then
Table(Block(i).address) = i
Table(Block(i).address + 1) = i
ElseIf Block(i).style = 2 Then
Table(Block(i).address) = i
Table(Block(i).address + 4) = i
ElseIf Block(i).style = 3 Then
Table(Block(i).address) = i
End If
Next i
temp(Block(0).address) = True
temp(Block(0).address + 1) = True
temp(Block(0).address + 4) = True
temp(Block(0).address + 5) = True
If Block(0).address < 10 Then
code = code & Block(0).address
Else
code = code & Chr(Block(0).address + 55)
End If
addr = 0
num = 1
For i = 1 To 11
While (temp(addr) = True)
If addr < 19 Then
addr = addr + 1
Else
Exit Function
End If
Wend
If Table(addr) = 10 Then
temp(addr) = True
dat(num) = 0: num = num + 1
Else
style = Block(Table(addr)).style
If style = 1 Then
temp(addr) = True
temp(addr + 1) = True
dat(num) = 1: num = num + 1
ElseIf style = 2 Then
temp(addr) = True
temp(addr + 4) = True
dat(num) = 2: num = num + 1
ElseIf style = 3 Then
temp(addr) = True
dat(num) = 3: num = num + 1
End If
End If
Next i
For i = 1 To 6
num = dat(i * 2 - 1) * 4 + dat(i * 2)
If num < 10 Then
code = code & num
Else
code = code & Chr(num + 55)
End If
Next i
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
For m = 0 To 9
addr = Block(m).address
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
End If
If Block(m).style = 1 Then
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
End If
If Block(m).style = 3 Then
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
End Sub
Private Sub Analyse_Code(code As String) Private Sub Analyse_Code(code As String)
On Error Resume Next On Error Resume Next
Dim temp(1 To 12) As Integer Dim temp(1 To 12) As Integer
@ -263,3 +720,49 @@ Private Sub Analyse_Code(code As String)
Next i Next i
err: err:
End Sub End Sub
Private Sub Timer_Debug_Timer()
Dim debug_dat As String
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 limit" & vbCrLf
For j = 1 To 5
For i = 1 To 4
If Exist(i, j) Then
debug_dat = debug_dat & "$$ "
Else
debug_dat = debug_dat & "[] "
End If
Next i
debug_dat = debug_dat & " "
For i = 1 To 4
If Block_index(i, j) = 10 Then
debug_dat = debug_dat & "A "
Else
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 & "click_mouse_x=" & click_mouse_x & vbCrLf & "click_mouse_y=" & click_mouse_y & 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 & "favourite_add_save=" & favourite_add_save & vbCrLf
Text_Debug = debug_dat
End Sub

371
Form_Game.frm
View File

@ -2,7 +2,7 @@ VERSION 5.00
Begin VB.Form Form_Game Begin VB.Form Form_Game
AutoRedraw = -1 'True AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single BorderStyle = 1 'Fixed Single
Caption = "HRD Game v1.4 by Dnomd343" Caption = "HRD Game v1.5 by Dnomd343"
ClientHeight = 7305 ClientHeight = 7305
ClientLeft = 45 ClientLeft = 45
ClientTop = 690 ClientTop = 690
@ -14,6 +14,14 @@ Begin VB.Form Form_Game
ScaleHeight = 7305 ScaleHeight = 7305
ScaleWidth = 7290 ScaleWidth = 7290
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command_Add_Favourite
Caption = "¼ÓÈëÊÕ²Ø"
Height = 495
Left = 5760
TabIndex = 12
Top = 3480
Width = 1335
End
Begin VB.CommandButton Command_Favourite Begin VB.CommandButton Command_Favourite
Caption = "我的收藏" Caption = "我的收藏"
Height = 495 Height = 495
@ -27,7 +35,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 10 TabIndex = 10
Top = 4080 Top = 4680
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Create_Snapshot Begin VB.CommandButton Command_Create_Snapshot
@ -35,7 +43,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 9 TabIndex = 9
Top = 3480 Top = 4080
Width = 1335 Width = 1335
End End
Begin VB.CommandButton Command_Rand_Case Begin VB.CommandButton Command_Rand_Case
@ -72,7 +80,7 @@ Begin VB.Form Form_Game
Height = 495 Height = 495
Left = 5760 Left = 5760
TabIndex = 1 TabIndex = 1
Top = 4680 Top = 5280
Width = 1335 Width = 1335
End End
Begin VB.Timer Timer_Get_Time Begin VB.Timer Timer_Get_Time
@ -148,8 +156,8 @@ Private Type Case_Block
style As Integer style As Integer
End Type End Type
Private Type Block_Address Private Type Block_Address
x As Integer X As Integer
y As Integer Y As Integer
End Type End Type
Dim Block(0 To 9) As Case_Block Dim Block(0 To 9) As Case_Block
Dim Exist(1 To 4, 1 To 5) As Boolean Dim Exist(1 To 4, 1 To 5) As Boolean
@ -163,6 +171,8 @@ Dim last_move As Integer, move_times As Integer
Dim total_steps As Long, total_time As Long Dim total_steps As Long, total_time As Long
Dim Start_Code As String Dim Start_Code As String
Dim snapshot_code As String, snapshot_step As Long Dim snapshot_code As String, snapshot_step As Long
Private Sub Menu_Debug_Mode_Click() Private Sub Menu_Debug_Mode_Click()
Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked
If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False
@ -179,16 +189,16 @@ End Sub
Private Sub Form_Load() Private Sub Form_Load()
Call init Call init
End Sub End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
mouse_button = Button mouse_button = Button
mouse_x = x mouse_x = X
mouse_y = y mouse_y = Y
End Sub End Sub
Private Sub Form_DblClick() Private Sub Form_DblClick()
Call Form_Click Call Form_Click
End Sub End Sub
Private Sub Form_Click() Private Sub Form_Click()
Dim m As Integer, x As Integer, y As Integer Dim m As Integer, X As Integer, Y As Integer
If mouse_x < start_x Or mouse_x > start_x + square_width * 4 + gap * 5 Then Exit Sub If mouse_x < start_x Or mouse_x > start_x + square_width * 4 + gap * 5 Then Exit Sub
If mouse_y < start_y Or mouse_y > start_y + square_width * 5 + gap * 6 Then Exit Sub If mouse_y < start_y Or mouse_y > start_y + square_width * 5 + gap * 6 Then Exit Sub
If solve_compete = True Then Exit Sub If solve_compete = True Then Exit Sub
@ -200,32 +210,32 @@ Private Sub Form_Click()
total_steps = 0 total_steps = 0
Timer_Get_Time.Enabled = True Timer_Get_Time.Enabled = True
End If End If
y = Int(Block(m).address / 4) + 1 Y = Int(Block(m).address / 4) + 1
x = Block(m).address - (y - 1) * 4 + 1 X = Block(m).address - (Y - 1) * 4 + 1
If m = last_move Then If m = last_move Then
If move_max_step = 1 Then If move_max_step = 1 Then
If dir_x2 = 0 And dir_y2 = 0 Then If dir_x2 = 0 And dir_y2 = 0 Then
If move_times Mod 2 = 1 Then If move_times Mod 2 = 1 Then
Call Move_Block(m, block_addr(0).x - x, block_addr(0).y - y) Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
Else Else
Call Move_Block(m, block_addr(1).x - x, block_addr(1).y - y) Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
End If End If
Else Else
If mouse_button = 1 Then If mouse_button = 1 Then
If move_times Mod 4 = 0 Then If move_times Mod 4 = 0 Then
Call Move_Block(m, block_addr(1).x - x, block_addr(1).y - y) Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
ElseIf move_times Mod 4 = 1 Then ElseIf move_times Mod 4 = 1 Then
Call Move_Block(m, block_addr(0).x - x, block_addr(0).y - y) Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
ElseIf move_times Mod 4 = 2 Then ElseIf move_times Mod 4 = 2 Then
Call Move_Block(m, block_addr(2).x - x, block_addr(2).y - y) Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
Else Else
Call Move_Block(m, block_addr(0).x - x, block_addr(0).y - y) Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
End If End If
ElseIf mouse_button = 2 Then ElseIf mouse_button = 2 Then
If move_times Mod 2 = 0 Then If move_times Mod 2 = 0 Then
Call Move_Block(m, block_addr(1).x - x, block_addr(1).y - y) Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
ElseIf move_times Mod 2 = 1 Then ElseIf move_times Mod 2 = 1 Then
Call Move_Block(m, block_addr(2).x - x, block_addr(2).y - y) Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
End If End If
End If End If
End If End If
@ -234,17 +244,17 @@ Private Sub Form_Click()
If move_times Mod 4 = 0 Then If move_times Mod 4 = 0 Then
Call Move_Block(m, dir_x1, dir_y1) Call Move_Block(m, dir_x1, dir_y1)
ElseIf move_times Mod 4 = 1 Then ElseIf move_times Mod 4 = 1 Then
Call Move_Block(m, block_addr(2).x - x, block_addr(2).y - y) Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
ElseIf move_times Mod 4 = 2 Then ElseIf move_times Mod 4 = 2 Then
Call Move_Block(m, block_addr(1).x - x, block_addr(1).y - y) Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
Else Else
Call Move_Block(m, block_addr(0).x - x, block_addr(0).y - y) Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
End If End If
ElseIf mouse_button = 2 Then ElseIf mouse_button = 2 Then
If move_times Mod 2 = 0 Then If move_times Mod 2 = 0 Then
Call Move_Block(m, block_addr(2).x - x, block_addr(2).y - y) Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
ElseIf move_times Mod 2 = 1 Then ElseIf move_times Mod 2 = 1 Then
Call Move_Block(m, block_addr(0).x - x, block_addr(0).y - y) Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
End If End If
End If End If
End If End If
@ -256,13 +266,13 @@ Private Sub Form_Click()
If move_max_step = 0 Then Exit Sub If move_max_step = 0 Then Exit Sub
total_steps = total_steps + 1 total_steps = total_steps + 1
If mouse_button = 1 Then If mouse_button = 1 Then
Call Move_Block(m, block_addr(1).x - x, block_addr(1).y - y) Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
End If End If
If mouse_button = 2 Then If mouse_button = 2 Then
If move_max_step = 1 Then If move_max_step = 1 Then
Call Move_Block(m, block_addr(1).x - x, block_addr(1).y - y) Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
ElseIf move_max_step = 2 Then ElseIf move_max_step = 2 Then
Call Move_Block(m, block_addr(2).x - x, block_addr(2).y - y) Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
End If End If
End If End If
End If End If
@ -289,6 +299,12 @@ Private Sub Command_Favourite_Click()
favourite_add_confirm = False favourite_add_confirm = False
Form_Favourite.Show 1 Form_Favourite.Show 1
End Sub End Sub
Private Sub Command_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 = ""
Form_Favourite_Add.Show 1
End Sub
Private Sub Command_Create_Snapshot_Click() Private Sub Command_Create_Snapshot_Click()
If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
@ -322,6 +338,7 @@ End Sub
Private Sub init() Private Sub init()
playing = False playing = False
solve_compete = False solve_compete = False
Timer_Get_Time.Enabled = False
snapshot_step = -1 snapshot_step = -1
last_move = 10 last_move = 10
move_times = 0 move_times = 0
@ -351,216 +368,216 @@ Private Sub init()
y_split(5) = start_y + gap + (square_width + gap) * 5 y_split(5) = start_y + gap + (square_width + gap) * 5
End Sub End Sub
Private Sub Move_Block(m As Integer, dir_x As Integer, dir_y As Integer) Private Sub Move_Block(m As Integer, dir_x As Integer, dir_y As Integer)
Dim addr As Integer, style As Integer, x As Integer, y As Integer Dim addr As Integer, style As Integer, X As Integer, Y As Integer
addr = Block(m).address addr = Block(m).address
style = Block(m).style style = Block(m).style
y = Int(addr / 4) + 1 Y = Int(addr / 4) + 1
x = addr - (y - 1) * 4 + 1 X = addr - (Y - 1) * 4 + 1
x = x + dir_x X = X + dir_x
y = y + dir_y Y = Y + dir_y
addr = (y - 1) * 4 + x - 1 addr = (Y - 1) * 4 + X - 1
Call Clear_Block(m) Call Clear_Block(m)
Block(m).address = addr Block(m).address = addr
Block(m).style = style Block(m).style = style
If Block(m).style = 0 Then If Block(m).style = 0 Then
Block_index(x, y) = m Block_index(X, Y) = m
Block_index(x, y + 1) = m Block_index(X, Y + 1) = m
Block_index(x + 1, y) = m Block_index(X + 1, Y) = m
Block_index(x + 1, y + 1) = m Block_index(X + 1, Y + 1) = m
End If End If
If Block(m).style = 1 Then If Block(m).style = 1 Then
Block_index(x, y) = m Block_index(X, Y) = m
Block_index(x + 1, y) = m Block_index(X + 1, Y) = m
End If End If
If Block(m).style = 2 Then If Block(m).style = 2 Then
Block_index(x, y) = m Block_index(X, Y) = m
Block_index(x, y + 1) = m Block_index(X, Y + 1) = m
End If End If
If Block(m).style = 3 Then If Block(m).style = 3 Then
Block_index(x, y) = m Block_index(X, Y) = m
End If End If
For x = 1 To 4 For X = 1 To 4
For y = 1 To 5 For Y = 1 To 5
If Block_index(x, y) <> 10 Then Exist(x, y) = True If Block_index(X, Y) <> 10 Then Exist(X, Y) = True
Next y Next Y
Next x Next X
End Sub End Sub
Private Sub Check_Move(m As Integer) Private Sub Check_Move(m As Integer)
Dim addr As Integer, x As Integer, y As Integer Dim addr As Integer, X As Integer, Y As Integer
Dim move_once As Boolean Dim move_once As Boolean
move_once = False move_once = False
dir_x1 = 0: dir_x2 = 0: dir_y1 = 0: dir_y2 = 0 dir_x1 = 0: dir_x2 = 0: dir_y1 = 0: dir_y2 = 0
move_max_step = 0 move_max_step = 0
addr = Block(m).address addr = Block(m).address
y = Int(addr / 4) + 1 Y = Int(addr / 4) + 1
x = addr - (y - 1) * 4 + 1 X = addr - (Y - 1) * 4 + 1
block_addr(0).x = x: block_addr(0).y = y block_addr(0).X = X: block_addr(0).Y = Y
block_addr(1).x = x: block_addr(1).y = y block_addr(1).X = X: block_addr(1).Y = Y
block_addr(2).x = x: block_addr(2).y = y block_addr(2).X = X: block_addr(2).Y = Y
If Block(m).style = 0 Then If Block(m).style = 0 Then
If y > 1 Then If Y > 1 Then
If Exist(x, y - 1) = False And Exist(x + 1, y - 1) = False Then move_max_step = 1: dir_y1 = -1 If Exist(X, Y - 1) = False And Exist(X + 1, Y - 1) = False Then move_max_step = 1: dir_y1 = -1
End If End If
If y < 4 Then If Y < 4 Then
If Exist(x, y + 2) = False And Exist(x + 1, y + 2) = False Then move_max_step = 1: dir_y1 = 1 If Exist(X, Y + 2) = False And Exist(X + 1, Y + 2) = False Then move_max_step = 1: dir_y1 = 1
End If End If
If x > 1 Then If X > 1 Then
If Exist(x - 1, y) = False And Exist(x - 1, y + 1) = False Then move_max_step = 1: dir_x1 = -1 If Exist(X - 1, Y) = False And Exist(X - 1, Y + 1) = False Then move_max_step = 1: dir_x1 = -1
End If End If
If x < 3 Then If X < 3 Then
If Exist(x + 2, y) = False And Exist(x + 2, y + 1) = False Then move_max_step = 1: dir_x1 = 1 If Exist(X + 2, Y) = False And Exist(X + 2, Y + 1) = False Then move_max_step = 1: dir_x1 = 1
End If End If
ElseIf Block(m).style = 1 Then ElseIf Block(m).style = 1 Then
If y > 1 Then If Y > 1 Then
If Exist(x, y - 1) = False And Exist(x + 1, y - 1) = False Then move_max_step = 1: dir_y1 = -1 If Exist(X, Y - 1) = False And Exist(X + 1, Y - 1) = False Then move_max_step = 1: dir_y1 = -1
End If End If
If y < 5 Then If Y < 5 Then
If Exist(x, y + 1) = False And Exist(x + 1, y + 1) = False Then move_max_step = 1: dir_y1 = 1 If Exist(X, Y + 1) = False And Exist(X + 1, Y + 1) = False Then move_max_step = 1: dir_y1 = 1
End If End If
If x > 1 Then If X > 1 Then
If Exist(x - 1, y) = False Then If Exist(X - 1, Y) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_x1 = -1 Else dir_x2 = -1 If move_once = False Then dir_x1 = -1 Else dir_x2 = -1
move_once = True move_once = True
If x > 2 Then If X > 2 Then
If Exist(x - 2, y) = False Then move_max_step = 2: dir_x2 = -2 If Exist(X - 2, Y) = False Then move_max_step = 2: dir_x2 = -2
End If End If
End If End If
End If End If
If x < 3 Then If X < 3 Then
If Exist(x + 2, y) = False Then If Exist(X + 2, Y) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_x1 = 1 Else dir_x2 = 1 If move_once = False Then dir_x1 = 1 Else dir_x2 = 1
move_once = True move_once = True
If x < 2 Then If X < 2 Then
If Exist(x + 3, y) = False Then move_max_step = 2: dir_x2 = 2 If Exist(X + 3, Y) = False Then move_max_step = 2: dir_x2 = 2
End If End If
End If End If
End If End If
ElseIf Block(m).style = 2 Then ElseIf Block(m).style = 2 Then
If y > 1 Then If Y > 1 Then
If Exist(x, y - 1) = False Then If Exist(X, Y - 1) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_y1 = -1 Else dir_y2 = -1 If move_once = False Then dir_y1 = -1 Else dir_y2 = -1
move_once = True move_once = True
If y > 2 Then If Y > 2 Then
If Exist(x, y - 2) = False Then move_max_step = 2: dir_y2 = -2 If Exist(X, Y - 2) = False Then move_max_step = 2: dir_y2 = -2
End If End If
End If End If
End If End If
If y < 4 Then If Y < 4 Then
If Exist(x, y + 2) = False Then If Exist(X, Y + 2) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_y1 = 1 Else dir_y2 = 1 If move_once = False Then dir_y1 = 1 Else dir_y2 = 1
move_once = True move_once = True
If y < 3 Then If Y < 3 Then
If Exist(x, y + 3) = False Then move_max_step = 2: dir_y2 = 2 If Exist(X, Y + 3) = False Then move_max_step = 2: dir_y2 = 2
End If End If
End If End If
End If End If
If x > 1 Then If X > 1 Then
If Exist(x - 1, y) = False And Exist(x - 1, y + 1) = False Then move_max_step = 1: dir_x1 = -1 If Exist(X - 1, Y) = False And Exist(X - 1, Y + 1) = False Then move_max_step = 1: dir_x1 = -1
End If End If
If x < 4 Then If X < 4 Then
If Exist(x + 1, y) = False And Exist(x + 1, y + 1) = False Then move_max_step = 1: dir_x1 = 1 If Exist(X + 1, Y) = False And Exist(X + 1, Y + 1) = False Then move_max_step = 1: dir_x1 = 1
End If End If
ElseIf Block(m).style = 3 Then ElseIf Block(m).style = 3 Then
If y > 1 Then If Y > 1 Then
If Exist(x, y - 1) = False Then If Exist(X, Y - 1) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_y1 = -1 Else dir_y2 = -1 If move_once = False Then dir_y1 = -1 Else dir_y2 = -1
move_once = True move_once = True
If y > 2 Then If Y > 2 Then
If Exist(x, y - 2) = False Then move_max_step = 2: dir_y2 = -2 If Exist(X, Y - 2) = False Then move_max_step = 2: dir_y2 = -2
End If End If
If x > 1 Then If X > 1 Then
If Exist(x - 1, y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1 If Exist(X - 1, Y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1
End If End If
If x < 4 Then If X < 4 Then
If Exist(x + 1, y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1 If Exist(X + 1, Y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1
End If End If
End If End If
End If End If
If y < 5 Then If Y < 5 Then
If Exist(x, y + 1) = False Then If Exist(X, Y + 1) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_y1 = 1 Else dir_y2 = 1 If move_once = False Then dir_y1 = 1 Else dir_y2 = 1
move_once = True move_once = True
If y < 4 Then If Y < 4 Then
If Exist(x, y + 2) = False Then move_max_step = 2: dir_y2 = 2 If Exist(X, Y + 2) = False Then move_max_step = 2: dir_y2 = 2
End If End If
If x > 1 Then If X > 1 Then
If Exist(x - 1, y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1 If Exist(X - 1, Y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1
End If End If
If x < 4 Then If X < 4 Then
If Exist(x + 1, y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1 If Exist(X + 1, Y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1
End If End If
End If End If
End If End If
If x > 1 Then If X > 1 Then
If Exist(x - 1, y) = False Then If Exist(X - 1, Y) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_x1 = -1 Else dir_x2 = -1 If move_once = False Then dir_x1 = -1 Else dir_x2 = -1
move_once = True move_once = True
If x > 2 Then If X > 2 Then
If Exist(x - 2, y) = False Then move_max_step = 2: dir_x2 = -2 If Exist(X - 2, Y) = False Then move_max_step = 2: dir_x2 = -2
End If End If
If y > 1 Then If Y > 1 Then
If Exist(x - 1, y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1 If Exist(X - 1, Y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1
End If End If
If y < 5 Then If Y < 5 Then
If Exist(x - 1, y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1 If Exist(X - 1, Y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1
End If End If
End If End If
End If End If
If x < 4 Then If X < 4 Then
If Exist(x + 1, y) = False Then If Exist(X + 1, Y) = False Then
move_max_step = 1 move_max_step = 1
If move_once = False Then dir_x1 = 1 Else dir_x2 = 1 If move_once = False Then dir_x1 = 1 Else dir_x2 = 1
move_once = True move_once = True
If x < 3 Then If X < 3 Then
If Exist(x + 2, y) = False Then move_max_step = 2: dir_x2 = 2 If Exist(X + 2, Y) = False Then move_max_step = 2: dir_x2 = 2
End If End If
If y > 1 Then If Y > 1 Then
If Exist(x + 1, y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1 If Exist(X + 1, Y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1
End If End If
If y < 5 Then If Y < 5 Then
If Exist(x + 1, y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1 If Exist(X + 1, Y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1
End If End If
End If End If
End If End If
End If End If
block_addr(1).x = block_addr(0).x + dir_x1 block_addr(1).X = block_addr(0).X + dir_x1
block_addr(1).y = block_addr(0).y + dir_y1 block_addr(1).Y = block_addr(0).Y + dir_y1
block_addr(2).x = block_addr(0).x + dir_x2 block_addr(2).X = block_addr(0).X + dir_x2
block_addr(2).y = block_addr(0).y + dir_y2 block_addr(2).Y = block_addr(0).Y + dir_y2
End Sub End Sub
Private Function Get_block_x(x As Long) As Integer Private Function Get_block_x(X As Long) As Integer
Dim i As Integer Dim i As Integer
For i = 1 To 4 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 Get_block_x = i
Exit For Exit For
End If End If
Next i Next i
End Function End Function
Private Function Get_block_y(y As Long) As Integer Private Function Get_block_y(Y As Long) As Integer
Dim i As Integer Dim i As Integer
For i = 1 To 5 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 Get_block_y = i
Exit For Exit For
End If End If
Next i Next i
End Function End Function
Private Sub Output_Graph() Private Sub Output_Graph()
Dim m, x, y As Integer Dim m, X, Y As Integer
Dim width As Integer, height As Integer Dim width As Integer, height As Integer
Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
For m = 0 To 9 For m = 0 To 9
If Block(m).address <> 25 Then If Block(m).address <> 25 Then
x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x X = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y Y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
If Block(m).style = 0 Or Block(m).style = 1 Then If Block(m).style = 0 Or Block(m).style = 1 Then
width = square_width * 2 + gap width = square_width * 2 + gap
Else Else
@ -571,7 +588,7 @@ Private Sub Output_Graph()
Else Else
height = square_width height = square_width
End If End If
Print_Block x, y, width, height, block_line_width, block_color, block_line_color Print_Block X, Y, width, height, block_line_width, block_color, block_line_color
End If End If
Next m Next m
End Sub End Sub
@ -597,35 +614,35 @@ Private Sub Case_init()
Next i Next i
End Sub End Sub
Private Sub Clear_Block(m As Integer) 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
addr = Block(m).address addr = Block(m).address
y = Int(addr / 4) + 1 Y = Int(addr / 4) + 1
x = addr - (y - 1) * 4 + 1 X = addr - (Y - 1) * 4 + 1
If Block(m).style = 0 Then If Block(m).style = 0 Then
Exist(x, y) = False Exist(X, Y) = False
Exist(x, y + 1) = False Exist(X, Y + 1) = False
Exist(x + 1, y) = False Exist(X + 1, Y) = False
Exist(x + 1, y + 1) = False Exist(X + 1, Y + 1) = False
Block_index(x, y) = 10 Block_index(X, Y) = 10
Block_index(x, y + 1) = 10 Block_index(X, Y + 1) = 10
Block_index(x + 1, y) = 10 Block_index(X + 1, Y) = 10
Block_index(x + 1, y + 1) = 10 Block_index(X + 1, Y + 1) = 10
End If End If
If Block(m).style = 1 Then If Block(m).style = 1 Then
Exist(x, y) = False Exist(X, Y) = False
Exist(x + 1, y) = False Exist(X + 1, Y) = False
Block_index(x, y) = 10 Block_index(X, Y) = 10
Block_index(x + 1, y) = 10 Block_index(X + 1, Y) = 10
End If End If
If Block(m).style = 2 Then If Block(m).style = 2 Then
Exist(x, y) = False Exist(X, Y) = False
Exist(x, y + 1) = False Exist(X, Y + 1) = False
Block_index(x, y) = 10 Block_index(X, Y) = 10
Block_index(x, y + 1) = 10 Block_index(X, Y + 1) = 10
End If End If
If Block(m).style = 3 Then If Block(m).style = 3 Then
Exist(x, y) = False Exist(X, Y) = False
Block_index(x, y) = 10 Block_index(X, Y) = 10
End If End If
Block(m).address = 25 Block(m).address = 25
Block(m).style = 4 Block(m).style = 4
@ -706,41 +723,41 @@ Private Function Get_Code() As String
Get_Code = code Get_Code = code
End Function End Function
Private Sub Analyse(code As String) Private Sub Analyse(code As String)
Dim m As Integer, addr As Integer, x As Integer, y As Integer Dim m As Integer, addr As Integer, X As Integer, Y As Integer
Call Analyse_Code(code) Call Analyse_Code(code)
For x = 1 To 4 For X = 1 To 4
For y = 1 To 5 For Y = 1 To 5
Block_index(x, y) = 10 Block_index(X, Y) = 10
Exist(x, y) = False Exist(X, Y) = False
Next y Next Y
Next x Next X
For m = 0 To 9 For m = 0 To 9
addr = Block(m).address addr = Block(m).address
y = Int(addr / 4) + 1 Y = Int(addr / 4) + 1
x = addr - (y - 1) * 4 + 1 X = addr - (Y - 1) * 4 + 1
If Block(m).style = 0 Then If Block(m).style = 0 Then
Block_index(x, y) = 0 Block_index(X, Y) = 0
Block_index(x, y + 1) = 0 Block_index(X, Y + 1) = 0
Block_index(x + 1, y) = 0 Block_index(X + 1, Y) = 0
Block_index(x + 1, y + 1) = 0 Block_index(X + 1, Y + 1) = 0
End If End If
If Block(m).style = 1 Then If Block(m).style = 1 Then
Block_index(x, y) = m Block_index(X, Y) = m
Block_index(x + 1, y) = m Block_index(X + 1, Y) = m
End If End If
If Block(m).style = 2 Then If Block(m).style = 2 Then
Block_index(x, y) = m Block_index(X, Y) = m
Block_index(x, y + 1) = m Block_index(X, Y + 1) = m
End If End If
If Block(m).style = 3 Then If Block(m).style = 3 Then
Block_index(x, y) = m Block_index(X, Y) = m
End If End If
Next m Next m
For x = 1 To 4 For X = 1 To 4
For y = 1 To 5 For Y = 1 To 5
If Block_index(x, y) <> 10 Then Exist(x, y) = True If Block_index(X, Y) <> 10 Then Exist(X, Y) = True
Next y Next Y
Next x Next X
End Sub End Sub
Private Function Check() As Boolean Private Function Check() As Boolean
Dim temp(0 To 19) As Boolean Dim temp(0 To 19) As Boolean
@ -905,9 +922,9 @@ Private Sub Timer_Debug_Timer()
Next j Next j
debug_dat = debug_dat & "dir_x1=" & dir_x1 & " dir_y1=" & dir_y1 & vbCrLf debug_dat = debug_dat & "dir_x1=" & dir_x1 & " dir_y1=" & dir_y1 & vbCrLf
debug_dat = debug_dat & "dir_x2=" & dir_x2 & " dir_y2=" & dir_y2 & vbCrLf debug_dat = debug_dat & "dir_x2=" & dir_x2 & " dir_y2=" & dir_y2 & vbCrLf
debug_dat = debug_dat & "block_addr(0)=(" & block_addr(0).x & "," & block_addr(0).y & ")" & vbCrLf debug_dat = debug_dat & "block_addr(0)=(" & block_addr(0).X & "," & block_addr(0).Y & ")" & vbCrLf
debug_dat = debug_dat & "block_addr(1)=(" & block_addr(1).x & "," & block_addr(1).y & ")" & vbCrLf debug_dat = debug_dat & "block_addr(1)=(" & block_addr(1).X & "," & block_addr(1).Y & ")" & vbCrLf
debug_dat = debug_dat & "block_addr(2)=(" & block_addr(2).x & "," & block_addr(2).y & ")" & vbCrLf debug_dat = debug_dat & "block_addr(2)=(" & block_addr(2).X & "," & block_addr(2).Y & ")" & vbCrLf
debug_dat = debug_dat & "move_max_step=" & move_max_step & vbCrLf debug_dat = debug_dat & "move_max_step=" & move_max_step & vbCrLf
debug_dat = debug_dat & "last_move=" & last_move & vbCrLf debug_dat = debug_dat & "last_move=" & last_move & vbCrLf
debug_dat = debug_dat & "move_times=" & move_times & vbCrLf debug_dat = debug_dat & "move_times=" & move_times & vbCrLf

2
HRD_Game.vbp
View File

@ -17,7 +17,7 @@ Name="HRD_Game"
HelpContextID="0" HelpContextID="0"
CompatibleMode="0" CompatibleMode="0"
MajorVer=1 MajorVer=1
MinorVer=4 MinorVer=5
RevisionVer=0 RevisionVer=0
AutoIncrementVer=0 AutoIncrementVer=0
ServerSupportFiles=0 ServerSupportFiles=0

2
HRD_Game.vbw
View File

@ -3,5 +3,5 @@ Module = 52, 52, 883, 479,
Form_Classic_Cases = 104, 104, 891, 531, , 104, 104, 937, 531, C Form_Classic_Cases = 104, 104, 891, 531, , 104, 104, 937, 531, C
Form_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, C Form_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, C
Form_Rand_Case = 78, 78, 855, 505, , 156, 156, 933, 583, C Form_Rand_Case = 78, 78, 855, 505, , 156, 156, 933, 583, C
Form_Favourite = 52, 52, 829, 479, Z, 26, 26, 803, 453, C Form_Favourite = 52, 52, 829, 479, , 26, 26, 803, 453, C
Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C

12
Module.bas
View File

@ -3,7 +3,7 @@ Option Explicit
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" (ByVal hkey As Long, ByVal pszSubKey As String) As Long Public Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" (ByVal hkey As Long, ByVal pszSubKey As String) As Long
Public Type FILETIME Public Type FILETIME
dwLowDateTime As Long dwLowDateTime As Long
@ -22,25 +22,25 @@ 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
Public Favourite_Cases_name() As String, Favourite_Cases_code() As String Public Favourite_Cases_name() As String, Favourite_Cases_code() As String
Public favourite_add_name As String, favourite_add_code As String, favourite_add_confirm As Boolean Public favourite_add_name As String, favourite_add_code As String, favourite_add_confirm As Boolean
Public favourite_add_init_name As String, favourite_add_init_code As String Public favourite_add_init_name As String, favourite_add_init_code As String, favourite_add_save As Boolean
Public Sub FindKeys(hkey As Long, SubKey As String) Public Sub FindKeys(hkey As Long, SubKey As String)
Dim phkRet As Long, lRet As Long, Index As Long, lName As Long, lReserved As Long, lClass As Long Dim phkRet As Long, lRet As Long, index As Long, lName As Long, lReserved As Long, lClass As Long
Dim name As String, Class As String Dim name As String, Class As String
Dim LWT As FILETIME Dim LWT As FILETIME
lReserved = 0 lReserved = 0
Index = 0 index = 0
lRet = RegOpenKey(hkey, SubKey, phkRet) lRet = RegOpenKey(hkey, SubKey, phkRet)
If lRet = 0 Then If lRet = 0 Then
Do Do
name = String(255, Chr(0)): lName = Len(name) name = String(255, Chr(0)): lName = Len(name)
lRet = RegEnumKeyEx(phkRet, Index, name, lName, lReserved, Class, lClass, LWT) lRet = RegEnumKeyEx(phkRet, index, name, lName, lReserved, Class, lClass, LWT)
If lRet = 0 Then If lRet = 0 Then
ReDim Preserve Favourite_Cases_name(UBound(Favourite_Cases_name) + 1) ReDim Preserve Favourite_Cases_name(UBound(Favourite_Cases_name) + 1)
Favourite_Cases_name(UBound(Favourite_Cases_name)) = name Favourite_Cases_name(UBound(Favourite_Cases_name)) = name
Else Else
Exit Do Exit Do
End If End If
Index = Index + 1 index = index + 1
Loop While lRet = 0 Loop While lRet = 0
End If End If
Call RegCloseKey(phkRet) Call RegCloseKey(phkRet)

Write Preview
Loading…
Cancel
Save