VB与三菱40点PLC的通讯程序

Dim rec_bv As Variant
Dim rec_flag As Integer
Dim timer1_count As Integer

Private Sub Form_Load()

    MSComm1.CommPort = 1
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.PortOpen = True
    MSComm1.RThreshold = 10
    MSComm1.InputMode = comInputModeBinary
    Timer1.Enabled = True

MSFlexGrid1.Cols = 12
    MSFlexGrid2.Cols = 12
    MSFlexGrid3.Cols = 13
    MSFlexGrid4.Cols = 13

    For i = 0 To 11
        MSFlexGrid1.ColWidth(i) = MSFlexGrid1.Width / 12
        MSFlexGrid2.ColWidth(i) = MSFlexGrid2.Width / 12
        MSFlexGrid3.ColWidth(i) = MSFlexGrid3.Width / 13
        MSFlexGrid4.ColWidth(i) = MSFlexGrid4.Width / 13
    Next i

    For i = 0 To 11
        MSFlexGrid1.Row = 0
        MSFlexGrid1.Col = i
        MSFlexGrid1.CellAlignment = 4
        MSFlexGrid2.Row = 0
        MSFlexGrid2.Col = i
        MSFlexGrid2.CellAlignment = 4
    Next i

    For i = 0 To 12
        MSFlexGrid3.Row = 0
        MSFlexGrid3.Col = i
        MSFlexGrid3.CellAlignment = 4
        MSFlexGrid4.Row = 0
        MSFlexGrid4.Col = i
        MSFlexGrid4.CellAlignment = 4
Next I

    For i = 0 To 23
        If i Mod 2 = 0 Then
            MSFlexGrid1.TextMatrix(0, i / 2) = "X" + CStr(Int(i / 8) * 10 + i Mod 8)
        End If
        If i Mod 2 = 1 Then
            MSFlexGrid2.TextMatrix(0, Int(i / 2)) = "X" + CStr(Int(i / 8) * 10 + i Mod 8)
        End If
    Next i

    Call Y_grid_init

End Sub

Private Sub MSComm1_OnComm()

    Dim label_text As String

    Select Case MSComm1.CommEvent
        Case comEvReceive
            Sleep (100)
            MSComm1.InputLen = 0
            rec_bv = MSComm1.Input
            If rec_flag = 1 Then
                Call set_state_1
                rec_flag = 2
                Exit Sub
            End If
            If rec_flag = 2 Then
                Call set_state_2
                rec_flag = 0
            End If
            If rec_flag = 3 Then
                For i = 5 To 28
                    j = j + 1
                    If j <= 4 Then
                        label_text = label_text & Chr(rec_bv(i))
                    Else
                        Label1(kk).Caption = Format(CDec("&H" & label_text), "0000")
                        label_text = Chr(rec_bv(i))
                        j = 1
                    End If
                    kk = Int((i - 5) / 4)
                Next i
                Label1(kk).Caption = Format(CDec("&H" & label_text), "0000")
                rec_flag = 0
                err_string = ""
                For i = 0 To 7
                    err_string = err_string & Label1(i).Caption
                Next i
            End If
    End Select

End Sub

Private Sub readStatus1()

    Dim send_bv() As Byte
    ReDim send_bv(0 To 16)

    send_bv(0) = &H5
    send_bv(1) = &H30
    send_bv(2) = &H30
    send_bv(3) = &H46
    send_bv(4) = &H46
    send_bv(5) = &H42
    send_bv(6) = &H52
    send_bv(7) = &H41
    send_bv(8) = &H58
    send_bv(9) = &H30
    send_bv(10) = &H30
    send_bv(11) = &H30
    send_bv(12) = &H30
    send_bv(13) = &H31
    send_bv(14) = &H38
    send_bv(15) = &H34
    send_bv(16) = &H32

    rec_flag = 1
    MSComm1.Output = send_bv

    Do Until rec_flag = 2
        DoEvents
    Loop

    ReDim send_bv(0 To 16)

    send_bv(0) = &H5
    send_bv(1) = &H30
    send_bv(2) = &H30
    send_bv(3) = &H46
    send_bv(4) = &H46
    send_bv(5) = &H42
    send_bv(6) = &H52
    send_bv(7) = &H41
    send_bv(8) = &H59
    send_bv(9) = &H30
    send_bv(10) = &H30
    send_bv(11) = &H30
    send_bv(12) = &H30
    send_bv(13) = &H31
    send_bv(14) = &H30
    send_bv(15) = &H33
    send_bv(16) = &H42

    rec_flag = 2
    MSComm1.Output = send_bv

End Sub

Private Sub readStatus2()

    Dim send_bv() As Byte
    ReDim send_bv(0 To 16)

    send_bv(0) = &H5
    send_bv(1) = &H30
    send_bv(2) = &H30
    send_bv(3) = &H46
    send_bv(4) = &H46
    send_bv(5) = &H57
    send_bv(6) = &H52
    send_bv(7) = &H41
    send_bv(8) = &H44
    send_bv(9) = &H38
    send_bv(10) = &H30
    send_bv(11) = &H36
    send_bv(12) = &H30
    send_bv(13) = &H30
    send_bv(14) = &H38
    send_bv(15) = &H35
    send_bv(16) = &H30

    rec_flag = 3
    MSComm1.Output = send_bv

End Sub

Private Sub set_state_1()

    X_str = ""
    For i = 5 To 28
        If (i - 5) Mod 2 = 0 Then
            MSFlexGrid1.Row = 1
            MSFlexGrid1.Col = (i - 5) / 2
            If rec_bv(i) = &H30 Then
                Set MSFlexGrid1.CellPicture = red.Picture
            End If
            If rec_bv(i) = &H31 Then
                Set MSFlexGrid1.CellPicture = green.Picture
            End If
        End If
        If (i - 5) Mod 2 = 1 Then
            MSFlexGrid2.Row = 1
            MSFlexGrid2.Col = Int((i - 5) / 2)
            If rec_bv(i) = &H30 Then
                Set MSFlexGrid2.CellPicture = red.Picture
            End If
            If rec_bv(i) = &H31 Then
                Set MSFlexGrid2.CellPicture = green.Picture
            End If
        End If
        If rec_bv(i) = &H30 Then
            X_str = X_str & "0"
        End If
        If rec_bv(i) = &H31 Then
            X_str = X_str & "1"
        End If
    Next i

End Sub

Private Sub set_state_2()

    Dim li_flag As Integer
    Y_str = ""
    For i = 5 To 20
        li_flag = 0
        Select Case (i - 5)
            Case 0
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 0
            Case 1
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 1
            Case 2
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 2
            Case 4
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 4
            Case 6
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 5
            Case 8
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 7
            Case 10
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 8
            Case 12
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 10
            Case 14
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 11
            Case 16
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 13
            Case 18
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 14
            Case 20
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 16
            Case 22
                MSFlexGrid3.Row = 1
                MSFlexGrid3.Col = 17
            Case Else
                li_flag = 1
        End Select

        If li_flag = 0 Then
            If rec_bv(i) = &H30 Then
                Set MSFlexGrid3.CellPicture = red.Picture
            End If
            If rec_bv(i) = &H31 Then
                Set MSFlexGrid3.CellPicture = green.Picture
            End If
        End If

        Select Case (i - 5)
        Case 3
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 3
        Case 5
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 5
        Case 7
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 6
        Case 9
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 8
        Case 11
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 9
        Case 13
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 11
        Case 15
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 12
        Case 17
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 14
        Case 19
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 15
        Case 21
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 17
        Case 23
            MSFlexGrid4.Row = 1
            MSFlexGrid4.Col = 18
        Case Else
            li_flag = 2
        End Select

        If li_flag = 1 Then
            If rec_bv(i) = &H30 Then
                Set MSFlexGrid4.CellPicture = red.Picture
            End If
            If rec_bv(i) = &H31 Then
                Set MSFlexGrid4.CellPicture = green.Picture
            End If
        End If

        If rec_bv(i) = &H30 Then
            Y_str = Y_str & "0"
        End If

        If rec_bv(i) = &H31 Then
            Y_str = Y_str & "1"
        End If

    Next i

End Sub

Private Sub Y_grid_init()

    Dim i As Integer

    For i = 1 To 13
        MSFlexGrid3.Row = 0
        MSFlexGrid3.Col = i - 1
        MSFlexGrid4.Row = 0
        MSFlexGrid4.Col = i - 1
        MSFlexGrid3.CellPictureAlignment = 4
        Select Case i
        Case 1
            MSFlexGrid3.Text = "Y0"
            MSFlexGrid4.Text = "COM0"
        Case 2
            MSFlexGrid3.Text = "Y1"
            MSFlexGrid4.Text = "COM1"
        Case 3
            MSFlexGrid3.Text = "Y2"
            MSFlexGrid4.Text = "COM2"
        Case 4
            Set MSFlexGrid3.CellPicture = angel.Picture
            MSFlexGrid4.Text = "Y3"
        Case 5
            MSFlexGrid3.Text = "Y4"
            MSFlexGrid4.Text = "COM3"
        Case 6
            MSFlexGrid3.Text = "Y6"
            MSFlexGrid4.Text = "Y5"
        Case 7
            Set MSFlexGrid3.CellPicture = angel.Picture
            MSFlexGrid4.Text = "Y7"
        Case 8
            MSFlexGrid3.Text = "Y10"
            MSFlexGrid4.Text = "COM4"
        Case 9
            MSFlexGrid3.Text = "Y12"
            MSFlexGrid4.Text = "Y11"
        Case 10
            Set MSFlexGrid3.CellPicture = angel.Picture
            MSFlexGrid4.Text = "Y13"
        Case 11
            MSFlexGrid3.Text = "Y14"
            MSFlexGrid4.Text = "COM5"
        Case 12
            MSFlexGrid3.Text = "Y16"
            MSFlexGrid4.Text = "Y15"
        Case 13
            Set MSFlexGrid3.CellPicture = angel.Picture
            MSFlexGrid4.Text = "Y17"
        End Select
    Next i

End Sub

Private Sub Timer1_Timer()

    On Error Resume Next

    timer1_count = timer1_count + 1
    If timer1_count < 5 Then
        Call readStatus1
    Else
        timer1_count = 0
        Call readStatus1
        Do Until rec_flag = 0
            DoEvents
        Loop
        Call readStatus2
    End If

End Sub

Private Sub Label1_Change(Index As Integer)

    If Label1(Index).Caption = "" Then
        Label1(Index).ToolTipText = ""
        Exit Sub
    End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
End If
End Sub