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

v0.1

master v0.1
Dnomd343 5 years ago
parent
a70c45c115
commit
2b16e01932
4 changed files with 479 additions and 201 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. 652
      Form_Game.frm
  2. 4
      HRD_Game.vbp
  3. 3
      HRD_Game.vbw
  4. 9
      Module.bas

652
Form_Game.frm
View File

@ -1,35 +1,100 @@
VERSION 5.00 VERSION 5.00
Begin VB.Form Form_Game Begin VB.Form Form_Game
AutoRedraw = -1 'True AutoRedraw = -1 'True
BorderStyle = 4 'Fixed ToolWindow BorderStyle = 1 'Fixed Single
Caption = "HRD Game v0.0 by Dnomd343" Caption = "HRD Game v0.1 by Dnomd343"
ClientHeight = 6990 ClientHeight = 7305
ClientLeft = 150 ClientLeft = 45
ClientTop = 495 ClientTop = 690
ClientWidth = 9660 ClientWidth = 7290
Icon = "Form_Game.frx":0000 Icon = "Form_Game.frx":0000
LinkTopic = "Form1" LinkTopic = "Form1"
MaxButton = 0 'False MaxButton = 0 'False
MinButton = 0 'False MinButton = 0 'False
ScaleHeight = 6990 ScaleHeight = 7305
ScaleWidth = 9660 ScaleWidth = 7290
ShowInTaskbar = 0 'False
StartUpPosition = 2 'ÆÁÄ»ÖÐÐÄ StartUpPosition = 2 'ÆÁÄ»ÖÐÐÄ
Begin VB.Timer Timer1 Begin VB.CommandButton Command_Create_Case
Caption = "自定义布局"
Height = 495
Left = 5760
TabIndex = 6
Top = 600
Width = 1335
End
Begin VB.Timer Timer_Layout
Interval = 300
Left = 0
Top = 0
End
Begin VB.CommandButton Command_Reset
Caption = "重新开始"
Height = 495
Left = 5760
TabIndex = 1
Top = 1200
Width = 1335
End
Begin VB.Timer Timer_Get_Time
Enabled = 0 'False
Interval = 50
Left = 0
Top = 0
End
Begin VB.Timer Timer_Debug
Interval = 200 Interval = 200
Left = 9840 Left = 0
Top = 240 Top = 0
End End
Begin VB.TextBox Text_Debug Begin VB.TextBox Text_Debug
Height = 6735 Height = 6855
Left = 5760 Left = 7320
MultiLine = -1 'True MultiLine = -1 'True
TabIndex = 0 TabIndex = 0
Top = 120 Top = 240
Width = 3735 Width = 3735
End End
Begin VB.Menu test Begin VB.Label Label_Code
Caption = "test" AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 5
Top = 7000
Width = 90
End
Begin VB.Label Label_Step
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 4
Top = 7000
Width = 90
End
Begin VB.Label Label_Title
Alignment = 2 'Center
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 3
Top = 45
Width = 105
End
Begin VB.Label Label_Time
AutoSize = -1 'True
Height = 180
Left = 0
TabIndex = 2
Top = 7000
Width = 90
End
Begin VB.Menu Menu_Setting
Caption = "设置"
Begin VB.Menu Menu_On_Top
Caption = "窗口保持最前"
End
Begin VB.Menu Menu_Debug_Mode
Caption = "Debug模式"
End
End End
End End
Attribute VB_Name = "Form_Game" Attribute VB_Name = "Form_Game"
@ -43,56 +108,99 @@ 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
Dim Block_index(1 To 4, 1 To 5) As Integer Dim Block_index(1 To 4, 1 To 5) As Integer
Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
Dim block_line_width As Integer, case_line_width As Integer
Dim block_color, block_line_color, case_color, case_line_color
Dim x_split(0 To 4) As Integer, y_split(0 To 5) As Integer Dim x_split(0 To 4) As Integer, y_split(0 To 5) As Integer
Dim dir_x1 As Integer, dir_y1 As Integer, dir_x2 As Integer, dir_y2 As Integer Dim dir_x1 As Integer, dir_y1 As Integer, dir_x2 As Integer, dir_y2 As Integer
Dim block_addr(0 To 2) As Block_Address, move_max_step As Integer Dim block_addr(0 To 2) As Block_Address, move_max_step As Integer
Dim mouse_x As Long, mouse_y As Long Dim mouse_x As Long, mouse_y As Long, mouse_button As Integer
Dim last_move As Integer, move_times As Integer Dim last_move As Integer, move_times As Integer
Dim total_steps As Long Dim total_steps As Long, total_time As Long
Dim debug_mode As Boolean Dim Start_Code As String
Private Sub Command_Create_Case_Click()
change_case_title = InputBox("请输入布局名称", "提示", "横刀立马")
change_case_code = InputBox("请输入布局编码(7bits)", "提示", "1A9BF0C")
change_case = True
End Sub
Private Sub Command_Reset_Click()
total_steps = 0
total_time = 0
Timer_Get_Time.Enabled = False
Call init
Label_Step = "步数: 0"
Label_Code = Start_Code
Label_Time = "用时: 0:00:00"
Call Analyse(Start_Code)
Call Output_Graph
End Sub
Private Sub Form_Click() Private Sub Form_Click()
Dim m 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
m = Block_index(Get_block_x(mouse_x), Get_block_y(mouse_y)) m = Block_index(Get_block_x(mouse_x), Get_block_y(mouse_y))
If m = 10 Then Exit Sub If m = 10 Then Exit Sub
If playing = False Then
playing = True
total_time = 0
total_steps = 0
Timer_Get_Time.Enabled = True
End If
Y = Int(Block(m).address / 4) + 1
X = Block(m).address - (Y - 1) * 4 + 1
If m = last_move Then 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, -dir_x1, -dir_y1) Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
Else Else
Call Move_Block(m, dir_x1, dir_y1) 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 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, 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 - block_addr(1).x, block_addr(0).y - block_addr(1).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 - block_addr(0).x, block_addr(2).y - block_addr(0).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 - block_addr(2).x, block_addr(0).y - block_addr(2).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)
ElseIf move_times Mod 2 = 1 Then
Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
End If
End If End If
End If End If
ElseIf move_max_step = 2 Then ElseIf move_max_step = 2 Then
If mouse_button = 1 Then
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 - block_addr(1).x, block_addr(2).y - block_addr(1).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 - block_addr(2).x, block_addr(1).y - block_addr(2).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 - block_addr(1).x, block_addr(0).y - block_addr(1).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)
ElseIf move_times Mod 2 = 1 Then
Call Move_Block(m, block_addr(0).X - X, block_addr(0).Y - Y)
End If
End If End If
End If End If
move_times = move_times + 1 move_times = move_times + 1
@ -102,9 +210,27 @@ Private Sub Form_Click()
last_move = m last_move = m
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
Call Move_Block(m, dir_x1, dir_y1) If mouse_button = 1 Then
Call Move_Block(m, block_addr(1).X - X, block_addr(1).Y - Y)
End If 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)
ElseIf move_max_step = 2 Then
Call Move_Block(m, block_addr(2).X - X, block_addr(2).Y - Y)
End If
End If
End If
Label_Step = "步数: " & total_steps
Label_Code = Get_Code()
Call Output_Graph Call Output_Graph
If Block(0).address = 13 Then
Timer_Get_Time = False
playing = False
solve_compete = True
MsgBox "恭喜你成功完成！" & vbCrLf & "编码: " & Start_Code & vbCrLf & "步数: " & total_steps & vbCrLf & "用时: " & Right(Label_Time, Len(Label_Time) - 4), , "（>__<）"
End If
End Sub End Sub
Private Sub Form_DblClick() Private Sub Form_DblClick()
@ -112,226 +238,225 @@ Private Sub Form_DblClick()
End Sub End Sub
Private Sub Form_Load() Private Sub Form_Load()
Me.Icon = LoadPicture("")
Call init Call init
debug_mode = True
Call Analyse("1A9BF0C")
Call Output_Graph
End Sub End Sub
Private Sub Form_MouseMove(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_x = x mouse_button = Button
mouse_y = y mouse_x = X
mouse_y = Y
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 init() Private Sub init()
playing = False
solve_compete = False
last_move = 10 last_move = 10
move_times = 0 move_times = 0
total_steps = 0 total_steps = 0
start_x = 90 start_x = 180
start_y = 180 start_y = 300
gap = 105 gap = 105
square_width = 1200 square_width = 1200
block_line_width = 1 block_line_width = 1
@ -340,6 +465,7 @@ Private Sub init()
case_line_color = RGB(0, 0, 0) case_line_color = RGB(0, 0, 0)
block_color = RGB(250, 250, 250) block_color = RGB(250, 250, 250)
case_color = RGB(256, 256, 256) case_color = RGB(256, 256, 256)
Call Case_init
x_split(0) = start_x x_split(0) = start_x
x_split(1) = start_x + gap / 2 + square_width + gap x_split(1) = start_x + gap / 2 + square_width + gap
x_split(2) = start_x + gap / 2 + (square_width + gap) * 2 x_split(2) = start_x + gap / 2 + (square_width + gap) * 2
@ -353,13 +479,13 @@ 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 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
@ -370,7 +496,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
@ -396,75 +522,150 @@ 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
End Sub End Sub
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) 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
@ -590,7 +791,34 @@ Private Sub Analyse_Code(Code As String)
Next i Next i
err: err:
End Sub End Sub
Private Sub Timer1_Timer()
Private Sub Menu_Debug_Mode_Click()
Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked
If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False
End Sub
Private Sub Menu_On_Top_Click()
Menu_On_Top.Checked = Not Menu_On_Top.Checked
If Menu_On_Top.Checked = True Then
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
Else
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
End If
End Sub
Private Sub Timer_Get_Time_Timer()
Static temp As Integer
Dim time_hour As String, time_minute As String, time_second As String
If Not temp = Second(Time) Then total_time = total_time + 1: temp = Second(Time)
time_second = total_time Mod 60
time_minute = ((total_time - time_second) Mod 3600) / 60
time_hour = (total_time - time_second - time_minute * 60) / 3600
If Len(time_second) = 1 Then time_second = "0" & time_second
If Len(time_minute) = 1 Then time_minute = "0" & time_minute
Label_Time = "用时: " & time_hour & ":" & time_minute & ":" & time_second
End Sub
Private Sub Timer_Debug_Timer()
Dim i As Integer, j As Integer, m As Integer, debug_dat As String Dim i As Integer, j As Integer, m As Integer, debug_dat As String
For m = 0 To 9 For m = 0 To 9
debug_dat = debug_dat & "Block[" & m & "] -> address = " & Block(m).address & " style = " & Block(m).style debug_dat = debug_dat & "Block[" & m & "] -> address = " & Block(m).address & " style = " & Block(m).style
@ -618,13 +846,49 @@ Private Sub Timer1_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
debug_dat = debug_dat & vbCrLf
debug_dat = debug_dat & "total_steps=" & total_steps & vbCrLf debug_dat = debug_dat & "total_steps=" & total_steps & vbCrLf
debug_dat = debug_dat & "total_time=" & total_time & vbCrLf
Text_Debug = debug_dat Text_Debug = debug_dat
End Sub End Sub
Private Sub Timer_Layout_Timer()
Dim width As Integer
width = gap * 5 + square_width * 4
Label_Title.Top = 45
Label_Code.Top = 7000
Label_Step.Top = 7000
Label_Time.Top = 7000
Label_Title.Left = (width - Label_Title.width) / 2 + start_x
Label_Code.Left = (width - Label_Code.width) / 2 + start_x
Label_Step.Left = start_x
Label_Time.Left = start_x + width - Label_Time.width
If debug_mode = True Then
Form_Game.width = 11355
Form_Game.height = 8040
Text_Debug.Visible = True
Timer_Debug.Enabled = True
Else
Form_Game.width = 7380
Form_Game.height = 8040
Text_Debug.Visible = False
Timer_Debug.Enabled = False
End If
If change_case = True Then
change_case = False
Label_Title.Caption = change_case_title & "(" & change_case_code & ")"
Call init
Start_Code = change_case_code
Label_Step = "步数: 0"
Label_Code = Start_Code
Label_Time = "用时: 0:00:00"
Call Analyse(Start_Code)
Call Output_Graph
End If
End Sub

4
HRD_Game.vbp
View File

@ -1,6 +1,7 @@
Type=Exe Type=Exe
Form=Form_Game.frm Form=Form_Game.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation
Module=Module; Module.bas
IconForm="Form_Game" IconForm="Form_Game"
Startup="Form_Game" Startup="Form_Game"
HelpFile="" HelpFile=""
@ -10,6 +11,9 @@ Command32=""
Name="HRD_Game" Name="HRD_Game"
HelpContextID="0" HelpContextID="0"
CompatibleMode="0" CompatibleMode="0"
MajorVer=0
MinorVer=1
RevisionVer=0
AutoIncrementVer=0 AutoIncrementVer=0
ServerSupportFiles=0 ServerSupportFiles=0
VersionCompanyName="Dnomd343" VersionCompanyName="Dnomd343"

3
HRD_Game.vbw
View File

@ -1 +1,2 @@
Form_Game = 52, 52, 883, 479, , 26, 26, 857, 453, C Form_Game = 52, 52, 883, 479, , 26, 27, 857, 453, C
Module = 52, 52, 883, 479,

9
Module.bas
View File

@ -0,0 +1,9 @@
Attribute VB_Name = "Module"
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 debug_mode As Boolean, playing As Boolean, solve_compete As Boolean
Public block_line_width As Integer, case_line_width As Integer
Public block_color, block_line_color, case_color, case_line_color
Public change_case As Boolean, change_case_title As String, change_case_code As String
Write Preview
Loading…
Cancel
Save