📄 dialog.frm
字号:
VERSION 5.00
Begin VB.Form Dialog_input
BorderStyle = 3 'Fixed Dialog
Caption = "字符输入"
ClientHeight = 2580
ClientLeft = 3390
ClientTop = 3255
ClientWidth = 6000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2580
ScaleWidth = 6000
Begin VB.ComboBox Combo_Y
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2880
TabIndex = 8
Text = "1"
Top = 1560
Width = 855
End
Begin VB.ComboBox Combo_X
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2880
TabIndex = 7
Text = "1"
Top = 1080
Width = 855
End
Begin VB.PictureBox Picture_print
BorderStyle = 0 'None
Height = 315
Left = 480
ScaleHeight = 315
ScaleWidth = 3600
TabIndex = 5
Top = 2160
Width = 3600
End
Begin VB.TextBox text_string
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 2
Text = "武汉市东湖高新创业园"
Top = 600
Width = 3255
End
Begin VB.CommandButton CancelButton
Cancel = -1 'True
Caption = "取消"
Height = 375
Left = 4440
TabIndex = 1
Top = 1200
Width = 1215
End
Begin VB.CommandButton OKButton
Caption = "确定"
Default = -1 'True
Height = 375
Left = 4440
TabIndex = 0
Top = 600
Width = 1215
End
Begin VB.Label Label1
Caption = "输入要更改的字符串内容："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 6
Top = 240
Width = 3015
End
Begin VB.Label Label_y
Caption = "屏幕垂直位置坐标："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 4
Top = 1680
Width = 2295
End
Begin VB.Label Label_x
Caption = "屏幕水平位置坐标："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 3
Top = 1200
Width = 2295
End
End
Attribute VB_Name = "Dialog_input"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mReturnValue As Byte '-----------------定义返回值，模块变量
Private Sub Form_Load()
Dim i As Byte
For i = 1 To 27
Combo_X.AddItem Str(i)
Next
For i = 1 To 14
Combo_Y.AddItem Str(i) '------------------------combo_y初始化
Next
mReturnValue = 0 '------------------------------设定初始返回值为0
End Sub
Private Sub OKButton_Click()
Dim send_string As String '----------------返回输入的字符串
send_string = text_string.Text
main.Label_show(label_index).Caption = send_string
If text_string.Enabled = True Then
Call GetOSDCode(OSD_code(), send_string)
End If
label_pos(label_index, 0) = val(Combo_X.Text)
label_pos(label_index, 1) = val(Combo_Y.Text)
mReturnValue = 1
Unload Me '-----------------------------------卸载并退出该对话框
End Sub
Private Sub CancelButton_Click()
mReturnValue = 0
Unload Me '-----------------------------------卸载并退出该对话框
End Sub
'================下面程序通过OSD_code()数组返回OSD显示的点阵代码==================================================
Function GetOSDCode(OSD_code() As Byte, ByVal mychar As String)
Dim wcode16() As Byte ' --------------Wcode16((17,block_len*12-1),存储采样后的点阵代码
Dim Wcode_frame() As Byte '-----------Wcode_frame(17,block_len*12-1)'存储加黑框后的点阵代码
Dim block_len As Byte
Call GetWordcodeCY(mychar, block_len, wcode16()) '-----获得字符点阵存于Wcode16(17,block_len*12-1)中，
'-----block_len-1为12*18点阵的个数
'-----在该函数内定义数据块的长度：block_len
Call add_frame(block_len, wcode16(), Wcode_frame()) '------- 将点阵信息wcode16()添加黑框后存于Wcode_frame
'Call OSD_show(Wcode_frame()) '------------------------------将12*18的点阵数据显示在屏幕上，测试实际显示效果
ReDim OSD_code(0 To block_len - 1, 53)
'Call OSDcode_tran(wcode16(), block_len, OSD_code()) '--将上述代码Wcode16()转化为OSD能够识别的54byte数据
'---存于OSD_code(block_len-1,53)中
Call OSDcode_tran(Wcode_frame(), block_len, OSD_code()) '--将上述代码Wcode_frame()转化为OSD能够识别的54byte数据
'--存于OSD_code(block_len-1,53)中
End Function
'=================================================================================================================
'==============以下三个函数用于获取OSD显示的54bytes点阵代码=======================================================
Function GetWordcodeCY(word As String, block_len As Byte, wcode16() As Byte)
'------ 将一个字串采样后保存到Wcode16(17,block_len*12-1)中，block_len为12*18点阵块的个数--------------------------
Dim X As Integer, Y As Integer
Dim row As Integer, lin As Integer
Dim color_value As Variant
Dim board As Integer
board = 20 '--------------------------设定picture_print边框大小，防止打印溢出导致采样不全
'------------控件Picture_print初始化------------------------------------------------------------------------------
Picture_print.FontName = "宋体"
Picture_print.FontSize = 12 '----------------字号设定为12时刚好对应系统的16点阵字库
Picture_print.ForeColor = RGB(0, 0, 0)
Picture_print.BackColor = RGB(255, 255, 255)
Picture_print.Visible = False
'------------控件Picture_print初始化完毕--------------------------------------------------------------------------
block_len = 14 ' (Picture_print.TextWidth(word) + 179) \ 180
ReDim wcode16(17, block_len * 12 - 1)
Picture_print.Width = 2400 + 2 * board '限制输入的字符最多为10个汉字，或20个字符
Picture_print.Height = Picture_print.TextHeight(word) + 2 * board
Picture_print.CurrentX = board
Picture_print.CurrentY = board
Picture_print.Visible = True
Picture_print.Print word
For lin = 0 To (block_len * 12 - 1)
wcode16(0, lin) = 1 '---------------------------最上一行初始化为透明点
wcode16(17, lin) = 1 '---------------------------最下一行初始化为透明点
Next lin
For row = 0 To 15
Y = board + 15 * row
For lin = 0 To (block_len * 12 - 1)
X = board + lin * 15
If Picture_print.Point(X, Y) = 0 Then
wcode16(row + 1, lin) = 2 '白色点
Else
wcode16(row + 1, lin) = 1 '透明点
End If
Next lin
Next row
Picture_print.Visible = False
End Function
Function add_frame(block_len As Byte, wcode16() As Byte, Wcode_frame() As Byte)
'----------将点阵信息wcode16(17,block_len*12-1)添加黑框后存于Wcode_frame(17,block_len*12-1)-----------------------
Dim val As Byte, row As Byte, lin As Byte
ReDim Wcode_frame(17, block_len * 12 - 1)
For row = 0 To 17
For lin = 0 To block_len * 12 - 1
If wcode16(row, lin) = 1 Then
val = 0
If row > 0 Then
val = val + wcode16(row - 1, lin) - 1 '---------正上
If lin > 0 Then
val = val + wcode16(row - 1, lin - 1) - 1 '-----左上
End If
If lin < block_len * 12 - 1 Then
val = val + wcode16(row - 1, lin + 1) - 1 '-----右上
End If
End If
If row < 17 Then
val = val + wcode16(row + 1, lin) - 1 '---------正下
If lin > 0 Then
val = val + wcode16(row + 1, lin - 1) - 1 '-----左下
End If
If lin < block_len * 12 - 1 Then
val = val + wcode16(row + 1, lin + 1) - 1 '----右下
End If
End If
If lin > 0 Then
val = val + wcode16(row, lin - 1) - 1 '----正左
End If
If lin < block_len * 12 - 1 Then
val = val + wcode16(row, lin + 1) - 1 '------正右
End If
If val <> 0 Then
Wcode_frame(row, lin) = 0
Else
Wcode_frame(row, lin) = 1
End If
Else
Wcode_frame(row, lin) = 2
End If
Next lin
Next row
End Function
Function OSDcode_tran(wcode16() As Byte, block_len As Byte, OSD_code() As Byte)
'将Wcode16(17,block_len*12-1)转换为适合OSD 显示的2bit对应一个像数的模式，存于OSD_code(num,53)中
Dim row As Byte, lin As Byte
Dim block() As Byte
Dim temp As Byte, num As Byte
ReDim block(block_len - 1, 17, 11)
For num = 0 To block_len - 1
For row = 0 To 17 '----------------------------------将Wcode16(17,block_len*12-1)分为18*12 的块缓存
For lin = 0 To 11
block(num, row, lin) = wcode16(row, num * 12 + lin)
Next
Next row
Next num
For num = 0 To block_len - 1 '-------------------------------数据分块转换
For row = 0 To 17
temp = 0
For lin = 0 To 3
temp = temp + block(num, row, lin) * (4 ^ (3 - lin))
Next
OSD_code(num, 3 * row) = temp
temp = 0
For lin = 4 To 7
temp = temp + block(num, row, lin) * (4 ^ (7 - lin))
Next
OSD_code(num, 3 * row + 1) = temp
temp = 0
For lin = 8 To 11
temp = temp + block(num, row, lin) * (4 ^ (11 - lin))
Next
OSD_code(num, 3 * row + 2) = temp
Next
Next num
End Function
'==============以上三个函数用于获取OSD显示的54bytes点阵代码=======================================================
'=================================================================================================================
'Function OSD_show(wcode16() As Byte) '-----------该函数用于测试点阵数据显示的实际效果，程序中不用
'Picture_show.Cls
'Picture_show.Scale (-1, -1)-(49, 19)
'For row = 0 To 17
'For lin = 0 To 47
'If wcode16(row, lin) = 2 Then
'Picture_show.Line (lin, row)-(lin + 1, row + 1), QBColor(15), BF
'ElseIf wcode16(row, lin) = 0 Then
'Picture_show.Line (lin, row)-(lin + 1, row + 1), QBColor(0), BF
'Else
'Picture_show.Line (lin, row)-(lin + 1, row + 1), QBColor(8), BF
'End If
'Next lin
'Next row
'End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -