This is a database project containing all klotski cases.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 

217 lines
8.3 KiB

Attribute VB_Name = "Module"
Option Explicit
Type Case_detail
status(0 To 3, 0 To 4) As Integer ' 255 -> undefined ; 254 -> space
kind(0 To 14) As Integer ' 0 -> 2 * 2 ; 1 -> 2 * 1 ; 2 -> 1 * 2 ; 3 -> 1 * 1
code As String ' length -> 9
End Type
Type Case_size ' 记录棋盘的大小
start_x As Integer
start_y As Integer
square_width As Integer
gap As Integer
End Type
Type Case_style ' 记录显示的颜色与边框粗细
block_line_width As Integer
case_line_width As Integer
block_line_color As OLE_COLOR
case_line_color As OLE_COLOR
block_color As OLE_COLOR
case_color As OLE_COLOR
End Type
Public Parse_data As Case_detail ' 解析编码的返回数据
Public style As Case_style ' 通用显示样式
Sub main() ' 程序入口
Form_main.Show
End Sub
Public Sub Output_case(obj, case_data As Case_detail, case_output As Case_size) ' 将输入的布局显示到obj上
Dim i As Integer, x As Integer, y As Integer
Dim block_type As Integer
Dim exclude(0 To 3, 0 To 4) ' 排除已经搜索过的块
Dim print_x As Integer, print_y As Integer ' 显示的起始位置
Dim print_width As Integer, print_height As Integer ' 显示的宽度和高度
For y = 0 To 4 ' 初始化exclude
For x = 0 To 3
exclude(x, y) = False
Next x
Next y
' 显示主框架
Call Print_Block(obj, case_output.start_x, case_output.start_y, case_output.square_width * 4 + case_output.gap * 5, case_output.square_width * 5 + case_output.gap * 6, style.case_line_width, style.case_color, style.case_line_color)
For y = 0 To 4 ' 遍历20个位置
For x = 0 To 3
If exclude(x, y) = False And case_data.status(x, y) <> 254 Then ' 未被发现过且该块不为空
print_x = x * (case_output.square_width + case_output.gap) + case_output.gap + case_output.start_x ' 计算起始位置
print_y = y * (case_output.square_width + case_output.gap) + case_output.gap + case_output.start_y
block_type = case_data.kind(case_data.status(x, y)) ' 得到块的类型
If block_type = 0 Then ' 2 * 2
print_width = case_output.square_width * 2 + case_output.gap
print_height = case_output.square_width * 2 + case_output.gap
exclude(x + 1, y) = True ' 设置为已发现
exclude(x, y + 1) = True
exclude(x + 1, y + 1) = True
ElseIf block_type = 1 Then ' 2 * 1
print_width = case_output.square_width * 2 + case_output.gap
print_height = case_output.square_width
exclude(x + 1, y) = True ' 设置为已发现
ElseIf block_type = 2 Then ' 1 * 2
print_width = case_output.square_width
print_height = case_output.square_width * 2 + case_output.gap
exclude(x, y + 1) = True ' 设置为已发现
ElseIf block_type = 3 Then ' 1 * 1
print_width = case_output.square_width
print_height = case_output.square_width
End If
' 显示找到的块
Call Print_Block(obj, print_x, print_y, print_width, print_height, style.block_line_width, style.block_color, style.block_line_color)
End If
Next x
Next y
End Sub
Public Sub Print_Block(obj, print_start_x, print_start_y, print_width, print_height, print_line_width, print_color, print_line_color) ' 打印输入参数的矩形到obj上
If print_width < 0 Or print_height < 0 Then Exit Sub
obj.FillStyle = 0
obj.DrawWidth = print_line_width
obj.FillColor = print_color
obj.Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B
obj.Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B
End Sub
Function change_str(dat As Integer) As String ' 输入一个十六进制位 转化为字符串返回
If dat <= 9 And dat >= 0 Then
change_str = Str(dat)
ElseIf dat >= 10 And dat <= 15 Then
change_str = Chr(dat + 55)
Else
change_str = "-"
End If
change_str = Trim(change_str)
End Function
Function change_int(dat As String) As Integer ' 输入一个十六进制位字符串 转化为int返回
If Asc(dat) >= 48 And Asc(dat) <= 57 Then change_int = Int(dat) ' 0 - 9
If Asc(dat) >= 65 And Asc(dat) <= 70 Then change_int = Asc(dat) - 55 ' A - F
If Asc(dat) >= 97 And Asc(dat) <= 102 Then change_int = Asc(dat) - 87 ' a - f
End Function
Public Function Get_Code(case_data As Case_detail) As String ' 获取编码 输入数据必须无误
Dim x As Integer, y As Integer, num As Integer
Dim block_type As Integer
Dim range(1 To 16) As Integer
Dim exclude(0 To 3, 0 To 4) ' 排除已经搜索过的块
For num = 1 To 16 ' 初始化range
range(num) = 0
Next num
For y = 0 To 4 ' 初始化exclude
For x = 0 To 3
exclude(x, y) = False
Next x
Next y
num = 1
For y = 0 To 4 ' 遍历20个位置
For x = 0 To 3
If exclude(x, y) = False Then ' 未被发现过且该块不为空
If case_data.status(x, y) <> 254 Then
block_type = case_data.kind(case_data.status(x, y)) ' 得到块的类型
If block_type = 0 Then ' 2 * 2
Get_Code = change_str(x + y * 4)
exclude(x + 1, y) = True
exclude(x, y + 1) = True
exclude(x + 1, y + 1) = True
ElseIf block_type = 1 Then ' 2 * 1
range(num) = 1
num = num + 1
exclude(x + 1, y) = True
ElseIf block_type = 2 Then ' 1 * 2
range(num) = 2
num = num + 1
exclude(x, y + 1) = True
ElseIf block_type = 3 Then ' 1 * 1
range(num) = 3
num = num + 1
End If
Else ' 空格
range(num) = 0
num = num + 1
End If
End If
Next x
Next y
For num = 1 To 16
Get_Code = Get_Code & change_str(range(num) * 4 + range(num + 1)) ' 每两个转化为一个十六进制位
num = num + 1
Next num
End Function
Public Function Parse_Code(code As String) As Boolean ' 解译编码 结果储存在Parse_data中 编码错误返回false
Dim space_num As Integer
Dim i As Integer, num As Integer
Dim x As Integer, y As Integer
Dim range(1 To 16) As Integer
Parse_Code = False
For i = 1 To 8 ' 编码后8位切割成16份
num = change_int(Mid(code, i + 1, 1)) ' 取第i位并转为数字
range(i * 2) = num Mod 4
range(i * 2 - 1) = (num - num Mod 4) / 4 Mod 4
Next i
For x = 0 To 3 ' 初始化status
For y = 0 To 4
Parse_data.status(x, y) = 255
Next y
Next x
For i = 0 To 14 ' 初始化kind
Parse_data.kind(i) = 255
Next i
num = 0
For i = 1 To 16 ' 统计序列中0的个数
If range(i) = 0 Then num = num + 1
Next i
If num < 2 Then GoTo code_err ' 0的个数低于两个出错
num = change_int(Mid(code, 1, 1))
If num > 14 Or num Mod 4 = 3 Then GoTo code_err ' 排除2 * 2块越界情况
x = num Mod 4
y = Int(num / 4)
Parse_data.kind(0) = 0 ' 载入2 * 2方块
Parse_data.status(x, y) = 0
Parse_data.status(x, y + 1) = 0
Parse_data.status(x + 1, y) = 0
Parse_data.status(x + 1, y + 1) = 0
num = 0: x = 0: y = 0
For i = 1 To 16
While Parse_data.status(x, y) <> 255 ' 找到下一个未填入的位置
x = x + 1
If x = 4 Then ' 到达行末
x = 0 ' 移动到下一行起始
y = y + 1
If y = 5 Then ' 已填满20个空位 越界
If space_num < 2 Then GoTo code_err ' 空格低于两个 出错
For num = i To 16 ' 检查余下编码是否为0
'Form_main.Text_Focus = Form_main.Text_Focus & range(num)
If range(num) <> 0 Then GoTo code_err ' 出现非0 编码错误
Next num
GoTo code_right ' 全为0 编码正确
End If
End If
Wend
If range(i) = 0 Then ' space
space_num = space_num + 1
Parse_data.status(x, y) = 254
ElseIf range(i) = 1 Then ' 2 * 1
If x = 3 Then GoTo code_err ' 越界出错
If Parse_data.status(x + 1, y) <> 255 Then GoTo code_err ' 方块重叠
num = num + 1
Parse_data.kind(num) = 1
Parse_data.status(x, y) = num
Parse_data.status(x + 1, y) = num
ElseIf range(i) = 2 Then ' 1 * 2
If y = 4 Then GoTo code_err ' 越界出错
If Parse_data.status(x, y + 1) <> 255 Then GoTo code_err ' 方块重叠
num = num + 1
Parse_data.kind(num) = 2
Parse_data.status(x, y) = num
Parse_data.status(x, y + 1) = num
ElseIf range(i) = 3 Then ' 1 * 1
num = num + 1
Parse_data.kind(num) = 3
Parse_data.status(x, y) = num
End If
Next i
code_right:
Parse_Code = True
code_err:
End Function