delta.frm

vb编制的和台达通讯的源代码

      Left            =   4920
      Top             =   4080
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      ParitySetting   =   2
      DataBits        =   7
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "Delta PLC Monitor System"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   600
      Width           =   3495
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim plc As Byte
Dim y0flag As Byte
Dim y1flag As Byte
Dim str As String
Dim n, S

Private Sub Command1_Click()
Dim strout As String
Dim QQ As String
Timer1.Enabled = False
QQ = Text1.Text
If Len(QQ) = 3 Then
        QQ = "0" & QQ
    ElseIf Len(QQ) = 2 Then
        QQ = "00" & QQ
    ElseIf Len(QQ) = 1 Then
        QQ = "000" & QQ
End If
str = "01061000" + QQ
LRCC = LRC(str)   '计算 str的lrc校验码。
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()

End Sub

Private Sub Form_Load()
    Dim s1 As String
    Dim s2 As String
    Dim s22 As String
    Dim s3 As String
    Dim s4 As String
    
    Picture1.Move 0, 0, 5600, 280   '长度可随意改
    Timer1.Enabled = True
    n = -(Me.TextWidth(Now)) - 10
    MSComm1.PortOpen = True
    Timer1.Enabled = True
    s2 = "01010C300001"
    s22 = LRC(s2)
    s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
    MSComm1.InBufferCount = 0
    MSComm1.Output = s1
    TimeDelay (500)
    s3 = MSComm1.Input
    s4 = Mid$(s3, 8, 2)
    If s4 = "31" Then
        plc = 1
    Else: If s4 = "30" Then plc = 0
    End If
    If plc = 1 Then
        Label2.Caption = "PLC Running"
        Shape1.FillColor = RGB(0, 255, 0) 'green
    Else
        Label2.Caption = "PLC Stopped!"
        Shape1.FillColor = RGB(255, 0, 0) 'red
    End If
        
End Sub
 Public Function LRC(str As String) As String
    c = 0
    l = Len(str)
    For c = c + 1 To l
        c_data = Mid$(str, c, 2)
        d_lrc = d_lrc + Val("&H" + c_data)
        c = c + 1
    Next c
    If d_lrc > &HFF Then
        d_lrc = d_lrc Mod &H100
    End If
    h_lrc = Hex(&HFF - d_lrc + 1)
    If Len(h_lrc) > 2 Then
        h_lrc = Mid(h_lrc, Len(h_lrc) - 1, 2)
    End If
        LRC = h_lrc
    End Function



Private Sub start_Click()
Dim strout As String
Timer1.Enabled = False
str = "01050C30FF00"  'M1072 为PLC起动停止标志位。查地址表，M1072为OC30.FF00为置
                      '   ON,0000为置OFF。
LRCC = LRC(str)   '计算 str的lrc校验码。
strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End Sub
Private Sub stop_Click()
Dim strout As String
Timer1.Enabled = False
str = "01050C300000"
LRCC = LRC(str)
strout = ":" + str + LRCC + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = strout
Timer1.Enabled = True
End Sub



Private Sub Text1_KeyPress(KeyAscii As Integer)
'判断输入的是否为数字或是 Enter
    If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 13 Or (KeyAscii >= 65 And KeyAscii <= 70) Then
    Else
      KeyAscii = 0
      Exit Sub
    End If
End Sub


Private Sub Timer1_Timer()
Dim s1, s22, s3, s4, s5 As String
Dim s2 As String
Dim counter As Integer

  Picture1.AutoRedraw = True
  Picture1.Cls
  n = n + 10
  If Picture1.ScaleWidth <= S Then
    n = -(Me.TextWidth(Now)) - 10
  End If
  Picture1.CurrentX = n
  S = n
  Picture1.CurrentY = 0
  Picture1.Print Now & "  [e-mail]"
  
  Picture1.AutoRedraw = False

s2 = "01010C300001"          'M1072 Start/Stop Flag
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
'TimeDelay (200)

s3 = WaitRS(MSComm1, vbCrLf, 200)
s4 = Mid$(s3, 8, 2)
If s4 = "31" Then
    plc = 1
Else: If s4 = "30" Then plc = 0
End If

If plc = 1 Then
    Label2.Caption = "PLC Running"
    Shape1.FillColor = RGB(0, 255, 0) 'green
Else
    Label2.Caption = "PLC Stopped!"
    Shape1.FillColor = RGB(255, 0, 0) 'red
End If

s2 = "010108000002"          'Read Y0 Flag
s3 = ""
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
'TimeDelay (200)

s3 = WaitRS(MSComm1, vbCrLf, 200)
If s3 = "" Then Exit Sub
s4 = Mid$(s3, 8, 2) And &H1
s5 = Mid$(s3, 8, 2) And &H2
If s4 = "1" Then
    y0flag = 1
Else: If s4 = "0" Then y0flag = 0
End If

If y0flag = 1 Then
    
    Shape2.FillColor = RGB(0, 255, 0) 'green
Else
    
    Shape2.FillColor = RGB(255, 0, 0) 'red
End If

If s5 = "2" Then
    y1flag = 1
Else: If s5 = "0" Then y1flag = 0
End If

If y1flag = 1 Then
    
    Shape3.FillColor = RGB(0, 255, 0) 'green
Else
    
    Shape3.FillColor = RGB(255, 0, 0) 'red
End If

's2 = "010310000001"          'Read D512 value
's3 = ""
's22 = LRC(s2)
's1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
'MSComm1.InBufferCount = 0
'MSComm1.Output = s1
'TimeDelay (200)

's3 = WaitRS(MSComm1, vbCrLf, 200)
's4 = Mid$(s3, 8, 4)
'Text1.Text = s4

s2 = "010310000001"          'Read D0 value
s3 = ""
s22 = LRC(s2)
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10)
MSComm1.InBufferCount = 0
MSComm1.Output = s1
'TimeDelay (200)

s3 = WaitRS(MSComm1, vbCrLf, 200)
s4 = Mid$(s3, 8, 4)
Text2.Text = s4

End Sub

Private Sub Y1_Click()
    Dim strout As String
    If y1flag = 0 Then
        str = "01050801FF00"
        LRCC = LRC(str)   '计算 str的lrc校验码。
        Timer1.Enabled = False
        strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
        MSComm1.InBufferCount = 0
        MSComm1.Output = strout
        Timer1.Enabled = True
    Else
        str = "010508010000"
        LRCC = LRC(str)   '计算 str的lrc校验码。
        Timer1.Enabled = False
        strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
        MSComm1.InBufferCount = 0
        MSComm1.Output = strout
        Timer1.Enabled = True
    End If
End Sub

Private Sub YO_Click()
    Dim strout As String
    If y0flag = 0 Then
        str = "01050800FF00"
        LRCC = LRC(str)   '计算 str的lrc校验码。
        Timer1.Enabled = False
        strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
        MSComm1.InBufferCount = 0
        MSComm1.Output = strout
        Timer1.Enabled = True
    Else
        str = "010508000000"
        LRCC = LRC(str)   '计算 str的lrc校验码。
        Timer1.Enabled = False
        strout = ":" + str + LRCC + Chr$(13) + Chr$(10) '欲传送之数据。13为D，10为A
        MSComm1.InBufferCount = 0
        MSComm1.Output = strout
        Timer1.Enabled = True
    End If
End Sub