tsda.frm

用于电脑和TSDA台湾伺服控制器进行通讯

Dim j As Integer
Dim S As String
Dim a As String
Dim b(4) As String
VSgrid.Enabled = False
Cmd_read.Enabled = False
Cmd_save.Enabled = False
Cmd_exit.Enabled = False
VSgrid.Editable = flexEDNone
Adodc1.Recordset.MoveFirst
For i = 1 To Adodc1.Recordset.RecordCount
   If Adodc1.Recordset.EOF = True Then GoTo R_END
    MSComm1.OutBufferCount = 0 '...清空输出寄存器
    S = Adodc1.Recordset.Fields("地址")
    MSComm1.Output = Sx_str(S) '...发送数据
    Delay (80)
    If i = 11 Or i = 12 Or i = 13 Or i = 14 Then
       a = Rx_str(MSComm1.Input)
       If Len(a) = 1 Then GoTo R_END
       For j = 1 To 4
          Adodc1.Recordset.Fields("当前值") = Val(Mid(a, 5 - j, 1))
          Adodc1.Recordset.Update
          
          Adodc1.Recordset.MoveNext
       Next
       
    Else
        a = Rx_str(MSComm1.Input)
        If a = "!" Then GoTo R_END
        Adodc1.Recordset.Fields("当前值") = Val("&h" & a)
        Adodc1.Recordset.Update
        Adodc1.Recordset.MoveNext
    End If
Next

R_END:
Adodc1.Recordset.MoveFirst
Cmd_read.Enabled = True
Cmd_save.Enabled = True
Cmd_exit.Enabled = True
VSgrid.Enabled = True
End Sub




Private Sub Cmd_save_Click() '传送
Dim S As String
Dim D As String
Dim Check As String
If Write_enable = False Then
   MsgBox ("传送不允许!")
   Exit Sub
End If
VSgrid.Enabled = False
Cmd_read.Enabled = False
Cmd_save.Enabled = False
Cmd_exit.Enabled = False
VSgrid.Editable = flexEDNone
Adodc1.Recordset.MoveFirst

For i = 1 To 10
'   If Adodc1.Recordset.EOF = True Then GoTo R_END
    MSComm1.OutBufferCount = 0 '...清空输出寄存器
    S = Adodc1.Recordset.Fields("当前值")
    D = Adodc1.Recordset.Fields("地址")
    MSComm1.Output = W_str(S, D) '...发送数据
    Delay (200)
    Check = MSComm1.Input
    If Check = "!" Then
       MsgBox ("数值设置错误！请检查")
       GoTo W_END
    End If
    If Check = "" Then
       MsgBox ("通讯错误，请检查通讯电缆连接是否正确！")
        GoTo W_END
    End If
    Adodc1.Recordset.MoveNext

    
Next
For i = 10 To 13
    MSComm1.OutBufferCount = 0 '...清空输出寄存器
    S = ""
    D = Adodc1.Recordset.Fields("地址")
    For j = 1 To 4
      S = S & Trim(Adodc1.Recordset.Fields("当前值"))
      Adodc1.Recordset.MoveNext
    Next
    MSComm1.Output = W4_str(S, D) '...发送数据
    Delay (200)
    Check = MSComm1.Input
    If Check = "!" Then
       MsgBox ("数值设置错误！请检查")
       GoTo W_END
    End If
    If Check = "" Then
       MsgBox ("通讯错误，请检查通讯电缆连接是否正确！")
       GoTo W_END
    End If
    
Next
For i = 13 To 39
'   If Adodc1.Recordset.EOF = True Then GoTo R_END
    MSComm1.OutBufferCount = 0 '...清空输出寄存器
    S = Adodc1.Recordset.Fields("当前值")
    D = Adodc1.Recordset.Fields("地址")
    MSComm1.Output = W_str(S, D) '...发送数据
    If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveNext
    Delay (200)
    Check = MSComm1.Input
    If Check = "!" Then
       MsgBox ("数值设置错误！请检查")
       GoTo W_END
    End If
    If Check = "" Then
       MsgBox ("通讯错误，请检查通讯电缆连接是否正确！")
       GoTo W_END
    End If
Next
W_END:
Adodc1.Recordset.MoveFirst
Cmd_read.Enabled = True
Cmd_save.Enabled = True
Cmd_exit.Enabled = True
VSgrid.Enabled = True
End Sub

Private Sub Form_Load() '...初始化
On Error GoTo MY_END


MSComm1.CommPort = 1 '...使用Com1口

MSComm1.Settings = "9600,n,8,1" '...设置通讯参数

MSComm1.PortOpen = True '...打开串口

VSgrid.ColHidden(9) = True
VSgrid.ColHidden(10) = True
Adodc1.RecordSource = "参数"
'Adodc1.RecordSource = "select * from 参数 where 控制模式 like 'A'"
Adodc1.Refresh

VSgrid.Cell(flexcpBackColor, 1, 8, Adodc1.Recordset.RecordCount, 8) = &HE0E0E0
VSgrid.Cell(flexcpFontBold, 1, 8, Adodc1.Recordset.RecordCount, 8) = True
VSgrid.Cell(flexcpForeColor, 1, 8, Adodc1.Recordset.RecordCount, 8) = &HFF0000
VSgrid.Cell(flexcpAlignment, 0, 1, 0, 8) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 1, Adodc1.Recordset.RecordCount, 1) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 3, Adodc1.Recordset.RecordCount, 3) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 4, Adodc1.Recordset.RecordCount, 4) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 5, Adodc1.Recordset.RecordCount, 5) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 6, Adodc1.Recordset.RecordCount, 6) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 7, Adodc1.Recordset.RecordCount, 7) = flexAlignCenterCenter
VSgrid.Cell(flexcpAlignment, 1, 8, Adodc1.Recordset.RecordCount, 8) = flexAlignCenterCenter
Exit Sub
MY_END:
MsgBox ("请先到控制面板中ODBC数据源设定data.mdb为TSDA")
End Sub

Private Sub VSgrid_AfterEdit(ByVal Row As Long, ByVal Col As Long)
If VSgrid.TextMatrix(Row, Col) = Temp Then Exit Sub
VSgrid.Cell(flexcpBackColor, Row, Col, Row, Col) = &HC0C0FF
End Sub

Private Sub VSgrid_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
Temp = VSgrid.TextMatrix(Row, Col)
End Sub

Private Sub VSgrid_Click()
If Adodc1.Recordset.Fields("定义") <> "" Then
   Lab_sm.Caption = Adodc1.Recordset.Fields("定义")
Else
   Lab_sm.Caption = "无说明"
End If
End Sub


Private Function Sx_str(ByVal str As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim i As Integer
Dim S1 As String
Dim S2 As String
Dim Check_sum As String

a = "&h52" 'R
b = "&h35" '5

S1 = "&h" & Hex(Asc(Left(str, 1)))
S2 = "&h" & Hex(Asc(Right(str, 1)))
Check_sum = Hex(Val(a) + Val(b) + Val(S1) + Val(S2))
Sx_str = "R5" & Trim(str) & Check_sum

End Function

Private Function Rx_str(ByVal str As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim i As Integer
Dim S(7) As String
Dim Check_sum As String

For i = 1 To 7
   
   S(i) = Mid(str, i, 1)
   If S(1) <> "%" Then
      Rx_str = "!"
      MsgBox ("无法读取到数据，请检查通讯电缆后重试！")
      Exit Function
   End If
Next

Check_sum = Hex(Val(Asc(S(1))) + Val(Asc(S(2))) + Val(Asc(S(3))) + Val(Asc(S(4))) + Val(Asc(S(5))))
If Val("&h" & Right(Check_sum, 2)) = Val("&h" & S(6) & S(7)) Then
   Rx_str = S(2) & S(3) & S(4) & S(5)
Else
   MsgBox ("check number error!")
End If

End Function


Private Function W_str(ByVal str As String, ByVal ad As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim i, j As Integer
Dim L As Integer
Dim S(10) As String
Dim buff As Long
Dim Check_sum As String

S(1) = "W" 'W
S(2) = "5" '5
S(3) = Mid(ad, 1, 1)
S(4) = Mid(ad, 2, 1)
    
    a = Hex(Val(str))
    L = Len(a)
    Select Case L
    Case 0
      MsgBox ("数值为空")
    
    Case 1
      S(5) = "0"
      S(6) = "0"
      S(7) = "0"
      S(8) = a
    Case 2
      S(5) = "0"
      S(6) = "0"
      S(7) = Mid(a, 1, 1)
      S(8) = Mid(a, 2, 1)
    Case 3
      S(5) = "0"
      S(6) = Mid(a, 1, 1)
      S(7) = Mid(a, 2, 1)
      S(8) = Mid(a, 3, 1)
    Case 4
      S(5) = Mid(a, 1, 1)
      S(6) = Mid(a, 2, 1)
      S(7) = Mid(a, 3, 1)
      S(8) = Mid(a, 4, 1)
    End Select
    buff = 0
    For j = 1 To 8
        buff = buff + Val(Asc(S(j)))
    Next
    check_num = Hex(buff)
    check_num = Right(check_num, 2)
    W_str = ""
    For j = 1 To 8
        W_str = W_str & S(j)
    Next
    W_str = W_str & check_num


End Function
Private Function W4_str(ByVal str As String, ByVal ad As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim i, j As Integer
Dim L As Integer
Dim S(10) As String
Dim buff As Long
Dim Check_sum As String

S(1) = "W" 'W
S(2) = "5" '5
S(3) = Mid(ad, 1, 1)
S(4) = Mid(ad, 2, 1)
    a = str
S(5) = Mid(a, 4, 1)
S(6) = Mid(a, 3, 1)
S(7) = Mid(a, 2, 1)
S(8) = Mid(a, 1, 1)
buff = 0
For j = 1 To 8
    buff = buff + Val(Asc(S(j)))
Next
check_num = Hex(buff)
check_num = Right(check_num, 2)
W4_str = ""
For j = 1 To 8
    W4_str = W4_str & S(j)
Next
W4_str = W4_str & check_num


End Function


Private Sub VSgrid_RowColChange()
   If Edit_mode = False Then Exit Sub
   If VSgrid.Col = 8 Then
      
      VSgrid.Editable = flexEDKbd
      SendKeys "{ENTER}"
   Else
      VSgrid.FocusRect = flexFocusNone
      VSgrid.Editable = flexEDNone
   End If
End Sub