add visual

4 years ago · 4ffd141d18
14 changed files with 305 additions and 0 deletions
--- a/src/engine/HRD_analy.cpp
+++ b/src/engine/HRD_analy.cpp
--- a/src/engine/HRD_analy.h
+++ b/src/engine/HRD_analy.h
--- a/src/engine/HRD_cal.cpp
+++ b/src/engine/HRD_cal.cpp
--- a/src/engine/HRD_cal.h
+++ b/src/engine/HRD_cal.h
--- a/src/engine/HRD_group.cpp
+++ b/src/engine/HRD_group.cpp
--- a/src/engine/HRD_group.h
+++ b/src/engine/HRD_group.h
--- a/src/engine/HRD_statistic.cpp
+++ b/src/engine/HRD_statistic.cpp
--- a/src/engine/HRD_statistic.h
+++ b/src/engine/HRD_statistic.h
--- a/src/engine/main.cpp
+++ b/src/engine/main.cpp
--- a/src/visual/Form_main.frm
+++ b/src/visual/Form_main.frm
@ -0,0 +1,77 @@
+VERSION 5.00
+Begin VB.Form Form_main 
+   AutoRedraw      =   -1  'True
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "HRD Visual v0.0 by Dnomd343"
+   ClientHeight    =   6585
+   ClientLeft      =   45
+   ClientTop       =   390
+   ClientWidth     =   4830
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   6585
+   ScaleWidth      =   4830
+   StartUpPosition =   2  '屏幕中心
+   Begin VB.CommandButton Command_Print 
+      Caption         =   "解译编码"
+      Height          =   465
+      Left            =   3180
+      TabIndex        =   1
+      Top             =   5940
+      Width           =   975
+   End
+   Begin VB.TextBox Text_Code 
+      Alignment       =   2  'Center
+      BeginProperty Font 
+         Name            =   "微软雅黑"
+         Size            =   15.75
+         Charset         =   134
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   465
+      Left            =   1200
+      TabIndex        =   0
+      Text            =   "4FEA13400"
+      Top             =   5955
+      Width           =   2040
+   End
+End
+Attribute VB_Name = "Form_main"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Dim output As Case_size
+Dim case_main As Case_detail
+Private Sub Form_Load()
+  Call Parse_Code("4FEA13400")
+  case_main = Parse_data
+  output.start_x = 150
+  output.start_y = 150
+  output.square_width = 1000
+  output.gap = 100
+  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)
+  Call Output_case(Form_main, case_main, output)
+End Sub
+Private Sub Command_Print_Click()
+  If Len(Text_Code) <> 9 Then MsgBox "编码有误", , "提示": Exit Sub
+  If Parse_Code(Text_Code) = True Then
+    case_main = Parse_data
+    Call Output_case(Form_main, case_main, output)
+  Else
+    MsgBox "编码有误", , "提示"
+  End If
+End Sub
+Private Sub Text_Code_KeyPress(KeyAscii As Integer)
+  If KeyAscii = 13 Then Call Command_Print_Click
+End Sub
--- a/src/visual/HRD_Visual.vbp
+++ b/src/visual/HRD_Visual.vbp
@ -0,0 +1,31 @@
+Type=Exe
+Form=Form_main.frm
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation
+Module=Module; Module.bas
+IconForm="Form_main"
+Startup="Sub Main"
+HelpFile=""
+Command32=""
+Name="HRD_Visual"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
--- a/src/visual/HRD_Visual.vbw
+++ b/src/visual/HRD_Visual.vbw
@ -0,0 +1,2 @@
+Form_main = 52, 52, 810, 479, Z, 26, 26, 784, 453, C
+Module = 134, 45, 892, 472, 
--- a/src/visual/MSSCCPRJ.SCC
+++ b/src/visual/MSSCCPRJ.SCC
@ -0,0 +1,5 @@
+[SCC]
+SCC=This is a source code control file
+[HRD_Visual.vbp]
+SCC_Project_Name=this project is not under source code control
+SCC_Aux_Path=<This is an empty string for the mssccprj.scc file>
--- a/src/visual/Module.bas
+++ b/src/visual/Module.bas
@ -0,0 +1,190 @@
+Attribute VB_Name = "Module"
+Option Explicit
+Type Case_detail
+  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
+  start_x As Integer
+  start_y As Integer
+  square_width As Integer
+  gap As Integer
+End Type
+Type Case_style
+  block_line_width As Integer
+  case_line_width As Integer
+  block_line_color As OLE_COLOR
+  case_line_color As OLE_COLOR
+  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()
+  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 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
+  ' 显示主框架
+  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)) ' 得到块的类型
+        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
+        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 ' 设置为已发现
+        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 ' 设置为已发现
+        ElseIf block_type = 3 Then ' 1 * 1
+          print_width = case_output.square_width
+          print_height = case_output.square_width
+        End If
+        ' 显示找到的块
+        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
+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
+  obj.FillStyle = 0
+  obj.DrawWidth = print_line_width
+  obj.FillColor = print_color
+  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)
+  ElseIf dat >= 10 And dat <= 15 Then
+    change_str = Chr(dat + 55)
+  Else
+    change_str = "-"
+  End If
+  change_str = Trim(change_str)
+End Function
+Function change_int(dat As String) As Integer ' 输入一个十六进制位字符串 转化为int返回
+  If Asc(dat) >= 48 And Asc(dat) <= 57 Then change_int = Int(dat) ' 0 - 9
+  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
+  Dim space_num As Integer
+  Dim i As Integer, num 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份
+    num = change_int(Mid(code, i + 1, 1)) ' 取第i位并转为数字
+    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 i = 0 To 14 ' 初始化kind
+    Parse_data.kind(i) = 255
+  Next i
+  num = 0
+  For i = 1 To 16 ' 统计序列中0的个数
+    If range(i) = 0 Then num = num + 1
+  Next i
+  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
+  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
+  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个空位 越界
+          If space_num < 2 Then GoTo code_err ' 空格低于两个 出错
+          For num = i To 15 ' 检查余下编码是否为0
+            If range(num) <> 0 Then GoTo code_err ' 出现非0 编码错误
+          Next num
+          GoTo code_right ' 全为0 编码正确
+        End If
+      End If
+    Wend
+    If range(i) = 0 Then ' space
+      space_num = space_num + 1
+      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 ' 方块重叠
+      num = num + 1
+      Parse_data.kind(num) = 1
+      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 ' 方块重叠
+      num = num + 1
+      Parse_data.kind(num) = 2
+      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
+    End If
+  Next i
+code_right:
+  Parse_Code = True
+code_err:
+End Function