common.bas

一个VB环境的RS232通讯源码。欢迎下载试用。

Attribute VB_Name = "Module1"
Public sendstr(10) As String
Public sendbin(10) As Byte
Public sendplcr1(17) As Byte
Public sendplcw1(21) As Byte
Public sendplcrb(17) As Byte
Public sendplcwb(25) As Byte
Public strbin As String
Public adam_data As String
Private senddata As Boolean
'below const num.
Public Const sample_circle = 3
'variable
Public sample_time, countor As Byte
Public wide, height, sendi, reci As Integer
'below array
Public addata(21) As Integer
Public Sub preset_array()
  wide = 1022
  height = 725
  sample_time = 0
  countor = 0
  senddata = True
  strbin = "plcwb"
  adam_data = "0"
  sendi = 0
  reci = 0
End Sub
Public Sub frame(ByVal xs As Integer, ByVal ys As Integer, ByVal wide As Integer, ByVal height As Integer, _
                 ByVal color1 As Integer, ByVal color2 As Integer, ByVal color3 As Integer)
  Form1.ScaleMode = 3
  Form1.Line (xs, ys)-Step(wide, height), RGB(color1, color2, color3), BF
End Sub
Public Sub display_time()
With Form1.Font
    .Name = "arial"
    .Bold = True
    .Size = 11
   End With
  Form1.ForeColor = RGB(0, 0, 255)
  Form1.Line (wide - 75, 10)-(wide - 10, 26), , BF
  Form1.ForeColor = RGB(255, 0, 0)
  Form1.Line (wide - 75, 10)-(wide - 10, 26), , B
  Form1.ForeColor = QBColor(15)
  Form1.CurrentX = wide - 70
  Form1.CurrentY = 8
  Form1.Print Time$
End Sub
Public Sub head_first()
  Dim xs, ys, stx, sty As Integer
  xs = 1
  ys = 2
  sty = height \ 10
  Call frame(xs, ys, wide, height, 255, 0, 0)
  Call frame(xs + 1, ys + 1, wide - 2, height - 2, 255, 0, 0)
  Call frame(xs + 2, ys + 2, wide - 4, height - 4, 255, 255, 0)
  Call frame(xs + 3, ys + 3, wide - 6, height - 6, 255, 255, 0)
  Call frame(xs + 4, ys + 4, wide - 8, height - 8, 0, 0, 255)
  With Form1.Font
    .Name = "arial"
    .Bold = True
    .Size = 25
   End With
  stx = (wide - Len("通  讯  测  试  程  序") * 20) \ 2
  Form1.CurrentX = stx
  Form1.CurrentY = sty
  Form1.ForeColor = RGB(255, 200, 0)
  Form1.Print "通  讯  测  试  程  序"
End Sub
Public Sub first_graph()
  head_first
End Sub
Public Sub first_graph_renew()
Dim i, stx, sty, movx As Integer
stx = wide \ 8
sty = height \ 6
movx = 500
With Form1.Font
    .Name = "arial"
    .Bold = True
    .Size = 12
   End With
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx, sty + 30)-(stx + 150, sty + 60), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx
     Form1.CurrentY = sty + 30
     Form1.Print "SEND:"
     Form1.CurrentX = stx + 100
     Form1.CurrentY = sty + 30
     Form1.Print sendi
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx + movx, sty + 30)-(stx + 230 + movx, sty + 60), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx + movx
     Form1.CurrentY = sty + 30
     Form1.Print "RECORD:"
     Form1.CurrentX = stx + 100 + movx
     Form1.CurrentY = sty + 30
     Form1.Print reci
     
    For i = 0 To 10
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx, sty + 90 + i * 30)-(stx + 230, sty + 120 + i * 30), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print i + 1
     Form1.CurrentX = stx + 100
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print "SEND:"
     Form1.CurrentX = stx + 200
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print sendbin(i)
     
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx + movx, sty + 90 + i * 30)-(stx + 230 + movx, sty + 120 + i * 30), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx + movx
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print i + 1
     Form1.CurrentX = stx + 100 + movx
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print "RECD:"
     Form1.CurrentX = stx + 200 + movx
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print addata(i)
    Next i
    For i = 11 To 11
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx, sty + 90 + i * 30)-(stx + 230, sty + 120 + i * 30), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print i + 1
     Form1.CurrentX = stx + 100
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print "A/D:"
     Form1.CurrentX = stx + 200
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print adam_data
    Next i
End Sub
Public Sub plc_graph_renew()
Dim i, stx, sty As Integer
stx = wide \ 8
sty = height \ 6
With Form1.Font
    .Name = "arial"
    .Bold = True
    .Size = 12
   End With
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx, sty + 30)-(stx + 150, sty + 60), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx
     Form1.CurrentY = sty + 30
     Form1.Print "COUNTOR:"
     Form1.CurrentX = stx + 100
     Form1.CurrentY = sty + 30
     Form1.Print countor
    For i = 0 To 10
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx - 30, sty + 90 + i * 30)-(stx + 150, sty + 120 + i * 30), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx - 30
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print i + 1
     Form1.CurrentX = stx
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print "RECD:"
     Form1.CurrentX = stx + 100
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print addata(i)
    Next i
    For i = 0 To 10
     Form1.ForeColor = RGB(0, 0, 255)
     Form1.Line (stx - 30 + 250, sty + 90 + i * 30)-(stx + 150 + 250, sty + 120 + i * 30), , BF
     Form1.ForeColor = QBColor(15)
     Form1.CurrentX = stx - 30 + 250
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print i + 10
     Form1.CurrentX = stx + 250
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print "RECD:"
     Form1.CurrentX = stx + 100 + 250
     Form1.CurrentY = sty + 90 + i * 30
     Form1.Print addata(i + 11)
    Next i
End Sub
Public Sub init1_commu_port(ByVal port_no, bpds As Integer)
  Form1.MSComm1.CommPort = port_no
  Form1.MSComm1.InputLen = 0
  Form1.MSComm1.PortOpen = True
  Form1.MSComm1.Settings = bpds
End Sub
Public Sub close_commu_port()
  Form1.MSComm1.PortOpen = False
End Sub
Public Sub send_232_str(ByVal d As String)
  Form1.MSComm1.Output = d
End Sub
Public Function rec_232_str() As String
  rec_232_str = Form1.MSComm1.Input
End Function
Public Function read_232_str() As Boolean
  Dim s1, s2 As String
  Dim i, j As Integer
  If Form1.MSComm1.InBufferCount >= 11 Then
    s1 = rec_232_str
    For i = 0 To 10
      s2 = Mid$(s1, i + 1, 1)
      addata(i) = Asc(s2)
    Next i
  End If
End Function
Public Sub preparedata_str()
  countor = countor + 1
  sendstr(0) = "a"
  sendstr(1) = "b"
  sendstr(2) = "c"
  sendstr(3) = "d"
  sendstr(4) = "e"
  sendstr(5) = "f"
  sendstr(6) = "g"
  sendstr(7) = "h"
  sendstr(8) = "i"
  sendstr(9) = "j"
  sendstr(10) = "k"
End Sub
Public Sub send_data_str()
Dim i As Integer
  preparedata_str
  For i = 0 To 10
    Call send_232_str(sendstr(i))
  Next i
End Sub
Public Function read_232_bin() As Boolean
Dim i As Integer
Dim a As Variant
Dim sr() As Byte
  If Form1.MSComm1.InBufferCount >= 11 Then
    a = Form1.MSComm1.Input
    sr() = a
    For i = 0 To 10
      addata(i) = sr(i)
    Next i
    reci = reci + 1
    If ((addata(0) = 62) And (addata(8) = 13)) Then
      If (addata(1) = 43) Then
        If (addata(2) = 48) Then
          adam_data = Chr(addata(3)) & _
                      Chr(addata(4)) & _
                      Chr(addata(5)) & Chr(addata(6)) & Chr(addata(7))
        Else
          adam_data = Chr(addata(2)) & Chr(addata(3)) & _
                      Chr(addata(4)) & _
                      Chr(addata(5)) & Chr(addata(6)) & Chr(addata(7))
        End If
      ElseIf (addata(1) = 45) Then
        If (addata(2) = 48) Then
          adam_data = Chr(addata(2)) & _
                      Chr(addata(3)) & _
                      Chr(addata(4)) & _
                      Chr(addata(5)) & Chr(addata(6)) & Chr(addata(7))
        Else
          adam_data = Chr(addata(3)) & _
                      Chr(addata(2)) & Chr(addata(3)) & _
                      Chr(addata(4)) & _
                      Chr(addata(5)) & Chr(addata(6)) & Chr(addata(7))
        End If
      End If
    End If
  End If
End Function
Public Sub preparedata_bin1()
  sendi = sendi + 1
  If (sendi + 9 > 255) Then
    sendi = 0
    reci = 0
  End If
  sendbin(0) = sendi
  sendbin(1) = sendbin(0) + 1
  sendbin(2) = sendbin(1) + 1
  sendbin(3) = sendbin(2) + 1
  sendbin(4) = sendbin(3) + 1
  sendbin(5) = sendbin(4) + 1
  sendbin(6) = sendbin(5) + 1
  sendbin(7) = sendbin(6) + 1
  sendbin(8) = sendbin(7) + 1
  sendbin(9) = sendbin(8) + 1
  sendbin(10) = &HFF
End Sub
Public Sub preparedata_bin2()
  sendbin(0) = Asc("#")
  sendbin(1) = Asc("0")
  sendbin(2) = Asc("1")
  sendbin(3) = Asc("0")
  sendbin(4) = 13 'cr=&hd
End Sub
Public Sub send_data_bin()
Dim a As Variant
Dim ss() As Byte
  preparedata_bin1
  ss = sendbin
  a = ss
  Form1.MSComm1.Output = a
End Sub
Public Function read_232_plcr1() As Boolean
Dim i As Integer
Dim a As Variant
Dim sr() As Byte
  If Form1.MSComm1.InBufferCount >= 15 Then '15
    a = Form1.MSComm1.Input
    sr() = a
    For i = 0 To 14
      addata(i) = sr(i)
    Next i
    countor = countor + 1
  End If
End Function
Public Sub preparedata_plcr1()
  If (countor > 255) Then countor = 0
  sendplcr1(0) = &H5
  sendplcr1(1) = &H30
  sendplcr1(2) = &H30
  sendplcr1(3) = &H52
  sendplcr1(4) = &H53
  sendplcr1(5) = &H53
  sendplcr1(6) = &H30
  sendplcr1(7) = &H31
  sendplcr1(8) = &H30
  sendplcr1(9) = &H37
  sendplcr1(10) = &H25
  sendplcr1(11) = &H44
  sendplcr1(12) = &H57
  sendplcr1(13) = &H30
  sendplcr1(14) = &H30
  sendplcr1(15) = &H35
  sendplcr1(16) = &H30
  sendplcr1(17) = &H4
  'ENQ,h00,  R(h52),SS,   h01,  h07,  %DW0050,       EOT
  'h5, h3030,h52,   h5353,h3031,h3037,h25445730303530,h4
End Sub
Public Sub send_data_plcr1()
Dim a As Variant
Dim ss() As Byte
  preparedata_plcr1
  ss = sendplcr1
  a = ss
  Form1.MSComm1.Output = a
End Sub
Public Sub preparedata_plcw1()
  If (countor > 255) Then countor = 0
  sendplcw1(0) = &H5
  sendplcw1(1) = &H30
  sendplcw1(2) = &H30
  sendplcw1(3) = &H57
  sendplcw1(4) = &H53
  sendplcw1(5) = &H53
  sendplcw1(6) = &H30
  sendplcw1(7) = &H31
  sendplcw1(8) = &H30
  sendplcw1(9) = &H37
  sendplcw1(10) = &H25
  sendplcw1(11) = &H44
  sendplcw1(12) = &H57
  sendplcw1(13) = &H30
  sendplcw1(14) = &H30
  sendplcw1(15) = &H37
  sendplcw1(16) = &H30
  sendplcw1(17) = &H36
  sendplcw1(18) = &H37
  sendplcw1(19) = &H38
  sendplcw1(20) = &H39
  sendplcw1(21) = &H4
'ENQ,h00,  W,  SS,   h01   h07,   %DW0070,        h36373839,EOT
'h5, h3030,h57,h5353,h3031,h3037, h25445730303730,h36373839,h4
End Sub
Public Sub send_data_plcw1()
Dim a As Variant
Dim ss() As Byte
  preparedata_plcw1
  ss = sendplcw1
  a = ss
  Form1.MSComm1.Output = a
End Sub
Public Function read_232_plcrb() As Boolean
Dim i As Integer
Dim a As Variant
Dim sr() As Byte
  If Form1.MSComm1.InBufferCount >= 19 Then
    a = Form1.MSComm1.Input
    sr() = a
    For i = 0 To 18
      addata(i) = Hex(sr(i))
    Next i
    countor = countor + 1
  End If
End Function
Public Sub preparedata_plcrb()
  If (countor > 255) Then countor = 0
  sendplcrb(0) = &H5
  sendplcrb(1) = &H30
  sendplcrb(2) = &H30
  sendplcrb(3) = &H52
  sendplcrb(4) = &H53
  sendplcrb(5) = &H42
  sendplcrb(6) = &H30
  sendplcrb(7) = &H37
  sendplcrb(8) = &H25
  sendplcrb(9) = &H44
  sendplcrb(10) = &H57
  sendplcrb(11) = &H30
  sendplcrb(12) = &H30
  sendplcrb(13) = &H37
  sendplcrb(14) = &H30
  sendplcrb(15) = &H30
  sendplcrb(16) = &H32
  sendplcrb(17) = &H4
  'ENQ,h00,  R(h52),SB,   h07,  %DW0050,        h02,  EOT
  'h5, h3030,h52,   h5342,h3037,h25445730303530,h3032,h4
End Sub
Public Sub send_data_plcrb()
Dim a As Variant
Dim ss() As Byte
  preparedata_plcrb
  ss = sendplcrb
  a = ss
  Form1.MSComm1.Output = a
End Sub
Public Sub preparedata_plcwb()
  If (countor > 255) Then countor = 0
  sendplcwb(0) = &H5
  sendplcwb(1) = &H30
  sendplcwb(2) = &H30
  sendplcwb(3) = &H57
  sendplcwb(4) = &H53
  sendplcwb(5) = &H42
  sendplcwb(6) = &H30
  sendplcwb(7) = &H37
  sendplcwb(8) = &H25
  sendplcwb(9) = &H44
  sendplcwb(10) = &H57
  sendplcwb(11) = &H30
  sendplcwb(12) = &H30
  sendplcwb(13) = &H37
  sendplcwb(14) = &H30
  sendplcwb(15) = &H30
  sendplcwb(16) = &H32
  sendplcwb(17) = &H33
  sendplcwb(18) = &H34
  sendplcwb(19) = &H35
  sendplcwb(20) = &H36
  sendplcwb(21) = &H34
  sendplcwb(22) = &H35
  sendplcwb(23) = &H36
  sendplcwb(24) = &H37
  sendplcwb(25) = &H4
'ENQ,h00,  W,  SB,   h07,  %DW0070, h3334353634353637,       EOT
'h5, h3030,h57,h5342,h3037,h25445730303730,h3334353634353637,h4
End Sub
Public Sub send_data_plcwb()
Dim a As Variant
Dim ss() As Byte
  preparedata_plcwb
  ss = sendplcwb
  a = ss
  Form1.MSComm1.Output = a
End Sub
Public Sub do_onesec()
  sample_time = sample_time + 1
  display_time
  If (strbin = "str") Then
    recei232 = read_232_str
  ElseIf (strbin = "bin") Then
    recei232 = read_232_bin
  ElseIf (strbin = "plcr1") Then
    recei232 = read_232_plcr1
  ElseIf (strbin = "plcrb") Then
    recei232 = read_232_plcrb
  End If
End Sub
Public Sub do_three()
  If sample_time >= sample_circle Then
    If (strbin = "str") Then
      send_data_str
      first_graph_renew
    ElseIf (strbin = "bin") And (senddata) Then
      send_data_bin
      'senddata = False
      first_graph_renew
    ElseIf (strbin = "plcr1") Then
      'send_data_plcr1
      plc_graph_renew
    ElseIf (strbin = "plcw1") Then
      send_data_plcw1
      plc_graph_renew
      strbin = "plcr1"
    ElseIf (strbin = "plcrb") Then
      send_data_plcrb
      plc_graph_renew
    ElseIf (strbin = "plcwb") Then
      send_data_plcwb
      plc_graph_renew
      strbin = "plcrb"
    End If
    sample_time = 0
  End If
End Sub