?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -