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

update visual

master
Dnomd343 4 years ago
parent
9ff6b2556e
commit
7a8cc868e0
3 changed files with 212 additions and 198 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. 247
      src/visual/Form_main.frm
  2. 5
      src/visual/HRD_Visual.vbp
  3. 158
      src/visual/Module.bas

247
src/visual/Form_main.frm
View File

@ -2,53 +2,45 @@ VERSION 5.00
Begin VB.Form Form_main
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "HRD Visual v0.2 by Dnomd343"
ClientHeight = 6585
Caption = "HRD Visual v1.0 by Dnomd343"
ClientHeight = 6495
ClientLeft = 45
ClientTop = 390
ClientWidth = 9390
ClientWidth = 4815
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6585
ScaleWidth = 9390
ScaleHeight = 6495
ScaleWidth = 4815
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 360
Left = 5820
TabIndex = 4
Top = 5925
Width = 840
Begin VB.Timer Timer
Enabled = 0 'False
Interval = 10
Left = 4305
Top = 5040
End
Begin VB.Timer Timer1
Interval = 100
Left = 8280
Top = 5385
End
Begin VB.TextBox Text_debug
Height = 5190
Left = 5505
MultiLine = -1 'True
Begin VB.CommandButton Command_OK
Caption = "OK"
Height = 465
Left = 3615
TabIndex = 3
Top = 495
Width = 2250
Top = 5880
Width = 1050
End
Begin VB.CommandButton Command_Get_Code
Caption = "生成编码"
Begin VB.CommandButton Command_Clear
Caption = "Clear"
Height = 465
Left = 210
Left = 150
TabIndex = 2
Top = 5970
Width = 975
Top = 5900
Width = 1050
End
Begin VB.CommandButton Command_Print
Caption = "解译编码"
Height = 465
Left = 3180
TabIndex = 1
Top = 5940
Width = 975
Begin VB.TextBox Text_Focus
Height = 270
Left = 6000
TabIndex = 0
Top = 0
Width = 180
End
Begin VB.TextBox Text_Code
Alignment = 2 'Center
@ -62,10 +54,11 @@ Begin VB.Form Form_main
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 1200
TabIndex = 0
Text = "4FEA13400"
Top = 5955
Left = 1400
MaxLength = 9
TabIndex = 1
Text = "---"
Top = 5900
Width = 2040
End
End
@ -81,66 +74,113 @@ Dim click_x_ As Integer, click_y_ As Integer '
Dim mouse_x As Integer, mouse_y As Integer ' 记录当前鼠标位置合法对应的棋盘编号
Dim output As Case_size ' 输出大小
Dim case_main As Case_detail ' 布局信息
Dim timer_ctl As Integer
Dim exclude(-1 To 1, -1 To 1) As Boolean ' 记录按下位置周围是否能放置棋子 true -> 不难 / false -> 能
Private Sub Command_Get_Code_Click()
Text_Code = Get_Code(case_main)
End Sub
Private Sub Command1_Click()
MsgBox Check_2x2_seat
End Sub
Private Sub Form_Load()
Private Sub Form_Load() ' 窗体初始化
Call Init_case
print_now = False
Dim i As Integer, j As Integer
For i = 0 To 14
case_main.kind(i) = 255
Next i
For i = 0 To 3
For j = 0 To 4
case_main.status(i, j) = 254
Next j
Next i
output.start_x = 150
output.start_y = 150
output.square_width = 1000
output.gap = 100
output.square_width = 1000
style.block_line_width = 1
style.case_line_width = 2
style.block_line_color = RGB(0, 158, 240)
style.case_line_color = RGB(0, 158, 240)
style.block_color = RGB(225, 245, 255)
style.case_color = RGB(248, 254, 255)
' case_main.status(1, 1) = 254
' case_main.status(1, 2) = 254
' case_main.status(2, 1) = 254
' case_main.status(2, 2) = 254
' case_main.kind(0) = 255
Call Output_case(Form_main, case_main, output)
'Call Get_Code(case_main)
Call Output_case(Form_main, case_main, output) ' 显示界面
End Sub
Private Sub Command_Clear_Click() ' 清除当前显示
Call Init_case
Call Output_case(Form_main, case_main, output) ' 刷新显示界面
End Sub
Private Sub Command_OK_Click() ' 完成按钮
If Try_parse_code(Text_Code) = False Then
MsgBox "编码错误"
Else
Text_Code = UCase(Text_Code) & String(9 - Len(Text_Code), "0") ' 修改为大写并补0
Text_Focus.SetFocus ' 切走焦点
End If
End Sub
Private Sub Text_Code_DblClick() ' 双击文本框 清空内容
Text_Code = ""
Text_Code.ForeColor = vbBlack
End Sub
Private Sub Text_Code_GotFocus() ' 文本框得到焦点
If Text_Code = "---" Then Text_Code = "" ' 若还未输入内容则清空
End Sub
Private Sub Text_Code_LostFocus() ' 文本框失去焦点
If Text_Code = "" Then ' 未填写内容
Text_Code = "---"
Call Try_get_code
Else
If Text_Code.ForeColor = vbBlack Then Text_Code = UCase(Text_Code) ' 全部改为大写
End If
End Sub
Private Sub Command_Print_Click()
If Len(Text_Code) <> 9 Then MsgBox "编码有误", , "提示": Exit Sub
If Parse_Code(Text_Code) = True Then
Private Sub Text_Code_KeyPress(KeyAscii As Integer) ' 文本框输入内容
Dim code As String
If KeyAscii = 13 Then ' 回车键
Call Command_OK_Click ' 模拟点击OK按钮
Else
timer_ctl = 200 ' 发送至timer显示
Timer.Enabled = True
End If
End Sub
Private Function Try_parse_code(code As String) As Boolean ' 尝试解码
Dim i As Integer, dat As String, flag As Boolean
If Len(code) > 9 Then Try_parse_code = False: Exit Function ' 输入超9位 退出
For i = 1 To Len(code) ' 遍历字符串
dat = Mid(code, i, 1)
flag = False
If Asc(dat) >= 48 And Asc(dat) <= 57 Then flag = True ' 0 - 9
If Asc(dat) >= 65 And Asc(dat) <= 70 Then flag = True ' A - F
If Asc(dat) >= 97 And Asc(dat) <= 102 Then flag = True ' a - f
If flag = False Then Try_parse_code = False: Exit Function ' 如果存在不合法字符 退出
Next i
If Len(code) < 9 Then code = code & String(9 - Len(code), "0") ' 补0到9位
If Parse_Code(code) = True Then ' 解码正确
case_main = Parse_data
Call Output_case(Form_main, case_main, output) ' 刷新显示界面
Try_parse_code = True
Else
Try_parse_code = False
Exit Function
End If
End Function
Private Sub Try_get_code() ' 尝试获取编码
Dim code As String
If case_main.kind(0) <> 0 Then Exit Sub ' 2 * 2块还未确定 退出
code = Get_Code(case_main)
While Right(code, 1) = "0" ' 去除后方的0
code = Left(code, Len(code) - 1)
If Len(code) = 0 Then Text_Code = "0": Exit Sub ' 若全为0 保留一个退出
Wend
Text_Code = code
End Sub
Private Sub Timer_Timer()
timer_ctl = timer_ctl - 1
If timer_ctl = -1 Then Timer.Enabled = False ' 运行次数限制
If Text_Code = "" Then ' 已经被删空
Call Init_case
Call Output_case(Form_main, case_main, output)
Exit Sub
End If
If Try_parse_code(Text_Code) = False Then ' 根据输入正确性显示不同颜色
Text_Code.ForeColor = vbRed
Else
MsgBox "编码有误", , "提示"
Text_Code.ForeColor = vbBlack
End If
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) ' 按下鼠标按键
Text_Focus.SetFocus
Dim x_ As Integer, y_ As Integer, num As Integer
Dim raw_x As Single, raw_y As Single
Dim addr_x As Integer, addr_y As Integer
Dim clear As Boolean
clear = False
raw_x = Get_block_x(X) ' 得到点击位置在棋盘上的编号
raw_y = Get_block_y(Y)
raw_x = Get_block_x(x) ' 得到点击位置在棋盘上的编号
raw_y = Get_block_y(y)
If raw_x < 1 Or raw_x > 4 Or raw_y < 1 Or raw_y > 5 Then Exit Sub ' 点击在棋盘外 退出
addr_x = Int(raw_x) - 1 ' 若点击位置为间隙则映射到其左/上方
addr_y = Int(raw_y) - 1
@ -163,11 +203,13 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A
If clear = True Then ' 若被标识为点击在棋子上
Call Clear_block(num) ' 清除该棋子
Call Output_case(Form_main, case_main, output) ' 刷新显示界面
Text_Code = "---"
Call Try_get_code
Exit Sub ' 退出
End If
If Int(raw_x) <> raw_x Or Int(raw_y) <> raw_y Then Exit Sub ' 点击在间隙上 退出
click_x = raw_x: click_y = raw_y ' 记录有效的点击位置编号
click_x_ = X: click_y_ = Y ' 记录点击的真实位置
click_x_ = x: click_y_ = y ' 记录点击的真实位置
num = case_main.status(click_x - 1, click_y - 1) ' 点击位置对应的编码
For y_ = -1 To 1
For x_ = -1 To 1
@ -187,16 +229,16 @@ Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A
Next x_
Next y_
print_now = True ' 进入绘制模式
Call Form_MouseMove(Button, Shift, X, Y) ' 发起鼠标移动事件
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) ' 移动鼠标
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' 移动鼠标
Dim delta_x As Integer, delta_y As Integer
Dim print_x As Integer, print_y As Integer
Dim print_width As Integer, print_height As Integer
If print_now = False Then Exit Sub ' 判断是否在绘制模式
Call Output_case(Form_main, case_main, output) ' 覆盖上一次的显示
delta_x = signed(Get_block_x(X) - click_x) ' 记录鼠标位置与点击位置的相对方向
delta_y = signed(Get_block_y(Y) - click_y)
delta_x = signed(Get_block_x(x) - click_x) ' 记录鼠标位置与点击位置的相对方向
delta_y = signed(Get_block_y(y) - click_y)
mouse_x = click_x: mouse_y = click_y ' 默认
If Abs(delta_x) + Abs(delta_y) = 1 Then ' 如果在上下左右
If exclude(delta_x, delta_y) = False Then ' 目标位置可放置棋子
@ -208,7 +250,7 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A
If exclude(delta_x, 0) = True And exclude(0, delta_y) = False Then mouse_y = click_y + delta_y ' 若侧边被挡到
If exclude(delta_x, 0) = False And exclude(0, delta_y) = True Then mouse_x = click_x + delta_x
If exclude(delta_x, delta_y) = True And exclude(delta_x, 0) = False And exclude(0, delta_y) = False Then ' 若斜角不可放置而两边是空的
If Abs(click_x_ - X) > Abs(click_y_ - Y) Then ' x轴方向位移较大
If Abs(click_x_ - x) > Abs(click_y_ - y) Then ' x轴方向位移较大
mouse_x = click_x + delta_x
Else ' y轴方向位移较大
mouse_y = click_y + delta_y
@ -225,7 +267,7 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A
If Abs(click_y - mouse_y) = 1 Then print_height = output.square_width * 2 + output.gap Else print_height = output.square_width ' 计算绘制高度
Call Print_Block(Form_main, print_x, print_y, print_width, print_height, style.block_line_width, style.block_color, style.block_line_color) ' 绘制
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ' 释放鼠标按键
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' 释放鼠标按键
Dim i As Integer, j As Integer, num As Integer
Dim block_x As Integer, block_y As Integer
Dim block_width As Integer, block_height As Integer
@ -267,6 +309,7 @@ Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As
If case_main.kind(0) <> 0 And Check_2x2_seat = False Then Call Clear_block(num)
End If
End If
Call Try_get_code
Call Output_case(Form_main, case_main, output) ' 刷新显示界面
End Sub
Private Sub Clear_block(num As Integer) ' 根据编号清空棋子信息
@ -327,6 +370,17 @@ End Function
Private Function min(dat_1 As Integer, dat_2 As Integer) As Integer ' 返回较小的值
If dat_1 > dat_2 Then min = dat_2 Else min = dat_1
End Function
Private Sub Init_case() ' 初始化布局
Dim i As Integer, j As Integer
For i = 0 To 14
case_main.kind(i) = 255
Next i
For i = 0 To 3
For j = 0 To 4
case_main.status(i, j) = 254
Next j
Next i
End Sub
Private Function Get_addr_x(num As Integer) As Integer ' 找到编号的左上角x坐标 编号为不存在则返回255
Dim i As Integer, j As Integer
Get_addr_x = 255
@ -373,28 +427,3 @@ Private Function Get_block_y(dat As Single) As Single '
If dat < output.gap Then Get_block_y = 0 ' 上越界
dat = dat + output.start_y
End Function
Private Sub Text_Code_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command_Print_Click
End Sub
Private Sub Timer1_Timer()
Dim i As Integer, j As Integer
Dim debug_dat As String
debug_dat = ""
For j = 0 To 4
For i = 0 To 3
If case_main.status(i, j) = 254 Then
debug_dat = debug_dat & "- "
Else
debug_dat = debug_dat & case_main.status(i, j) & " "
End If
Next i
debug_dat = debug_dat & vbCrLf
Next j
For i = 0 To 14
debug_dat = debug_dat & Trim(i) & ": " & case_main.kind(i) & vbCrLf
Next i
Text_debug = debug_dat
End Sub

5
src/visual/HRD_Visual.vbp
View File

@ -5,6 +5,8 @@ Module=Module; Module.bas
IconForm="Form_main"
Startup="Sub Main"
HelpFile=""
Title="HRD_Visual"
ExeName32="HRD_Visual.exe"
Command32=""
Name="HRD_Visual"
HelpContextID="0"
@ -14,6 +16,9 @@ MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Dnomd343"
VersionLegalCopyright="DJNC"
VersionProductName="HRD_Visual"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0

158
src/visual/Module.bas
View File

@ -24,60 +24,39 @@ Public style As Case_style ' ͨ
Sub main() ' 程序入口
Form_main.Show
End Sub
Sub case_debug()
Dim X, Y, i As Integer
Dim debug_dat As String
For Y = 0 To 4
For X = 0 To 3
If Parse_data.status(X, Y) = 254 Then
debug_dat = debug_dat & "- "
ElseIf Parse_data.status(X, Y) = 255 Then
debug_dat = debug_dat & "? "
Else
debug_dat = debug_dat & change_str(Parse_data.status(X, Y)) & " "
End If
Next X
debug_dat = debug_dat & vbCrLf
Next Y
debug_dat = debug_dat & vbCrLf
For i = 0 To 14
debug_dat = debug_dat & i & ": " & Parse_data.kind(i) & vbCrLf
Next i
MsgBox debug_dat
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 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
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)) ' 得到块的类型
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
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 ' 设置为已发现
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 ' 设置为已发现
exclude(x, y + 1) = True ' 设置为已发现
ElseIf block_type = 3 Then ' 1 * 1
print_width = case_output.square_width
print_height = case_output.square_width
@ -85,8 +64,8 @@ Public Sub Output_case(obj, case_data As Case_detail, case_output As Case_size)
' 显示找到的块
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
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
@ -112,37 +91,37 @@ Function change_int(dat As String) As Integer '
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 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
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)) ' 得到块的类型
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
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
exclude(x + 1, y) = True
ElseIf block_type = 2 Then ' 1 * 2
range(num) = 2
num = num + 1
exclude(X, Y + 1) = True
exclude(x, y + 1) = True
ElseIf block_type = 3 Then ' 1 * 1
range(num) = 3
num = num + 1
@ -152,8 +131,8 @@ Public Function Get_Code(case_data As Case_detail) As String '
num = num + 1
End If
End If
Next X
Next Y
Next x
Next y
For num = 1 To 16
Get_Code = Get_Code & change_str(range(num) * 4 + range(num + 1)) ' 每两个转化为一个十六进制位
num = num + 1
@ -162,7 +141,7 @@ 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 x As Integer, y As Integer
Dim range(1 To 16) As Integer
Parse_Code = False
For i = 1 To 8 ' 编码后8位切割成16份
@ -170,11 +149,11 @@ Public Function Parse_Code(code As String) As Boolean '
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 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
@ -185,23 +164,24 @@ Public Function Parse_Code(code As String) As Boolean '
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 = num / 4
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
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个空位 越界
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 15 ' 检查余下编码是否为0
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 编码正确
@ -210,25 +190,25 @@ Public Function Parse_Code(code As String) As Boolean '
Wend
If range(i) = 0 Then ' space
space_num = space_num + 1
Parse_data.status(X, Y) = 254
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 ' 方块重叠
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
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 ' 方块重叠
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
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
Parse_data.status(x, y) = num
End If
Next i
code_right:

Write Preview
Loading…
Cancel
Save