datatransform.bas

主要用于控制三相电能表检验装置

Attribute VB_Name = "Module1"
Function StringToHex(sts As String, BY() As Byte) As Integer
     Dim STtemp As String
     Dim j As Integer
     j = 0
     Dim st As String
     st = sts
     st = Trim(st)
nex:
     If Len(st) >= 2 Then
        STtemp = Left(st, 2)
        st = Right(st, Len(st) - 2)
        BY(j) = StringTwoToHex(STtemp) '高位在前
        j = j + 1
        GoTo nex
     End If
     StringToHex = j
End Function
Function StringTwoToHex(Data As String) As Byte
Dim Data1 As Byte
 Data1 = 0
 Data = Trim(Data)
 If (Len(Data) = 1) Then
 GoTo rightdeal
 End If
 Data = LCase(Data)
 If Left(Data, 1) = "0" Then
 Data1 = 0
 ElseIf Left(Data, 1) = "1" Then
 Data1 = &H10
 ElseIf Left(Data, 1) = "2" Then
 Data1 = &H20
 ElseIf Left(Data, 1) = "3" Then
 Data1 = &H30
 ElseIf Left(Data, 1) = "4" Then
 Data1 = &H40
 ElseIf Left(Data, 1) = "5" Then
 Data1 = &H50
 ElseIf Left(Data, 1) = "6" Then
 Data1 = &H60
 ElseIf Left(Data, 1) = "7" Then
 Data1 = &H70
 ElseIf Left(Data, 1) = "8" Then
 Data1 = &H80
 ElseIf Left(Data, 1) = "9" Then
 Data1 = &H90
 ElseIf Left(Data, 1) = "a" Then
 Data1 = &HA0
 ElseIf Left(Data, 1) = "b" Then
 Data1 = &HB0
 ElseIf Left(Data, 1) = "c" Then
 Data1 = &HC0
 ElseIf Left(Data, 1) = "d" Then
 Data1 = &HD0
 ElseIf Left(Data, 1) = "e" Then
 Data1 = &HE0
 ElseIf Left(Data, 1) = "f" Then
 Data1 = &HF0
 
 End If
rightdeal:
 If Right(Data, 1) = "0" Then
 Data1 = Data1 Xor &H0
 ElseIf Right(Data, 1) = "1" Then
 Data1 = Data1 Xor &H1
 ElseIf Right(Data, 1) = "2" Then
 Data1 = Data1 Xor &H2
 ElseIf Right(Data, 1) = "3" Then
 Data1 = Data1 Xor &H3
 ElseIf Right(Data, 1) = "4" Then
 Data1 = Data1 Xor &H4
 ElseIf Right(Data, 1) = "5" Then
 Data1 = Data1 Xor &H5
 ElseIf Right(Data, 1) = "6" Then
 Data1 = Data1 Xor &H6
 ElseIf Right(Data, 1) = "7" Then
 Data1 = Data1 Xor &H7
 ElseIf Right(Data, 1) = "8" Then
 Data1 = Data1 Xor &H8
 ElseIf Right(Data, 1) = "9" Then
 Data1 = Data1 Xor &H9
 ElseIf Right(Data, 1) = "a" Then
 Data1 = Data1 Xor &HA
 ElseIf Right(Data, 1) = "b" Then
 Data1 = Data1 Xor &HB
 ElseIf Right(Data, 1) = "c" Then
 Data1 = Data1 Xor &HC
 ElseIf Right(Data, 1) = "d" Then
 Data1 = Data1 Xor &HD
 ElseIf Right(Data, 1) = "e" Then
 Data1 = Data1 Xor &HE
 ElseIf Right(Data, 1) = "f" Then
 Data1 = Data1 Xor &HF
 
 End If
 StringTwoToHex = Data1
End Function
Function StringHexToLong(st As String) As Long
    Dim temp(1) As Byte
    Dim redata As Long
    Dim temps As String
    temps = st
    StringToHex temps, temp
    redata = temp(0)
    redata = redata * 256
    redata = redata + temp(1)
    StringHexToLong = redata
End Function

Function ProcRDSTDVariableCommd()

End Function
Function HexToBCD(dd As Double, XiaoShuGeShu As Byte) As String
    Dim i As Long
    Dim k As Byte
    Dim st(5) As String
    Dim stt As String
    Dim fuhao As String
    Dim xiaos As String
    stt = ""
    If dd < 0 Then
          fuhao = "-"
          dd = -dd
    Else
         stt = ""
         fuhao = ""
    End If
    If dd > 100000000 Then
      Exit Function
    End If
    i = dd \ 100000000
    stt = stt & Format(i)
    dd = dd - i * 100000000
    
    i = dd \ 10000000
    stt = stt & Format(i)
    dd = dd - i * 10000000
    
    i = dd \ 1000000
    stt = stt & Format(i)
    dd = dd - i * 1000000
    
    i = dd \ 100000
    stt = stt & Format(i)
    dd = dd - i * 100000
    
    i = dd \ 10000
    stt = stt & Format(i)
    dd = dd - i * 10000
    
    i = dd \ 1000
    stt = stt & Format(i)
    dd = dd - i * 1000
    
    i = dd \ 100
    stt = stt & Format(i)
    dd = dd - i * 100
    
    i = dd \ 10
    stt = stt & Format(i)
    dd = dd - i * 10
    
    i = dd
    stt = stt & Format(i)
    If XiaoShuGeShu > 0 Then
        xiaos = Right(stt, XiaoShuGeShu)
        stt = Left(stt, Len(stt) - XiaoShuGeShu)
    End If
cccc:
    If Len(stt) > 1 Then

    If Left(stt, 1) = "0" Then
        stt = Right(stt, Len(stt) - 1)
        GoTo cccc
    End If
    End If
    stt = fuhao & stt & "." & xiaos
    HexToBCD = stt
    
    
End Function