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 5 years ago
parent
2e41222987
commit
9ff6b2556e
2 changed files with 218 additions and 176 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. 337
      src/visual/Form_main.frm
  2. 55
      src/visual/Module.bas

337
src/visual/Form_main.frm
View File

@ -2,7 +2,7 @@ VERSION 5.00
Begin VB.Form Form_main
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "HRD Visual v0.1 by Dnomd343"
Caption = "HRD Visual v0.2 by Dnomd343"
ClientHeight = 6585
ClientLeft = 45
ClientTop = 390
@ -13,6 +13,14 @@ Begin VB.Form Form_main
ScaleHeight = 6585
ScaleWidth = 9390
StartUpPosition = 2 'ÆÁÄ»ÖÐÐÄ
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 360
Left = 5820
TabIndex = 4
Top = 5925
Width = 840
End
Begin VB.Timer Timer1
Interval = 100
Left = 8280
@ -67,18 +75,22 @@ 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
Dim print_now As Boolean ' 标记当前是否正处于绘制状态
Dim click_x As Integer, click_y As Integer ' 记录按下位置对应的棋盘编号 click_x -> 1 ~ 4 / click_y -> 1 ~ 5
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 ' 记录按下位置周围是否能放置棋子 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()
print_now = False
Dim i As Integer, j As Integer
@ -90,13 +102,10 @@ Private Sub Form_Load()
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
@ -124,210 +133,244 @@ Private Sub Command_Print_Click()
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
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' 按下鼠标按键
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)
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
num = case_main.status(addr_x, addr_y) ' 得到编号或254
If num <> 254 Then ' 该位置不为空
If Int(raw_x) <> raw_x And Int(raw_y) <> raw_y Then ' 若处在两间隙相交处
If num = 0 And Get_addr_x(num) = addr_x And Get_addr_y(num) = addr_y Then clear = True ' 判断是否点击在2 * 2块正中央
ElseIf Int(raw_x) <> raw_x Then ' 若处在纵向间隙
If Get_addr_x(num) = addr_x Then '判断是否点击是否在棋子上
If case_main.kind(num) = 0 Or case_main.kind(num) = 1 Then clear = True
End If
ElseIf Int(raw_y) <> raw_y Then ' 若处在横向间隙
If Get_addr_y(num) = addr_y Then '判断是否点击是否在棋子上
If case_main.kind(num) = 0 Or case_main.kind(num) = 2 Then clear = True
End If
Else ' 不处在间隙
clear = True
End If
End If
If clear = True Then ' 若被标识为点击在棋子上
Call Clear_block(num) ' 清除该棋子
Call Output_case(Form_main, case_main, output) ' 刷新显示界面
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 ' 记录点击的真实位置
num = case_main.status(click_x - 1, click_y - 1) ' 点击位置对应的编码
For y_ = -1 To 1
For x_ = -1 To 1
exclude(x_, y_) = False
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
If case_main.kind(0) <> 255 Then exclude(-1, -1) = True: exclude(-1, 1) = True: exclude(1, -1) = True: exclude(1, 1) = True ' 若2 * 2块已存在 则四角都标记为不可放置
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
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)
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)
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
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
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)
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
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 ' 若侧边被挡到
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轴方向位移较大
mouse_x = click_x + delta_x
Else
Else ' y轴方向位移较大
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
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)
print_x = (min(click_x, mouse_x) - 1) * (output.square_width + output.gap) + output.gap + output.start_x ' 计算绘制起始位置
print_y = (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 ' 计算绘制宽度
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)
If print_now = False Then Exit Sub
print_now = False
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 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
If print_now = False Then Exit Sub ' 判断是否在绘制模式
print_now = False ' 退出绘制模式
block_x = min(click_x, mouse_x) - 1 ' 计算绘制棋子的起始位置
block_y = 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
If block_width = 2 And block_height = 2 Then ' 绘制的棋子是2 * 2
If Get_empty_num >= 6 Then ' 当前至少有6个空位
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
ElseIf block_width = 2 And block_height = 1 Then ' 绘制的棋子是2 * 1
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
If num <> 0 And Get_empty_num >= 4 Then ' 当前棋子数未到上限且至少存在4个空位
case_main.kind(num) = 1
case_main.status(block_x, block_y) = num
case_main.status(block_x + 1, block_y) = num
If case_main.kind(0) <> 0 And Check_2x2_seat = False Then Call Clear_block(num)
End If
ElseIf block_width = 1 And block_height = 2 Then
ElseIf block_width = 1 And block_height = 2 Then ' 绘制的棋子是1 * 2
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
If num <> 0 And Get_empty_num >= 4 Then ' 当前棋子数未到上限且至少存在4个空位
case_main.kind(num) = 2
case_main.status(block_x, block_y) = num
case_main.status(block_x, block_y + 1) = num
If case_main.kind(0) <> 0 And Check_2x2_seat = False Then Call Clear_block(num)
End If
ElseIf block_width = 1 And block_height = 1 Then
ElseIf block_width = 1 And block_height = 1 Then ' 绘制的棋子是1 * 1
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
If num <> 0 And Get_empty_num >= 3 Then ' 当前棋子数未到上限且至少存在3个空位
case_main.kind(num) = 3
case_main.status(block_x, block_y) = num
If case_main.kind(0) <> 0 And Check_2x2_seat = False Then Call Clear_block(num)
End If
End If
Call Output_case(Form_main, case_main, output)
Call Output_case(Form_main, case_main, output) ' 刷新显示界面
End Sub
Private Sub Clear_block(num As Integer) ' 根据编号清空棋子信息
Dim addr_x As Integer, addr_y As Integer
addr_x = Get_addr_x(num) ' 得到棋子左上角位置
addr_y = Get_addr_y(num)
If case_main.kind(num) = 0 Then ' 2 * 2
case_main.kind(num) = 255
case_main.status(addr_x, addr_y) = 254
case_main.status(addr_x, addr_y + 1) = 254
case_main.status(addr_x + 1, addr_y) = 254
case_main.status(addr_x + 1, addr_y + 1) = 254
ElseIf case_main.kind(num) = 1 Then ' 2 * 1
case_main.kind(num) = 255
case_main.status(addr_x, addr_y) = 254
case_main.status(addr_x + 1, addr_y) = 254
ElseIf case_main.kind(num) = 2 Then ' 1 * 2
case_main.kind(num) = 255
case_main.status(addr_x, addr_y) = 254
case_main.status(addr_x, addr_y + 1) = 254
ElseIf case_main.kind(num) = 3 Then ' 1 * 1
case_main.kind(num) = 255
case_main.status(addr_x, addr_y) = 254
End If
End Sub
Private Function Get_empty_seat() As Integer
Private Function Check_2x2_seat() As Boolean
Dim i As Integer, j As Integer
Check_2x2_seat = False
'If case_main.kind(0) = 0 Then Exit Function
For j = 0 To 3
For i = 0 To 2
If case_main.status(i, j) = 254 And case_main.status(i, j + 1) = 254 And case_main.status(i + 1, j) = 254 And case_main.status(i + 1, j + 1) = 254 Then Check_2x2_seat = True
Next i
Next j
End Function
Private Function Get_empty_num() As Integer ' 统计当前空位数量
Dim i As Integer, j As Integer
Get_empty_num = 0
For i = 0 To 3
For j = 0 To 4
If case_main.status(i, j) = 254 Then Get_empty_num = Get_empty_num + 1
Next j
Next i
End Function
Private Function Get_empty_seat() As Integer ' 在case_main.kind中找到空位
Dim i As Integer
Get_empty_seat = 0
For i = 1 To 14
If case_main.kind(i) = 255 Then
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
Private Function signed(dat As Single) ' 得到符号 返回-1 / 0 / 1
If Abs(dat) <> 0 Then signed = dat / Abs(dat) Else signed = 0
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 Function Get_addr_x(num As Integer) As Integer ' 找到编号的左上角x坐标 编号为不存在则返回255
Dim i As Integer, j As Integer
Get_addr_x = 255
For j = 0 To 4
For i = 0 To 3
If case_main.status(i, j) = num Then
Get_addr_x = i
Exit Function
End If
Next i
Next j
End Function
Private Function Get_addr_y(num As Integer) As Integer ' 找到编号的左上角y坐标 编号为不存在则返回255
Dim i As Integer, j As Integer
Get_addr_y = 255
For j = 0 To 4
For i = 0 To 3
If case_main.status(i, j) = num Then
Get_addr_y = j
Exit Function
End If
Next i
Next j
End Function
Private Function Get_block_x(dat As Single) As Single ' 间隔上返回*.5 左越界返回0 右越界返回5
dat = dat - output.start_x
Get_block_x = -1
Private Function Get_block_x(dat As Single) As Single ' 计算鼠标位置所在对应棋盘上的横坐标 间隔上返回*.5 左越界返回0 右越界返回5
dat = dat - output.start_x ' 去除起始偏移
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
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
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
Private Function Get_block_y(dat As Single) As Single ' 计算鼠标位置所在对应棋盘上的纵坐标 间隔上返回*.5 上越界返回0 下越界返回6
dat = dat - output.start_y ' 去除起始偏移
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
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
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

55
src/visual/Module.bas
View File

@ -1,17 +1,17 @@
Attribute VB_Name = "Module"
Option Explicit
Type Case_detail
status(0 To 3, 0 To 4) As Integer '255 -> undefined ; 254 -> space
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
Type Case_size ' 记录棋盘的大小
start_x As Integer
start_y As Integer
square_width As Integer
gap As Integer
End Type
Type Case_style
Type Case_style ' 记录显示的颜色与边框粗细
block_line_width As Integer
case_line_width As Integer
block_line_color As OLE_COLOR
@ -19,12 +19,32 @@ Type Case_style
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()
Public Parse_data As Case_detail ' 解析编码的返回数据
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 block_type As Integer
@ -76,27 +96,6 @@ 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_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
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
Function change_str(dat As Integer) As String ' 输入一个十六进制位 转化为字符串返回
If dat <= 9 And dat >= 0 Then
change_str = Str(dat)

Write Preview
Loading…
Cancel
Save