Browse Source

v0.1

master v0.1
Dnomd343 5 years ago
parent
commit
2b16e01932
  1. 652
      Form_Game.frm
  2. 4
      HRD_Game.vbp
  3. 3
      HRD_Game.vbw
  4. 9
      Module.bas

652
Form_Game.frm

@ -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

@ -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

@ -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

@ -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
Loading…
Cancel
Save