module1.bas

modbus协议的应用版本

Attribute VB_Name = "Module1"
Public fx() As Byte
Public shuju As Variant
Public Type A_single
    dblValue As Single
End Type
Public Type a_ByteAry
    ByteVal(0 To 3) As Byte
End Type
Public errt As String
'modbus规约（校验）
Public Function CrcResult(ByVal Data As Long, ByVal Genpoly As Long, ByVal CrcData As Long) As Long
    Dim TmpI As Integer
    Data = Data * 2
    For TmpI = 8 To 1 Step -1
        Data = Fix(Data / 2)
        
        If ((Data Xor CrcData) And 1) Then
            CrcData = Fix(CrcData / 2) Xor Genpoly
        Else
            CrcData = Fix(CrcData / 2)
        End If
        
    Next TmpI
    CrcResult = CrcData
End Function
'浮点数转换，结果显示四位数
Public Function fresult() As String
Dim byteAry As a_ByteAry
Dim dbl As A_single
For i = 0 To 3
   byteAry.ByteVal(3 - i) = Val(shuju(i + 3))
Next i
LSet dbl = byteAry
S = dbl.dblValue
If S < 1000 Then
   s0 = S
   s1 = "  "
ElseIf S > 1000 And S < 1000000 Then
   s0 = S / 1000
   s1 = " k"
ElseIf S > 1000000 Then
   s0 = S / 1000000
   s1 = " m"
End If
S = CStr(s0)
rep:
If InStr(1, S, ".") = 1 Then S = "0" + S
s0 = InStr(1, S, ".")
Select Case Len(S)
Case Is > 4
    If s0 < 5 And s0 > 0 Then
        If Val(Mid(S, 6, 1)) > 5 Then
        S = CStr(Round(Val(S), 5 - s0))
        GoTo rep
        Else
        fresult = Left(S, 5) + s1
        End If
    Else
        If Val(Mid(S, 5, 1)) > 5 Then
        fresult = Left(S, 3) + CStr(Val(Mid(S, 4, 1)) + 1) + s1
        Else
        fresult = Left(S, 4) + s1
        End If
    End If
Case Is = 4
    If s0 > 0 Then
    fresult = S + "0" + s1
    Else
    fresult = S + s1
    End If
Case Is = 3
    If s0 > 0 Then
    fresult = S + "00" + s1
    Else
    fresult = S + ".0" + s1
    End If
Case Is = 2
    If s0 > 0 Then
       fresult = S + "000" + s1
    Else
       fresult = S + ".00" + s1
    End If
Case Is = 1
    fresult = S + ".000" + s1
End Select
End Function