📄 main.frm
字号:
Picture = "main.frx":0AB8
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "main.frx":1792
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "main.frx":1AAC
Key = "Help"
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar
Height = 390
Left = 0
TabIndex = 13
Top = 0
Width = 1800
_ExtentX = 3175
_ExtentY = 688
ButtonWidth = 609
ButtonHeight = 582
Appearance = 1
ImageList = "imlToolbarIcons"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 5
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "open"
Object.ToolTipText = "打开"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "save"
Object.ToolTipText = "保存"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "time"
Object.ToolTipText = "时间校准"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "date"
Object.ToolTipText = "日期校准"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "video"
Object.ToolTipText = "视屏切换"
ImageIndex = 5
EndProperty
EndProperty
End
Begin VB.Menu files
Caption = "文件（&F）"
Begin VB.Menu file
Caption = "打开(&O)"
Index = 0
End
Begin VB.Menu file
Caption = "保存(&S)"
Index = 1
End
Begin VB.Menu file
Caption = "关闭(&X)"
Index = 2
End
End
Begin VB.Menu edit
Caption = "编辑(&E)"
End
Begin VB.Menu help
Caption = "帮助(&H)"
End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===========定义不同窗体交换数据的全局变量========================================
Dim send_times As Byte, Link_times As Byte '---定义发送次数和链接次数变量
Dim Link_success As Boolean '------------------链接成功标志位
Dim send_buffer() As Byte '--------------------缓存当前需要发送的数据块
Dim NUM_blockall As Integer '-----------------标志当前一共要发送的数据块个数
Dim channel As Integer '-----------------------标记当前是第几路视屏
'-------------定义命令参数---------------------------------------------------------------
Dim RLI(0) As Byte, ACK As Byte, NAK As Byte
Dim POSCOM As Byte, WORDCOM As Byte, TIMECOM As Byte, DATECOM As Byte, CHANNELCOM As Byte
'-------------定义命令参数---------------------------------------------------------------
Dim xp As Single
Dim yp As Single
Private Sub Form_Load()
'-------定义命令字
RLI(0) = &HFF
ACK = &HFF
NAK = 75
CHANNELCOM = &H5
DATECOM = &H4
TIMECOM = &H3
POSCOM = &H2
WORDCOM = &H1
Call initall '调用初始化函数
End Sub
'=============================================================================================================
'---------------------更新状态栏信息
Private Sub Picture_back_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
StatusBar.Panels(1) = ""
End Sub
Private Sub Timer_settime_Timer() '------------------------显示时间,日期，与下位机无关
Label_show(1).Caption = Str(Hour(Time)) + ":" + Str(Minute(Time)) + ":" + Str(Second(Time))
Label_show(0).Caption = Str(Year(Date)) + "/" + Str(Month(Date)) + "/" + Str(Day(Date))
Label_show(6).Caption = Label_show(1).Caption 'Str(Hour(Time)) + ":" + Str(Minute(Time)) + ":" + Str(Second(Time))
Label_show(5).Caption = Label_show(0).Caption 'Str(Year(Date)) + "/" + Str(Month(Date)) + "/" + Str(Day(Date))
End Sub
'============菜单栏相关操作=========================================================================================
Private Sub file_Click(Index As Integer)
Select Case Index
Case 0
Unload Me
End Select
End Sub
'===================================================================================================================
'----------------------------工具栏相关操作函数---------------------------------------------------------------------
Private Sub Toolbar_ButtonClick(ByVal Button As MSComCtlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "open"
'应做:添加 '打开' 按钮代码。
MsgBox "添加 '打开' 按钮代码。"
Case "save"
'应做:添加 '保存' 按钮代码。
MsgBox "添加 '保存' 按钮代码。"
Case "time"
'应做:添加 '时间' 按钮代码。
Call send_time(1 + 5 * channel)
Case "date"
Call send_date(5 * channel)
Case "video"
'应做:添加 '时间' 按钮代码。
Call channel_change
Case "help"
'应做:添加 '按钮' 按钮代码。
MsgBox "添加 '按钮' 按钮代码。"
End Select
End Sub
'===================================================================================================
'==============工具栏相关函数=======================================================================
Function setting_time() '---------------------发送系统时间
Dim time_code(6) As Byte
time_code(0) = TIMECOM '----------------------写待发送数据的命令
time_code(1) = CByte(Second(Time)) '----------写数据秒
time_code(2) = CByte(Minute(Time)) '----------写数据分
time_code(3) = CByte(Hour(Time)) '------------写数据时
time_code(4) = CByte(Day(Date)) '-------------写数据日
time_code(5) = CByte(Month(Date)) '-----------写数据月
If Year(Date) < 2100 And Year(Date) >= 2000 Then
time_code(6) = CByte(CInt(Year(Date)) - 2000) '--写数据年，取年的后两位
End If
Call send_state(time_code(), 7)
End Function
Function channel_change() '--------------------切换视屏通道
Dim channel_code(1) As Byte
If channel = 0 Then
channel = 1
For i = 0 To 4
Label_show(i).Visible = False '-------------视屏1不可见
Label_show(i + 5).Visible = True '----------视屏2可见
Next
Else
channel = 0
For i = 0 To 4
Label_show(i).Visible = True '--------------视屏1可见
Label_show(i + 5).Visible = False '---------视屏2可见
Next
End If
channel_code(0) = CHANNELCOM '-----------------写待发送的数据命令
channel_code(1) = channel '--------------------设定数据通道
Call send_state(channel_code(), 2) '-----------发送数据
StatusBar.Panels(2) = "视屏" + Str(channel + 1)
End Function
'==============以上为工具栏相关操作函数=======================================================================
'=============================================================================================================
'===================================================================================================================
'-----------------------------------数据发送与接收处理--------------------------------------------------------------
Private Sub MSComm1_Oncomm()
'-----------------串口通讯处理核心函数
Dim receive_buffer(0) As Byte
Select Case MSComm1.CommEvent
Case comEvReceive '---------------------------------------------有接受事件发生
Timer_over.Enabled = False
receive_buffer(0) = AscB(MSComm1.Input)
MSComm1.InBufferCount = 0
Text_r.Text = Hex(receive_buffer(0)) + ", " + Text_r.Text '--显示接收的数据
If ACK = receive_buffer(0) Then
If Link_success = False Then
Link_success = True
Call send_bytes(send_buffer)
send_times = 1 '--------------------------------标记发送次数
Link_times = 0 '--------------------------------链接次数清零
Else 'Link_success=ture
send_times = 0
Link_success = False '------------------------------拆链
Timer_over.Enabled = False '-------------------------停止超时计时
NUM_blockall = NUM_blockall - 1 '--------------------标志当前一共还要发送的数据块个数
If NUM_blockall >= 0 Then
Timer_senddelay.Enabled = True
End If
End If
Else 'ACK<>Cbyte(indata)
Call NAK_pro '-----------------------------------------调用否定应答处理函数
End If
End Select
End Sub
Private Sub Timer_senddelay_Timer()
Timer_senddelay.Enabled = False
If NUM_blockall > 0 Then '---------------------------------------汉字信息未发完则继续发送
Call send_word(OSD_code(), 15 - NUM_blockall, (label_index - 5 * channel) - 1)
Else
Call send_position(label_index) '-----------------------------汉字若发完，则紧接着发送位置信息
End If
End Sub
Private Sub Timer_over_Timer()
Call NAK_pro '----------------------------------------------超时重发
Label_show(label_index).BorderStyle = 0 '-------------------防止label_show(index)一直处于选中状态
xp = 0
yp = 0
End Sub
'-----------------------------------数据发送与接收处理--------------------------------------------------------------
'===================================================================================================================
'===================================================================================================================
'===================================================================================================================
'----------------------------控件Label_show(index)的主要事件
Private Sub Label_show_DblClick(Index As Integer)
Timer_clickdelay.Enabled = False
label_index = Index
Dialog_input.text_string.Text = Label_show(Index) '-------------获取当前标签属性值，并传递给Dialog_input对话框
Dialog_input.Combo_X.Text = val(label_pos(Index, 0))
Dialog_input.Combo_Y.Text = val(label_pos(Index, 1))
If Index = 0 Or Index = 1 Or Index = 5 Or Index = 6 Then
Dialog_input.text_string.Enabled = False
Dialog_input.Show vbModal
If Dialog_input.mReturnValue = 1 Then
Call send_position(Index)
Label_show(Index).Left = (label_pos(Index, 0) - 1) * Picture_back.Width / 27
Label_show(Index).Top = (label_pos(Index, 1) - 1) * Picture_back.Height / 14
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -