From 7a8cc868e05ed84800c34f32e4878a9c2b920743 Mon Sep 17 00:00:00 2001 From: Dnomd343 Date: Sun, 5 Jul 2020 00:18:06 +0800 Subject: [PATCH] update visual --- src/visual/Form_main.frm | 247 +++++++++++++++++++++----------------- src/visual/HRD_Visual.vbp | 5 + src/visual/Module.bas | 158 +++++++++++------------- 3 files changed, 212 insertions(+), 198 deletions(-) diff --git a/src/visual/Form_main.frm b/src/visual/Form_main.frm index 0d4bd55..17d2fb5 100644 --- a/src/visual/Form_main.frm +++ b/src/visual/Form_main.frm @@ -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 diff --git a/src/visual/HRD_Visual.vbp b/src/visual/HRD_Visual.vbp index 7db5555..b6ad3ca 100644 --- a/src/visual/HRD_Visual.vbp +++ b/src/visual/HRD_Visual.vbp @@ -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 diff --git a/src/visual/Module.bas b/src/visual/Module.bas index 1896fb8..6dd0542 100644 --- a/src/visual/Module.bas +++ b/src/visual/Module.bas @@ -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: