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
70e1dedfdc
commit
02860c38b0
2 changed files with 390 additions and 62 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. 290
      src/visual/Form_main.frm
  2. 162
      src/visual/Module.bas

290
src/visual/Form_main.frm
View File

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

162
src/visual/Module.bas
View File

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

Write Preview
Loading…
Cancel
Save