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
Split 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
End If
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
End Sub
Private Sub Command_Confirm_Click()
@ -115,6 +116,7 @@ Private Sub Command_Confirm_Click()
End Sub
Private Sub Command_Add_Click()
change_mode = False
favourite_add_save = False
favourite_add_init_name = ""
favourite_add_init_code = ""
Form_Favourite_Add.Show 1
@ -123,6 +125,7 @@ Private Sub Command_Modify_Click()
Dim temp As String
If List_Favourite.ListCount = 0 Then Exit Sub
change_mode = True
favourite_add_save = False
temp = List_Favourite.List(List_Favourite.ListIndex)
favourite_add_init_name = Left(temp, Len(temp) - 9)
favourite_add_init_code = Left(Right(temp, 8), 7)
@ -138,6 +141,10 @@ Private Sub Command_Delete_Click()
Else
List_Favourite.ListIndex = temp
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
End Sub
Private Sub List_Favourite_Click()
@ -180,13 +187,13 @@ Private Sub Save_Data()
Call Save_Favourite_Cases
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
@ -197,7 +204,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

559
Form_Favourite_Add.frm
View File

@ -13,11 +13,50 @@ Begin VB.Form Form_Favourite_Add
ScaleHeight = 5535
ScaleWidth = 3870
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
Caption = "确认"
Height = 615
Left = 2640
TabIndex = 4
TabIndex = 2
Top = 4800
Width = 1120
End
@ -25,7 +64,7 @@ Begin VB.Form Form_Favourite_Add
Alignment = 2 'Center
Height = 270
Left = 600
TabIndex = 3
TabIndex = 1
Top = 5160
Width = 1935
End
@ -33,28 +72,10 @@ Begin VB.Form Form_Favourite_Add
Alignment = 2 'Center
Height = 270
Left = 600
TabIndex = 2
TabIndex = 0
Top = 4800
Width = 1935
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
Attribute VB_Name = "Form_Favourite_Add"
Attribute VB_GlobalNameSpace = False
@ -67,36 +88,83 @@ Private Type Case_Block
style As Integer
End Type
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 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()
start_x = 120
start_y = 120
square_width = 815
gap = 75
print_now = 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
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
Text_Name = favourite_add_init_name
Text_Code = favourite_add_init_code
Call Text_Code_Change
End Sub
Private Sub Command_Confirm_Click()
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
favourite_add_confirm = True
favourite_add_name = Text_Name
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
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()
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_Code(UCase(Text_Code))
Call Analyse(UCase(Text_Code))
If Check = True Then
Text_Code = UCase(Text_Code)
Call Output_Graph
@ -109,14 +177,228 @@ End Sub
Private Sub Text_Name_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_Code.SetFocus
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()
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
@ -127,7 +409,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
@ -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_line_color, B
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
Dim temp(0 To 19) As Boolean
Dim addr As Integer, i As Integer, j As Integer
@ -193,6 +538,118 @@ Private Function Check() As Boolean
Next i
If j <> 2 Then Check = False
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)
On Error Resume Next
Dim temp(1 To 12) As Integer
@ -263,3 +720,49 @@ Private Sub Analyse_Code(code As String)
Next i
err:
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
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "HRD Game v1.4 by Dnomd343"
Caption = "HRD Game v1.5 by Dnomd343"
ClientHeight = 7305
ClientLeft = 45
ClientTop = 690
@ -14,6 +14,14 @@ Begin VB.Form Form_Game
ScaleHeight = 7305
ScaleWidth = 7290
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
Caption = "我的收藏"
Height = 495
@ -27,7 +35,7 @@ Begin VB.Form Form_Game
Height = 495
Left = 5760
TabIndex = 10
Top = 4080
Top = 4680
Width = 1335
End
Begin VB.CommandButton Command_Create_Snapshot
@ -35,7 +43,7 @@ Begin VB.Form Form_Game
Height = 495
Left = 5760
TabIndex = 9
Top = 3480
Top = 4080
Width = 1335
End
Begin VB.CommandButton Command_Rand_Case
@ -72,7 +80,7 @@ Begin VB.Form Form_Game
Height = 495
Left = 5760
TabIndex = 1
Top = 4680
Top = 5280
Width = 1335
End
Begin VB.Timer Timer_Get_Time
@ -148,8 +156,8 @@ Private Type Case_Block
style As Integer
End Type
Private Type Block_Address
x As Integer
y As Integer
X As Integer
Y As Integer
End Type
Dim Block(0 To 9) As Case_Block
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 Start_Code As String
Dim snapshot_code As String, snapshot_step As Long
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
@ -179,16 +189,16 @@ End Sub
Private Sub Form_Load()
Call init
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_x = x
mouse_y = y
mouse_x = X
mouse_y = Y
End Sub
Private Sub Form_DblClick()
Call Form_Click
End Sub
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_y < start_y Or mouse_y > start_y + square_width * 5 + gap * 6 Then Exit Sub
If solve_compete = True Then Exit Sub
@ -200,32 +210,32 @@ Private Sub Form_Click()
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
Y = Int(Block(m).address / 4) + 1
X = Block(m).address - (Y - 1) * 4 + 1
If m = last_move Then
If move_max_step = 1 Then
If dir_x2 = 0 And dir_y2 = 0 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
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
Else
If mouse_button = 1 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
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
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
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
ElseIf mouse_button = 2 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
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
@ -234,17 +244,17 @@ Private Sub Form_Click()
If move_times Mod 4 = 0 Then
Call Move_Block(m, dir_x1, dir_y1)
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
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
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
ElseIf mouse_button = 2 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
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
@ -256,13 +266,13 @@ Private Sub Form_Click()
If move_max_step = 0 Then Exit Sub
total_steps = total_steps + 1
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
If mouse_button = 2 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
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
@ -289,6 +299,12 @@ Private Sub Command_Favourite_Click()
favourite_add_confirm = False
Form_Favourite.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 = ""
Form_Favourite_Add.Show 1
End Sub
Private Sub Command_Create_Snapshot_Click()
If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
@ -322,6 +338,7 @@ End Sub
Private Sub init()
playing = False
solve_compete = False
Timer_Get_Time.Enabled = False
snapshot_step = -1
last_move = 10
move_times = 0
@ -351,216 +368,216 @@ Private Sub init()
y_split(5) = start_y + gap + (square_width + gap) * 5
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
Dim addr As Integer, style As Integer, X As Integer, Y As Integer
addr = Block(m).address
style = Block(m).style
y = Int(addr / 4) + 1
x = addr - (y - 1) * 4 + 1
x = x + dir_x
y = y + dir_y
addr = (y - 1) * 4 + x - 1
Y = Int(addr / 4) + 1
X = addr - (Y - 1) * 4 + 1
X = X + dir_x
Y = Y + dir_y
addr = (Y - 1) * 4 + X - 1
Call Clear_Block(m)
Block(m).address = addr
Block(m).style = style
If Block(m).style = 0 Then
Block_index(x, y) = m
Block_index(x, y + 1) = m
Block_index(x + 1, y) = m
Block_index(x + 1, y + 1) = m
Block_index(X, Y) = m
Block_index(X, Y + 1) = m
Block_index(X + 1, Y) = m
Block_index(X + 1, Y + 1) = m
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
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 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
move_once = False
dir_x1 = 0: dir_x2 = 0: dir_y1 = 0: dir_y2 = 0
move_max_step = 0
addr = Block(m).address
y = Int(addr / 4) + 1
x = addr - (y - 1) * 4 + 1
block_addr(0).x = x: block_addr(0).y = y
block_addr(1).x = x: block_addr(1).y = y
block_addr(2).x = x: block_addr(2).y = y
Y = Int(addr / 4) + 1
X = addr - (Y - 1) * 4 + 1
block_addr(0).X = X: block_addr(0).Y = Y
block_addr(1).X = X: block_addr(1).Y = Y
block_addr(2).X = X: block_addr(2).Y = Y
If Block(m).style = 0 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 Y > 1 Then
If Exist(X, Y - 1) = False And Exist(X + 1, Y - 1) = False Then move_max_step = 1: dir_y1 = -1
End If
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 Y < 4 Then
If Exist(X, Y + 2) = False And Exist(X + 1, Y + 2) = False Then move_max_step = 1: dir_y1 = 1
End If
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 X > 1 Then
If Exist(X - 1, Y) = False And Exist(X - 1, Y + 1) = False Then move_max_step = 1: dir_x1 = -1
End If
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 X < 3 Then
If Exist(X + 2, Y) = False And Exist(X + 2, Y + 1) = False Then move_max_step = 1: dir_x1 = 1
End If
ElseIf Block(m).style = 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 Y > 1 Then
If Exist(X, Y - 1) = False And Exist(X + 1, Y - 1) = False Then move_max_step = 1: dir_y1 = -1
End If
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 Y < 5 Then
If Exist(X, Y + 1) = False And Exist(X + 1, Y + 1) = False Then move_max_step = 1: dir_y1 = 1
End If
If x > 1 Then
If Exist(x - 1, y) = False Then
If X > 1 Then
If Exist(X - 1, Y) = False Then
move_max_step = 1
If move_once = False Then dir_x1 = -1 Else dir_x2 = -1
move_once = True
If x > 2 Then
If Exist(x - 2, y) = False Then move_max_step = 2: dir_x2 = -2
If X > 2 Then
If Exist(X - 2, Y) = False Then move_max_step = 2: dir_x2 = -2
End If
End If
End If
If x < 3 Then
If Exist(x + 2, y) = False Then
If X < 3 Then
If Exist(X + 2, Y) = False Then
move_max_step = 1
If move_once = False Then dir_x1 = 1 Else dir_x2 = 1
move_once = True
If x < 2 Then
If Exist(x + 3, y) = False Then move_max_step = 2: dir_x2 = 2
If X < 2 Then
If Exist(X + 3, Y) = False Then move_max_step = 2: dir_x2 = 2
End If
End If
End If
ElseIf Block(m).style = 2 Then
If y > 1 Then
If Exist(x, y - 1) = False Then
If Y > 1 Then
If Exist(X, Y - 1) = False Then
move_max_step = 1
If move_once = False Then dir_y1 = -1 Else dir_y2 = -1
move_once = True
If y > 2 Then
If Exist(x, y - 2) = False Then move_max_step = 2: dir_y2 = -2
If Y > 2 Then
If Exist(X, Y - 2) = False Then move_max_step = 2: dir_y2 = -2
End If
End If
End If
If y < 4 Then
If Exist(x, y + 2) = False Then
If Y < 4 Then
If Exist(X, Y + 2) = False Then
move_max_step = 1
If move_once = False Then dir_y1 = 1 Else dir_y2 = 1
move_once = True
If y < 3 Then
If Exist(x, y + 3) = False Then move_max_step = 2: dir_y2 = 2
If Y < 3 Then
If Exist(X, Y + 3) = False Then move_max_step = 2: dir_y2 = 2
End If
End If
End If
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 X > 1 Then
If Exist(X - 1, Y) = False And Exist(X - 1, Y + 1) = False Then move_max_step = 1: dir_x1 = -1
End If
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 X < 4 Then
If Exist(X + 1, Y) = False And Exist(X + 1, Y + 1) = False Then move_max_step = 1: dir_x1 = 1
End If
ElseIf Block(m).style = 3 Then
If y > 1 Then
If Exist(x, y - 1) = False Then
If Y > 1 Then
If Exist(X, Y - 1) = False Then
move_max_step = 1
If move_once = False Then dir_y1 = -1 Else dir_y2 = -1
move_once = True
If y > 2 Then
If Exist(x, y - 2) = False Then move_max_step = 2: dir_y2 = -2
If Y > 2 Then
If Exist(X, Y - 2) = False Then move_max_step = 2: dir_y2 = -2
End If
If x > 1 Then
If Exist(x - 1, y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1
If X > 1 Then
If Exist(X - 1, Y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1
End If
If x < 4 Then
If Exist(x + 1, y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1
If X < 4 Then
If Exist(X + 1, Y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1
End If
End If
End If
If y < 5 Then
If Exist(x, y + 1) = False Then
If Y < 5 Then
If Exist(X, Y + 1) = False Then
move_max_step = 1
If move_once = False Then dir_y1 = 1 Else dir_y2 = 1
move_once = True
If y < 4 Then
If Exist(x, y + 2) = False Then move_max_step = 2: dir_y2 = 2
If Y < 4 Then
If Exist(X, Y + 2) = False Then move_max_step = 2: dir_y2 = 2
End If
If x > 1 Then
If Exist(x - 1, y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1
If X > 1 Then
If Exist(X - 1, Y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1
End If
If x < 4 Then
If Exist(x + 1, y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1
If X < 4 Then
If Exist(X + 1, Y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1
End If
End If
End If
If x > 1 Then
If Exist(x - 1, y) = False Then
If X > 1 Then
If Exist(X - 1, Y) = False Then
move_max_step = 1
If move_once = False Then dir_x1 = -1 Else dir_x2 = -1
move_once = True
If x > 2 Then
If Exist(x - 2, y) = False Then move_max_step = 2: dir_x2 = -2
If X > 2 Then
If Exist(X - 2, Y) = False Then move_max_step = 2: dir_x2 = -2
End If
If y > 1 Then
If Exist(x - 1, y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1
If Y > 1 Then
If Exist(X - 1, Y - 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = -1
End If
If y < 5 Then
If Exist(x - 1, y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1
If Y < 5 Then
If Exist(X - 1, Y + 1) = False Then move_max_step = 2: dir_x2 = -1: dir_y2 = 1
End If
End If
End If
If x < 4 Then
If Exist(x + 1, y) = False Then
If X < 4 Then
If Exist(X + 1, Y) = False Then
move_max_step = 1
If move_once = False Then dir_x1 = 1 Else dir_x2 = 1
move_once = True
If x < 3 Then
If Exist(x + 2, y) = False Then move_max_step = 2: dir_x2 = 2
If X < 3 Then
If Exist(X + 2, Y) = False Then move_max_step = 2: dir_x2 = 2
End If
If y > 1 Then
If Exist(x + 1, y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1
If Y > 1 Then
If Exist(X + 1, Y - 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = -1
End If
If y < 5 Then
If Exist(x + 1, y + 1) = False Then move_max_step = 2: dir_x2 = 1: dir_y2 = 1
If Y < 5 Then
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
block_addr(1).x = block_addr(0).x + dir_x1
block_addr(1).y = block_addr(0).y + dir_y1
block_addr(2).x = block_addr(0).x + dir_x2
block_addr(2).y = block_addr(0).y + dir_y2
block_addr(1).X = block_addr(0).X + dir_x1
block_addr(1).Y = block_addr(0).Y + dir_y1
block_addr(2).X = block_addr(0).X + dir_x2
block_addr(2).Y = block_addr(0).Y + dir_y2
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
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
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
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
End Function
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
@ -571,7 +588,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
@ -597,35 +614,35 @@ Private Sub Case_init()
Next i
End Sub
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
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
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
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
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
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
Exist(X, Y) = False
Block_index(X, Y) = 10
End If
Block(m).address = 25
Block(m).style = 4
@ -706,41 +723,41 @@ Private Function Get_Code() As String
Get_Code = code
End Function
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)
For x = 1 To 4
For y = 1 To 5
Block_index(x, y) = 10
Exist(x, y) = False
Next y
Next x
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
@ -905,9 +922,9 @@ Private Sub Timer_Debug_Timer()
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 & "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 & "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

2
HRD_Game.vbp
View File

@ -17,7 +17,7 @@ Name="HRD_Game"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=4
MinorVer=5
RevisionVer=0
AutoIncrementVer=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_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, 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

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 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 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 Type FILETIME
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 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
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)
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 LWT As FILETIME
lReserved = 0
Index = 0
index = 0
lRet = RegOpenKey(hkey, SubKey, phkRet)
If lRet = 0 Then
Do
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
ReDim Preserve Favourite_Cases_name(UBound(Favourite_Cases_name) + 1)
Favourite_Cases_name(UBound(Favourite_Cases_name)) = name
Else
Exit Do
End If
Index = Index + 1
index = index + 1
Loop While lRet = 0
End If
Call RegCloseKey(phkRet)

Write Preview
Loading…
Cancel
Save