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
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 339
      src/visual/Form_main.frm
  2. 55
      src/visual/Module.bas

339
src/visual/Form_main.frm
View File

@ -2,7 +2,7 @@ VERSION 5.00
Begin VB.Form Form_main Begin VB.Form Form_main
AutoRedraw = -1 'True AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single BorderStyle = 1 'Fixed Single
Caption = "HRD Visual v0.1 by Dnomd343" Caption = "HRD Visual v0.2 by Dnomd343"
ClientHeight = 6585 ClientHeight = 6585
ClientLeft = 45 ClientLeft = 45
ClientTop = 390 ClientTop = 390
@ -13,6 +13,14 @@ Begin VB.Form Form_main
ScaleHeight = 6585 ScaleHeight = 6585
ScaleWidth = 9390 ScaleWidth = 9390
StartUpPosition = 2 'ÆÁÄ»ÖÐÐÄ StartUpPosition = 2 'ÆÁÄ»ÖÐÐÄ
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 360
Left = 5820
TabIndex = 4
Top = 5925
Width = 840
End
Begin VB.Timer Timer1 Begin VB.Timer Timer1
Interval = 100 Interval = 100
Left = 8280 Left = 8280
@ -67,18 +75,22 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Dim print_now As Boolean Dim print_now As Boolean ' 标记当前是否正处于绘制状态
Dim click_x As Integer, click_y As Integer 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 click_x_ As Integer, click_y_ As Integer ' 记录按下位置的窗体坐标
Dim mouse_x As Integer, mouse_y As Integer Dim mouse_x As Integer, mouse_y As Integer ' 记录当前鼠标位置合法对应的棋盘编号
Dim output As Case_size Dim output As Case_size ' 输出大小
Dim case_main As Case_detail Dim case_main As Case_detail ' 布局信息
Dim exclude(-1 To 1, -1 To 1) As Boolean Dim exclude(-1 To 1, -1 To 1) As Boolean ' 记录按下位置周围是否能放置棋子 true -> 不难 / false -> 能
Private Sub Command_Get_Code_Click() Private Sub Command_Get_Code_Click()
Text_Code = Get_Code(case_main) Text_Code = Get_Code(case_main)
End Sub End Sub
Private Sub Command1_Click()
MsgBox Check_2x2_seat
End Sub
Private Sub Form_Load() Private Sub Form_Load()
print_now = False print_now = False
Dim i As Integer, j As Integer Dim i As Integer, j As Integer
@ -90,13 +102,10 @@ Private Sub Form_Load()
case_main.status(i, j) = 254 case_main.status(i, j) = 254
Next j Next j
Next i Next i
'Call Parse_Code("4FEA13400")
'Call Parse_Code("5000300C0")
'case_main = Parse_data
output.start_x = 150 output.start_x = 150
output.start_y = 150 output.start_y = 150
'output.start_x = 0
'output.start_y = 0
output.square_width = 1000 output.square_width = 1000
output.gap = 100 output.gap = 100
style.block_line_width = 1 style.block_line_width = 1
@ -124,210 +133,244 @@ Private Sub Command_Print_Click()
End If End If
End Sub 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) ' 按下鼠标按键
Dim x_ As Integer, y_ As Integer Dim x_ As Integer, y_ As Integer, num As Integer
Dim block_x As Single, block_y As Single Dim raw_x As Single, raw_y As Single
Dim addr_x As Integer, addr_y As Integer
block_x = Get_block_x(X) Dim clear As Boolean
block_y = Get_block_y(Y) clear = False
raw_x = Get_block_x(X) ' 得到点击位置在棋盘上的编号
If Int(block_x) <> block_x Then Exit Sub raw_y = Get_block_y(Y)
If Int(block_y) <> block_y Then Exit Sub If raw_x < 1 Or raw_x > 4 Or raw_y < 1 Or raw_y > 5 Then Exit Sub ' 点击在棋盘外 退出
If block_x < 1 Or block_x > 4 Then Exit Sub addr_x = Int(raw_x) - 1 ' 若点击位置为间隙则映射到其左/上方
If block_y < 1 Or block_y > 5 Then Exit Sub addr_y = Int(raw_y) - 1
click_x = block_x num = case_main.status(addr_x, addr_y) ' 得到编号或254
click_y = block_y If num <> 254 Then ' 该位置不为空
click_x_ = X If Int(raw_x) <> raw_x And Int(raw_y) <> raw_y Then ' 若处在两间隙相交处
click_y_ = Y 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 case_main.status(click_x - 1, click_y - 1) <> 254 Then Exit Sub 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 y_ = -1 To 1
For x_ = -1 To 1 For x_ = -1 To 1
exclude(x_, y_) = False exclude(x_, y_) = False ' 全部初始化为可放置
Next x_ Next x_
Next y_ 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 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 = 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_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 = 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 click_y = 5 Then exclude(-1, 1) = True: exclude(0, 1) = True: exclude(1, 1) = True
For y_ = -1 To 1 For y_ = -1 To 1
For x_ = -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 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 case_main.status(click_x + x_ - 1, click_y + y_ - 1) <> 254 Then exclude(x_, y_) = True ' 不为空的标记为不可放置
End If End If
Next x_ Next x_
Next y_ Next y_
print_now = True ' 进入绘制模式
print_now = True Call Form_MouseMove(Button, Shift, X, Y) ' 发起鼠标移动事件
Call Form_MouseMove(Button, Shift, X, Y)
End Sub 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) ' 移动鼠标
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 delta_x As Integer, delta_y As Integer
Dim print_x As Integer, print_y As Integer Dim print_x As Integer, print_y As Integer
Dim print_width As Integer, print_height As Integer Dim print_width As Integer, print_height As Integer
If print_now = False Then Exit Sub ' 判断是否在绘制模式
delta_x = Get_block_x(X) - click_x Call Output_case(Form_main, case_main, output) ' 覆盖上一次的显示
delta_y = Get_block_y(Y) - click_y delta_x = signed(Get_block_x(X) - click_x) ' 记录鼠标位置与点击位置的相对方向
delta_y = signed(Get_block_y(Y) - click_y)
If Abs(delta_x) <> 0 Then delta_x = delta_x / Abs(delta_x) mouse_x = click_x: mouse_y = click_y ' 默认
If Abs(delta_y) <> 0 Then delta_y = delta_y / Abs(delta_y) If Abs(delta_x) + Abs(delta_y) = 1 Then ' 如果在上下左右
If exclude(delta_x, delta_y) = False Then ' 目标位置可放置棋子
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_x = click_x + delta_x
mouse_y = click_y + delta_y mouse_y = click_y + delta_y
End If End If
End If End If
If Abs(delta_x) + Abs(delta_y) = 2 Then If Abs(delta_x) + Abs(delta_y) = 2 Then ' 如果在斜对角
If exclude(delta_x, 0) = True And exclude(0, delta_y) = False Then If exclude(delta_x, 0) = True And exclude(0, delta_y) = False Then mouse_y = click_y + delta_y ' 若侧边被挡到
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
End If If exclude(delta_x, delta_y) = True And exclude(delta_x, 0) = False And exclude(0, delta_y) = False Then ' 若斜角不可放置而两边是空的
If exclude(delta_x, 0) = False And exclude(0, delta_y) = True Then If Abs(click_x_ - X) > Abs(click_y_ - Y) Then ' x轴方向位移较大
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 mouse_x = click_x + delta_x
Else Else ' y轴方向位移较大
mouse_y = click_y + delta_y mouse_y = click_y + delta_y
End If End If
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_x = click_x + delta_x
mouse_y = click_y + delta_y mouse_y = click_y + delta_y
End If End If
End If End If
print_x = (min(click_x, mouse_x) - 1) * (output.square_width + output.gap) + output.gap + output.start_x ' 计算绘制起始位置
print_x = (Get_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
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 ' 计算绘制宽度
If Abs(click_y - mouse_y) = 1 Then print_height = output.square_width * 2 + output.gap Else print_height = output.square_width ' 计算绘制高度
If Abs(click_x - mouse_x) = 1 Then 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_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 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)
If print_now = False Then Exit Sub
print_now = False
Dim i As Integer, j As Integer, num As Integer 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_x As Integer, block_y As Integer
Dim block_width As Integer, block_height As Integer Dim block_width As Integer, block_height As Integer
block_x = Get_min(click_x, mouse_x) - 1 If print_now = False Then Exit Sub ' 判断是否在绘制模式
block_y = Get_min(click_y, mouse_y) - 1 print_now = False ' 退出绘制模式
block_width = Abs(click_x - mouse_x) + 1 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 block_height = Abs(click_y - mouse_y) + 1
empty_num = 0 If block_width = 2 And block_height = 2 Then ' 绘制的棋子是2 * 2
If block_width = 2 And block_height = 2 Then If Get_empty_num >= 6 Then ' 当前至少有6个空位
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.kind(0) = 0
case_main.status(block_x, block_y) = 0 case_main.status(block_x, block_y) = 0
case_main.status(block_x, block_y + 1) = 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) = 0
case_main.status(block_x + 1, block_y + 1) = 0 case_main.status(block_x + 1, block_y + 1) = 0
End If 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 num = Get_empty_seat
For i = 0 To 3 If num <> 0 And Get_empty_num >= 4 Then ' 当前棋子数未到上限且至少存在4个空位
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.kind(num) = 1
case_main.status(block_x, block_y) = num case_main.status(block_x, block_y) = num
case_main.status(block_x + 1, 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 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 num = Get_empty_seat
For i = 0 To 3 If num <> 0 And Get_empty_num >= 4 Then ' 当前棋子数未到上限且至少存在4个空位
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.kind(num) = 2
case_main.status(block_x, block_y) = num case_main.status(block_x, block_y) = num
case_main.status(block_x, block_y + 1) = 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 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 num = Get_empty_seat
For i = 0 To 3 If num <> 0 And Get_empty_num >= 3 Then ' 当前棋子数未到上限且至少存在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.kind(num) = 3
case_main.status(block_x, block_y) = num 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
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 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 Dim i As Integer
Get_empty_seat = 0 Get_empty_seat = 0
For i = 1 To 14 For i = 1 To 14
If case_main.kind(i) = 255 Then If case_main.kind(i) = 255 Then ' 该位置暂未定义
Get_empty_seat = i Get_empty_seat = i
Exit For Exit For
End If End If
Next i Next i
End Function End Function
Private Function Get_min(dat_1 As Integer, dat_2 As Integer) As Integer Private Function signed(dat As Single) ' 得到符号 返回-1 / 0 / 1
If dat_1 > dat_2 Then If Abs(dat) <> 0 Then signed = dat / Abs(dat) Else signed = 0
Get_min = dat_2 End Function
Else Private Function min(dat_1 As Integer, dat_2 As Integer) As Integer ' 返回较小的值
Get_min = dat_1 If dat_1 > dat_2 Then min = dat_2 Else min = dat_1
End If 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 End Function
Private Function Get_block_x(dat As Single) As Single ' 间隔上返回*.5 左越界返回0 右越界返回5 Private Function Get_block_x(dat As Single) As Single ' 计算鼠标位置所在对应棋盘上的横坐标 间隔上返回*.5 左越界返回0 右越界返回5
dat = dat - output.start_x dat = dat - output.start_x ' 去除起始偏移
Get_block_x = -1
Dim i As Integer Dim i As Integer
For i = 1 To 4 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 * 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 + output.square_width) * i And dat <= output.gap * (i + 1) + output.square_width * i Then Get_block_x = i + 0.5 ' 点击在棋子间隔
Next i Next i
If dat > (output.gap + output.square_width) * 4 Then Get_block_x = 5 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 Then Get_block_x = 0 ' 左越界
dat = dat + output.start_x dat = dat + output.start_x
End Function End Function
Private Function Get_block_y(dat As Single) As Single ' 间隔上返回*.5 上越界返回0 下越界返回6 Private Function Get_block_y(dat As Single) As Single ' 计算鼠标位置所在对应棋盘上的纵坐标 间隔上返回*.5 上越界返回0 下越界返回6
dat = dat - output.start_y dat = dat - output.start_y ' 去除起始偏移
Get_block_y = -1
Dim i As Integer Dim i As Integer
For i = 1 To 5 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 * 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 + output.square_width) * i And dat <= output.gap * (i + 1) + output.square_width * i Then Get_block_y = i + 0.5 ' 点击在棋子间隔
Next i Next i
If dat > (output.gap + output.square_width) * 5 Then Get_block_y = 6 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 Then Get_block_y = 0 ' 上越界
dat = dat + output.start_y dat = dat + output.start_y
End Function End Function

55
src/visual/Module.bas
View File

@ -1,17 +1,17 @@
Attribute VB_Name = "Module" Attribute VB_Name = "Module"
Option Explicit Option Explicit
Type Case_detail 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 kind(0 To 14) As Integer ' 0 -> 2 * 2 ; 1 -> 2 * 1 ; 2 -> 1 * 2 ; 3 -> 1 * 1
code As String ' length -> 9 code As String ' length -> 9
End Type End Type
Type Case_size Type Case_size ' 记录棋盘的大小
start_x As Integer start_x As Integer
start_y As Integer start_y As Integer
square_width As Integer square_width As Integer
gap As Integer gap As Integer
End Type End Type
Type Case_style Type Case_style ' 记录显示的颜色与边框粗细
block_line_width As Integer block_line_width As Integer
case_line_width As Integer case_line_width As Integer
block_line_color As OLE_COLOR block_line_color As OLE_COLOR
@ -19,12 +19,32 @@ Type Case_style
block_color As OLE_COLOR block_color As OLE_COLOR
case_color As OLE_COLOR case_color As OLE_COLOR
End Type End Type
Public Parse_data As Case_detail Public Parse_data As Case_detail ' 解析编码的返回数据
Public style As Case_style Public style As Case_style ' 通用显示样式
Sub main() ' 程序入口
Sub main()
Form_main.Show Form_main.Show
End Sub 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上 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 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_color, B
obj.Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_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 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 ' 输入一个十六进制位 转化为字符串返回 Function change_str(dat As Integer) As String ' 输入一个十六进制位 转化为字符串返回
If dat <= 9 And dat >= 0 Then If dat <= 9 And dat >= 0 Then
change_str = Str(dat) change_str = Str(dat)

Write Preview
Loading…
Cancel
Save