From 02860c38b05cd7a4a972ce47ace285578229a7f2 Mon Sep 17 00:00:00 2001 From: Dnomd343 Date: Sat, 4 Jul 2020 15:16:59 +0800 Subject: [PATCH] update visual --- src/visual/Form_main.frm | 290 ++++++++++++++++++++++++++++++++++++++- src/visual/Module.bas | 162 ++++++++++++++-------- 2 files changed, 390 insertions(+), 62 deletions(-) diff --git a/src/visual/Form_main.frm b/src/visual/Form_main.frm index f850564..874a987 100644 --- a/src/visual/Form_main.frm +++ b/src/visual/Form_main.frm @@ -2,17 +2,38 @@ VERSION 5.00 Begin VB.Form Form_main AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single - Caption = "HRD Visual v0.0 by Dnomd343" + Caption = "HRD Visual v0.1 by Dnomd343" ClientHeight = 6585 ClientLeft = 45 ClientTop = 390 - ClientWidth = 4830 + ClientWidth = 9390 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6585 - ScaleWidth = 4830 + ScaleWidth = 9390 StartUpPosition = 2 '屏幕中心 + Begin VB.Timer Timer1 + Interval = 100 + Left = 8280 + Top = 5385 + End + Begin VB.TextBox Text_debug + Height = 5190 + Left = 5505 + MultiLine = -1 'True + TabIndex = 3 + Top = 495 + Width = 2250 + End + Begin VB.CommandButton Command_Get_Code + Caption = "生成编码" + Height = 465 + Left = 210 + TabIndex = 2 + Top = 5970 + Width = 975 + End Begin VB.CommandButton Command_Print Caption = "解译编码" Height = 465 @@ -46,13 +67,36 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit +Dim print_now As Boolean +Dim click_x As Integer, click_y As Integer +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 exclude(-1 To 1, -1 To 1) As Boolean + +Private Sub Command_Get_Code_Click() + Text_Code = Get_Code(case_main) +End Sub + Private Sub Form_Load() - Call Parse_Code("4FEA13400") - case_main = Parse_data + 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 + 'Call Parse_Code("4FEA13400") + 'Call Parse_Code("5000300C0") + 'case_main = Parse_data output.start_x = 150 output.start_y = 150 + 'output.start_x = 0 + 'output.start_y = 0 output.square_width = 1000 output.gap = 100 style.block_line_width = 1 @@ -61,7 +105,14 @@ Private Sub Form_Load() 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) + End Sub Private Sub Command_Print_Click() If Len(Text_Code) <> 9 Then MsgBox "编码有误", , "提示": Exit Sub @@ -72,6 +123,235 @@ Private Sub Command_Print_Click() MsgBox "编码有误", , "提示" End If End Sub + +Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) + Dim x_ As Integer, y_ As Integer + Dim block_x As Single, block_y As Single + + block_x = Get_block_x(X) + block_y = Get_block_y(Y) + + If Int(block_x) <> block_x Then Exit Sub + If Int(block_y) <> block_y Then Exit Sub + If block_x < 1 Or block_x > 4 Then Exit Sub + If block_y < 1 Or block_y > 5 Then Exit Sub + click_x = block_x + click_y = block_y + click_x_ = X + click_y_ = Y + + If case_main.status(click_x - 1, click_y - 1) <> 254 Then Exit Sub + + + For y_ = -1 To 1 + For x_ = -1 To 1 + exclude(x_, y_) = False + Next x_ + Next y_ + If case_main.kind(0) <> 255 Then exclude(-1, -1) = True: exclude(-1, 1) = True: exclude(1, -1) = True: exclude(1, 1) = True + + If click_x = 1 Then exclude(-1, -1) = True: exclude(-1, 0) = True: exclude(-1, 1) = True + If click_x = 4 Then exclude(1, -1) = True: exclude(1, 0) = True: exclude(1, 1) = True + If click_y = 1 Then exclude(-1, -1) = True: exclude(0, -1) = True: exclude(1, -1) = True + If click_y = 5 Then exclude(-1, 1) = True: exclude(0, 1) = True: exclude(1, 1) = True + For y_ = -1 To 1 + For x_ = -1 To 1 + If click_x + x_ >= 1 And click_x + x_ <= 4 And click_y + y_ >= 1 And click_y + y_ <= 5 Then + If case_main.status(click_x + x_ - 1, click_y + y_ - 1) <> 254 Then exclude(x_, y_) = True + End If + Next x_ + Next y_ + + print_now = True + 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) + If print_now = False Then Exit Sub + Form_main.Cls + Call Output_case(Form_main, case_main, output) + + 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 + + delta_x = Get_block_x(X) - click_x + delta_y = Get_block_y(Y) - click_y + + If Abs(delta_x) <> 0 Then delta_x = delta_x / Abs(delta_x) + If Abs(delta_y) <> 0 Then delta_y = delta_y / Abs(delta_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 + mouse_x = click_x + delta_x + mouse_y = click_y + delta_y + End If + End If + If Abs(delta_x) + Abs(delta_y) = 2 Then + If exclude(delta_x, 0) = True And exclude(0, delta_y) = False Then + mouse_y = click_y + delta_y + End If + If exclude(delta_x, 0) = False And exclude(0, delta_y) = True Then + mouse_x = click_x + delta_x + End If + 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 + mouse_x = click_x + delta_x + Else + mouse_y = click_y + delta_y + End If + End If + If exclude(delta_x, delta_y) = False And exclude(delta_x, 0) = False And exclude(0, delta_y) = False Then + mouse_x = click_x + delta_x + mouse_y = click_y + delta_y + End If + + End If + + print_x = (Get_min(click_x, mouse_x) - 1) * (output.square_width + output.gap) + output.gap + output.start_x ' 计算起始位置 + print_y = (Get_min(click_y, mouse_y) - 1) * (output.square_width + output.gap) + output.gap + output.start_y + + If Abs(click_x - mouse_x) = 1 Then + print_width = output.square_width * 2 + output.gap + Else + print_width = output.square_width + End If + If Abs(click_y - mouse_y) = 1 Then + print_height = output.square_width * 2 + output.gap + Else + print_height = output.square_width + End If + 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) + If print_now = False Then Exit Sub + print_now = False + Dim i As Integer, j As Integer, num As Integer + Dim empty_num As Integer + Dim block_x As Integer, block_y As Integer + Dim block_width As Integer, block_height As Integer + block_x = Get_min(click_x, mouse_x) - 1 + block_y = Get_min(click_y, mouse_y) - 1 + block_width = Abs(click_x - mouse_x) + 1 + block_height = Abs(click_y - mouse_y) + 1 + empty_num = 0 + If block_width = 2 And block_height = 2 Then + For i = 0 To 3 + For j = 0 To 4 + If case_main.status(i, j) = 254 Then empty_num = empty_num + 1 + Next j + Next i + If empty_num >= 6 Then + case_main.kind(0) = 0 + case_main.status(block_x, block_y) = 0 + case_main.status(block_x, block_y + 1) = 0 + case_main.status(block_x + 1, block_y) = 0 + case_main.status(block_x + 1, block_y + 1) = 0 + End If + ElseIf block_width = 2 And block_height = 1 Then + num = Get_empty_seat + For i = 0 To 3 + For j = 0 To 4 + If case_main.status(i, j) = 254 Then empty_num = empty_num + 1 + Next j + Next i + If num <> 0 And empty_num >= 4 Then + case_main.kind(num) = 1 + case_main.status(block_x, block_y) = num + case_main.status(block_x + 1, block_y) = num + End If + ElseIf block_width = 1 And block_height = 2 Then + num = Get_empty_seat + For i = 0 To 3 + For j = 0 To 4 + If case_main.status(i, j) = 254 Then empty_num = empty_num + 1 + Next j + Next i + If num <> 0 And empty_num >= 4 Then + case_main.kind(num) = 2 + case_main.status(block_x, block_y) = num + case_main.status(block_x, block_y + 1) = num + End If + ElseIf block_width = 1 And block_height = 1 Then + num = Get_empty_seat + For i = 0 To 3 + For j = 0 To 4 + If case_main.status(i, j) = 254 Then empty_num = empty_num + 1 + Next j + Next i + If num <> 0 And empty_num >= 3 Then + case_main.kind(num) = 3 + case_main.status(block_x, block_y) = num + End If + End If + Call Output_case(Form_main, case_main, output) +End Sub +Private Function Get_empty_seat() As Integer + Dim i As Integer + Get_empty_seat = 0 + For i = 1 To 14 + If case_main.kind(i) = 255 Then + Get_empty_seat = i + Exit For + End If + Next i +End Function +Private Function Get_min(dat_1 As Integer, dat_2 As Integer) As Integer + If dat_1 > dat_2 Then + Get_min = dat_2 + Else + Get_min = dat_1 + End If +End Function +Private Function Get_block_x(dat As Single) As Single ' 间隔上返回*.5 左越界返回0 右越界返回5 + dat = dat - output.start_x + Get_block_x = -1 + Dim i As Integer + For i = 1 To 4 + If dat > output.gap * i + output.square_width * (i - 1) And dat < (output.gap + output.square_width) * i Then Get_block_x = i + If dat >= (output.gap + output.square_width) * i And dat <= output.gap * (i + 1) + output.square_width * i Then Get_block_x = i + 0.5 + Next i + If dat > (output.gap + output.square_width) * 4 Then Get_block_x = 5 + If dat < output.gap Then Get_block_x = 0 + dat = dat + output.start_x +End Function +Private Function Get_block_y(dat As Single) As Single ' 间隔上返回*.5 上越界返回0 下越界返回6 + dat = dat - output.start_y + Get_block_y = -1 + Dim i As Integer + For i = 1 To 5 + If dat > output.gap * i + output.square_width * (i - 1) And dat < (output.gap + output.square_width) * i Then Get_block_y = i + If dat >= (output.gap + output.square_width) * i And dat <= output.gap * (i + 1) + output.square_width * i Then Get_block_y = i + 0.5 + Next i + If dat > (output.gap + output.square_width) * 5 Then Get_block_y = 6 + 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/Module.bas b/src/visual/Module.bas index 636657a..f328a1b 100644 --- a/src/visual/Module.bas +++ b/src/visual/Module.bas @@ -26,38 +26,38 @@ 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, x, 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 @@ -65,8 +65,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 @@ -77,20 +77,20 @@ Public Sub Print_Block(obj, print_start_x, print_start_y, print_width, print_hei obj.Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B End Sub Sub case_debug() - Dim x, y, i As Integer + 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 + 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 + ElseIf Parse_data.status(X, Y) = 255 Then debug_dat = debug_dat & "? " Else - debug_dat = debug_dat & change_str(Parse_data.status(x, y)) & " " + debug_dat = debug_dat & change_str(Parse_data.status(X, Y)) & " " End If - Next x + Next X debug_dat = debug_dat & vbCrLf - Next y + Next Y debug_dat = debug_dat & vbCrLf For i = 0 To 14 debug_dat = debug_dat & i & ": " & Parse_data.kind(i) & vbCrLf @@ -112,10 +112,58 @@ Function change_int(dat As String) As Integer ' 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 Parse_Code(code As String) As Boolean +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 X As Integer, Y As Integer Dim range(1 To 16) As Integer Parse_Code = False For i = 1 To 8 ' 编码后8位切割成16份 @@ -123,11 +171,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 @@ -138,21 +186,21 @@ 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 = 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 If range(num) <> 0 Then GoTo code_err ' 出现非0 编码错误 @@ -163,25 +211,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: