main.frm

字符叠加上位机

                                   
  End If
Else
   Dialog_input.Show vbModal
   If Dialog_input.mReturnValue = 1 Then
      Call send_word(OSD_code(), 1, (Index - 5 * channel) - 1)
      NUM_blockall = 14 '--------------------------------------一共要发送14个数据块
   
      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
                                        '-----------------------根据Dialog_input的返回值重置label_show(index)的位置
  End If
   
End If

      If Label_show(Index).Left + Label_show(Index).Width >= Picture_back.Width Then
         Label_show(Index).Left = Picture_back.Width - Label_show(Index).Width
         label_pos(Index, 0) = CByte(Label_show(Index).Left * 27 \ Picture_back.Width + 1) '----获取x坐标位置
      End If
     
      If Label_show(Index).Top + Label_show(Index).Height >= Picture_back.Height Then
        Label_show(Index).Top = Picture_back.Height - Label_show(Index).Height
        label_pos(Index, 1) = CByte(Label_show(Index).Top * 14 \ Picture_back.Height + 1)
      End If

End Sub



'===============================================================================================================
'====================以下四个函数用于控件拖动===================================================================

Private Sub Label_show_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
xp = X
yp = Y
label_index = Index '-----------------------------------------------激活当前label_show(index)
Label_show(Index).BorderStyle = 1 '---------------------------------选中Label_show(index)
End If
End Sub


Private Sub Label_show_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If xp <> 0 And yp <> 0 Then

   Label_show(Index).Left = Label_show(Index).Left + (X - xp)
   
   '------------------判断确保Label_show(index)在Picture_back的边框内
   If Label_show(Index).Left <= 0 Then
       Label_show(Index).Left = 0
   ElseIf Label_show(Index).Left + Label_show(Index).Width >= Picture_back.Width Then
        Label_show(Index).Left = Picture_back.Width - Label_show(Index).Width
   End If

    Label_show(Index).Top = Label_show(Index).Top + (Y - yp)
   If Label_show(Index).Top <= 0 Then
       Label_show(Index).Top = 0
   ElseIf Label_show(Index).Top + Label_show(Index).Height >= Picture_back.Height Then
       Label_show(Index).Top = Picture_back.Height - Label_show(Index).Height
   End If
  
  label_pos(Index, 0) = CByte(Label_show(Index).Left * 27 \ Picture_back.Width + 1) '----获取坐标位置
  label_pos(Index, 1) = CByte(Label_show(Index).Top * 14 \ Picture_back.Height + 1)
     
End If

StatusBar.Panels(1) = "双击打开字符输入对话框。"
StatusBar.Panels(3) = "水平位置：" + Str(label_pos(Index, 0)) '--------------------状态栏随时跟踪显示
StatusBar.Panels(4) = "垂直位置：" + Str(label_pos(Index, 1))
 
End Sub

Private Sub Label_show_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim offset As Byte
offset = 100

If Button = 1 Then
xp = yp = 0
Label_show(Index).BorderStyle = 0
Timer_clickdelay.Enabled = True

End If

End Sub

Private Sub Timer_clickdelay_Timer()

Timer_clickdelay = False

If label_index >= 0 And label_index <= 9 Then
   Call send_position(label_index)

   Label_show(label_index).Left = (label_pos(label_index, 0) - 1) * Picture_back.Width / 27
   Label_show(label_index).Top = (label_pos(label_index, 1) - 1) * Picture_back.Height / 14
End If

End Sub

'====================以上四个函数用于控件拖动===================================================================
'===============================================================================================================



'-----------------发送label_show(index)的位置坐标
Function send_position(ByVal label_index As Integer) '----------发送label_show(index)的坐标
Dim position_code(6) As Byte

If label_index = 0 Or label_index = 5 Then
   Call send_date(label_index)
ElseIf label_index = 1 Or label_index = 6 Then
   Call send_time(label_index)
Else '----------------------------------------------------------连续发送三组汉字坐标
position_code(0) = POSCOM '-------------------------------------写命令
position_code(1) = label_pos(2 + 5 * channel, 0) '--------------label(index)的水平坐标
position_code(2) = label_pos(2 + 5 * channel, 1) '--------------label(index)的垂直坐标
position_code(3) = label_pos(3 + 5 * channel, 0) '--------------label(index)的水平坐标
position_code(4) = label_pos(3 + 5 * channel, 1) '--------------label(index)的垂直坐标
position_code(5) = label_pos(4 + 5 * channel, 0) '--------------label(index)的水平坐标
position_code(6) = label_pos(4 + 5 * channel, 1) '--------------label(index)的垂直坐标

Call send_state(position_code(), 7) '---------------------------发送数据
End If

End Function


Function send_date(ByVal label_index)
Dim date_code(5) As Byte

date_code(0) = DATECOM
date_code(1) = CByte(Day(Date))
date_code(2) = CByte(Month(Date))

If Year(Date) < 2100 And Year(Date) >= 2000 Then
date_code(3) = CByte(CInt(Year(Date)) - 2000)
End If

date_code(4) = label_pos(label_index, 0)
date_code(5) = label_pos(label_index, 1)

Call send_state(date_code(), 6)

End Function
Function send_time(ByVal label_index)
Dim time_code(5) 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) = label_pos(label_index, 0)
time_code(5) = label_pos(label_index, 1)

Call send_state(time_code(), 6)

End Function
'----------------------------控件Label_show(index)的主要事件、函数操作完毕
'===================================================================================================================
'===================================================================================================================











Function initall()

'------------初始化控件mscomm-----------------------------------------------------------------------------------
MSComm1.InBufferSize = 40        '-----------设置MSComm1接收缓冲区为40字节
MSComm1.InBufferCount = 0        '-----------设置输入寄存器所存储的字符数,0清除接收缓冲区
MSComm1.InputMode = comInputModeBinary '-----二进制方式
MSComm1.CommPort = 1             '-----------使用串口com1
MSComm1.Settings = "19200,N,8,1"  '-----------设置通讯参数
MSComm1.RThreshold = 1           '-----------设置一次接收的数据量，每接收完一次这多数据，触发一次oncomm事件
MSComm1.InputLen = 0             '-----------每次读入缓冲区所有字符

If MSComm1.PortOpen = False Then
   MSComm1.PortOpen = True       '------------打开串口
'ElseIf vbYes = MsgBox("串口1正在使用，继续操作吗？", vbYesNo + vbQuestion + vbDefaultButton2, "串口冲突") Then
'       Picture_back.Enabled = False
'       Else
'       Unload Me
End If
'------------控件mscomm初始化完毕---------------------------------------------------------------------------------

'------------控件timer初始化-------------------------------------------------------------------------------------
Timer_over.Enabled = False
Timer_senddelay.Enabled = False
Timer_clickdelay.Enabled = False
Timer_settime.Enabled = True
'------------控件timer初始化-------------------------------------------------------------------------------------

'------------控件Label_show初始化----------------------------------------------------------------------------------
For i = 0 To 9
Label_show(i).AutoSize = True
Label_show(i).FontName = "宋体" '-----------------字体设置
Label_show(i).FontSize = Picture_back.Width / 390  '-------随屏幕改变设定字符大小
Next
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初始化完毕------------------------------------------------------------------------------

'------------控件command_channel初始化----------------------------------------------------------------------------
channel = 0 '------------------------初始值为视屏1

For i = 5 To 9
Label_show(i).Visible = False '-------视屏2不可见
Next
'------------控件command_channel初始化完毕------------------------------------------------------------------------

'------------初始化状态栏statusbar--------------------------------------------------------------------------------
StatusBar.Panels(2) = "视屏1"
StatusBar.Panels(3) = "水平位置：" + Str(label_pos(label_index, 0))
StatusBar.Panels(4) = "垂直位置：" + Str(label_pos(label_index, 1))
'------------初始化状态栏statusbar完毕----------------------------------------------------------------------------

'------------坐标位置数组初始化-----------------------------------------------------------------------------------
For i = 0 To 9
label_pos(i, 0) = CByte(val(Label_show(i).Left * 27 \ (Picture_back.Width) + 1))
label_pos(i, 1) = CByte(val(Label_show(i).Top * 14 \ (Picture_back.Height) + 1))
Label_show(i).Left = (label_pos(i, 0) - 1) * Picture_back.Width / 27 '-----Labek_show(index)重新定位
Label_show(i).Top = (label_pos(i, 1) - 1) * Picture_back.Height / 14
Next
'------------坐标位置数组初始化完毕-------------------------------------------------------------------------------

End Function














'===============================================================================================================
'======================以下为发送字符的串口操作函数=============================================================

Function send_bytes(outdata() As Byte)
'--------向串口发送一个块的数据--------------------------------------------
'--------outdata(num as byte) ，当前要发送的数据块，可以是任意字节长度
If MSComm1.PortOpen = True Then
MSComm1.OutBufferCount = 0 '-----------------清空输出寄存器
MSComm1.Output = outdata   '-----------------发送数据

Timer_over.Enabled = True
End If
End Function

Function send_word(send_code() As Byte, ByVal num_block, ByVal num_string)
'-----------------发送字符串点阵函数
'-----------------send_code()所有要发送的数据
'-----------------NUM_bloke,标记当前是第NUM_bloke个数据帧
'-----------------num_string,对应屏幕的第几个字符串，取值范围0-5


Call send_bytes(RLI) '---------------------------------请求建立通讯链接
Timer_over.Enabled = True

ReDim send_buffer(56)

send_buffer(0) = WORDCOM
send_buffer(1) = num_string
send_buffer(2) = num_block - 1

For i = 0 To 53 '---------------------------------------将要发送的数据放入缓冲区send_buffer(53)内，
send_buffer(i + 3) = send_code(num_block - 1, i) '------提取发送代码的第num_block个数据块，并存储到发送缓冲区send_buffer.                                       '------------等待接收到ACK肯定应答后发送该数据块
Next

End Function

Function send_state(send_code() As Byte, ByVal buffer_len)

'----------------发送以帧数据，数据量小于54bytes------------------------------------------------
Dim sum As Integer
sum = 0 '-----------------------赋初值

Call send_bytes(RLI) '---------------------------------请求建立通讯链接
Timer_over.Enabled = True

ReDim send_buffer(buffer_len + 2)

For i = 0 To buffer_len - 1
send_buffer(i) = send_code(i)
sum = sum + send_code(i)
Next
send_buffer(buffer_len) = sum Mod 256
send_buffer(buffer_len + 1) = ELI
NUM_blockall = 0
End Function

Function NAK_pro()
If Link_success = True Then
   send_times = send_times + 1
   If send_times >= 4 Then
   MsgBox "发送数据超时！", vbOKOnly + vbQuestion + vbDefaultButton1, "提示"
   Link_success = False
   Timer_over.Enabled = False
   Else
   Call send_bytes(send_buffer)
   Timer_over.Enabled = True
   End If
Else
  Link_times = Link_times + 1
  If Link_times >= 4 Then
    MsgBox "链接超时", vbOKOnly + vbInformation + vbDefaultButton1, "提示"
    Link_success = False
    Timer_over.Enabled = False
  Else
    Call send_bytes(RLI)
    Timer_over.Enabled = True
  End If
End If
End Function