Public Shared Function ToBcd(ByVal pValue As Integer) As Byte()
If pValue < 0 OrElse pValue > 99999999 Then Throw New ArgumentOutOfRangeException("value")
Dim ret As Byte() = New Byte(3) {} 'All bytes are init with 0's
For i As Integer = 0 To 3
ret(i) = CByte(pValue Mod 10)
pValue = Math.Floor(pValue / 10.0)
ret(i) = ret(i) Or CByte((pValue Mod 10) << 4)
pValue = Math.Floor(pValue / 10.0)
If pValue = 0 Then Exit For
Next
Return ret
End Function
这里的技巧是要知道，简单地使用pValue / = 10将舍入该值，因此，例如，如果参数为“ 16”，则字节的第一部分将是正确的，但除法的结果将是2（因为1.6将四舍五入）。因此，我使用Math.Floor方法。
此功能运行正常，我也以相反的顺序使用结果。我已经尝试了几次调整，但是却缺少一些东西。
我的问题是：
是否可以将4字节扩展到5字节？ 我正在使用它来将频率转换为BCD。 一些业余无线电广播请求5个字节。
非常感谢您的回答Jimi。
此例程有效，但在两种情况下，我的4字节+ 5字节 结果BCD错误 没有分数部分的结果
4字节函数始终返回4字节
根据输入值返回Nr-of-Bytes。在这种情况下，返回的字节必须插入到 对5个字节数组的附加字节？ 小数部分是个问题。可能需要一个2.函数调用
通过示例尝试使用两个函数获得有效的结果： 输入值：439700.11
我正在将单返回值调整为前面或后面的“ 0”。也许还不够。
频率：Hz x 1000 = Khz * 1000 = MHz * 1000 = GHz 有了4个字节，我们达到1 GHz-1。999999.99
数据1数据2数据3数据4 100 / 10Hz 10/1 KHz 1MHz / 100KHz 100 / 10MHz 01 00 97 43（439700.01 KHz） 50 00 01 07（7100.50 KHz）
示例：4字节功能 输入：sfreq =“ 7000.00” sfreq = Replace（sfreq，“。”，“”） 结果：00 70 00 00这是错误的 输入：sfreq =“ 70000.00” 结果：00 00 07 00这是错误的
Dim sp As String =“”'1个空格 Dim ret As Byte（）= New Byte（3）{}'所有字节都初始化为0 Dim hfreq，sStr作为字符串 Dim ddouble As Double Dim ssfreq As String =“ 700000”'我们始终输入小数点#####。00
hfreq = ""
ret = ToBcd(Val(ssfreq))
For i As Integer = 0 To 3
sStr = Hex(ret(i))
'just for testing
value = Val("&H" & sStr)
value = Int(value / 16)
MsgBox(value.ToString())
'maybe byte values should adjusted based on the value
'or based on the total value string-Length
If Len(sStr) = 1 Then
If sStr = "0" Then
sStr = sStr + "0"
Else
sStr = "0" & sStr
End If
End If
hfreq = hfreq + sStr & sp 'sp = 1 space
Next
hfreq = Trim(hfreq)
'the 4-Byte answer
'00 70 00 00
'convert to number
Dim counter As Integer = 7
sStr = Replace(hfreq, " ", "")
Dim s1 As String = sStr
sStr = ""
While counter > 0 'read BCD/HEx from right to left
sStr = sStr & Mid$(s1, counter, 2)
counter = counter - 2
If counter = 0 Then counter = 1
End While
value = Val(sStr) ' with the right result the value must be divided / 100
我想使用这2个函数，因为我认为它们比我自己的函数要快。 10年前，我写了2个函数转换为BCD。 两种功能均读取任何数字并始终返回正确的BCD结果。 我还使用此函数解释了转换为BCD的逻辑。
我已经不那么年轻了，但是仍然为像我这样的Radio Amatuers编程。
这里有2个功能 sfreq必须为“ 7000”或“ 7000.01”，而不是“ 7.000,01” 您调用：hfreq = SendHexStr（sfreq） 您调用：hfreq = SendHexStr4Byte（sfreq）
Private Sub InsertDec4Byte(ByVal frac)
Dim dd As Double
Dim freqfrac As String = frac
If frac Then
Dim f1, f2, h2 As Double
'even 50 even
dd = Val(freqfrac)
f1 = Val(shex4(1)) '10
f2 = Val(Mid(freqfrac, 1, 2)) '50
If (dd Mod 10 = 0) Then
'0.50
f2 = f2 / 10 '5
h2 = f1 + f2
If h2 < 10 Then
shex4(1) = "0" & h2.ToString() '15
Else
shex4(1) = h2.ToString() '15
End If
Else
'51 - Odd
f2 = Val(Mid(freqfrac, 1, 1)) '5
h2 = f1 + f2 ' 10 + 5
If h2 < 10 Then
shex4(1) = "0" & h2.ToString() '15
Else
shex4(1) = h2.ToString() '15
End If
f2 = Val(Mid(freqfrac, 2, 1)) '1
f2 = f2 * 10
shex4(0) = f2 '10 = 0.01
End If
End If
End Sub
'Hex 4 Byte
Private Function SendHexStr4Byte(ByVal hs)
Dim sStr As String = ""
Dim s1 As String = ""
Dim freq As String = ""
Dim freqfrac As String = ""
Dim ppos As Integer = 0
Dim frac As Boolean = False
'fill the array with Hex '00'
For i As Integer = 0 To 3
shex4(i) = "00"
Next
freq = hs
freq = Replace(freq, ",", ".")
s1 = freq
'copy the fraction part if any - 500.01 - 501.50
ppos = InStr(1, freq, ".", CompareMethod.Text)
If ppos > 0 Then
'copy only the integer part as frequency
s1 = Mid(s1, 1, ppos - 1)
'the fraction part
freqfrac = Mid(freq, ppos + 1, Len(freq) - ppos)
'correct input error
If Len(freqfrac) = 1 Then freqfrac = freqfrac & "0"
If Len(freqfrac) = 0 Then freqfrac = freqfrac & "00"
frac = Not frac 'fraction part = true 0.01..0.99
End If
'final hex-str array position is depending on the freq value
'insert the Hex str into array with inverted order from right to left = the final string
Dim dd As Double = 0
Dim bitpos As Integer = 1 'default Hex-array position
Dim le As Integer = Len(s1)
Dim v1000, v100, vdec As Integer
If le = 3 Then 'value is multiplied by 100
' below 1000 and over 99.99
'00 00 30 00 00 = 300
'00 10 30 00 00 = 301
'00 10 31 00 00 = 311
v100 = Val(Mid(s1, 1, 2))
vdec = Val(Mid(s1, 3, 1))
ElseIf le = 4 Then
'Freq Integer over 999.99 and below 10.000
'9900 - value * 1000
v1000 = Val(Mid(s1, 1, 1))
v100 = Val(Mid(s1, 2, 2))
vdec = Val(Mid(s1, 4, 1))
'freq Integer over 9999.99 and below 100.000,00
ElseIf le = 5 Then
'12345
v1000 = Val(Mid(s1, 1, 2))
v100 = Val(Mid(s1, 3, 2))
vdec = Val(Mid(s1, 5, 1))
End If
If le = 3 Then 'value is multiplied by 10
'310
' hex array position 0 1 2 3 4 | 2 1 0
'we use only the first 3 byte |10 15 31| 00 00 = 310 + 1.50 + 0.01 (10/10)
'first 2
bitpos = 1
shex4(3 - bitpos) = v100.ToString()
bitpos = bitpos + 1
'bitpos start with 3 = byte 1
ElseIf le = 4 Then 'value is multiplied by 1000
shex4(3 - bitpos) = "0" & v1000.ToString() 'is less then 10, below 10.000
bitpos = bitpos + 1
'bitpos start with 2 = byte 2
ElseIf le = 5 Then 'value is multiplied by 10000
shex4(3 - bitpos) = v1000.ToString() 'is > 9999.99 and less then 100.000
bitpos = bitpos + 1
End If
'123
If le = 3 Then
' + vdec
If vdec * 10 > 0 Then _
shex4(3 - bitpos) = vdec * 10.ToString()
If frac Then
InsertDec4Byte(freqfrac)
End If
End If
'1234, 12345
If (le = 4 Or le = 5) Then
' + v100 + vdec
If v100 < 10 Then
sStr = "0" & v100.ToString
Else
sStr = v100.ToString
End If
If v100 > 0 Then _
shex4(3 - bitpos) = sStr.ToString()
'else we do not consider, Hex value = already "00"
bitpos = bitpos + 1
If vdec * 10 > 0 Then _
shex4(3 - bitpos) = vdec * 10.ToString()
If frac Then
InsertDec4Byte(freqfrac)
End If
End If
If bcdinverted Then
sStr = ""
For i As Integer = 3 To 0 Step -1
sStr = sStr & shex4(i).ToString() & " "
Next
Else
sStr = ""
For i As Integer = 0 To 3
sStr = sStr & shex4(i).ToString() & " "
Next
End If
Return sStr
End Function
Private Sub InsertDec(ByVal frac)
Dim dd As Double
Dim freqfrac As String = frac
If frac Then
Dim f1, f2, h2 As Double
'even 50 even
dd = Val(freqfrac)
f1 = Val(shex5(1)) '10
f2 = Val(Mid(freqfrac, 1, 2)) '50
If (dd Mod 10 = 0) Then
'0.50
f2 = f2 / 10 '5
h2 = f1 + f2
If h2 < 10 Then
shex5(1) = "0" & h2.ToString() '15
Else
shex5(1) = h2.ToString() '15
End If
Else
'51 - Odd
f2 = Val(Mid(freqfrac, 1, 1)) '5
h2 = f1 + f2 ' 10 + 5
If h2 < 10 Then
shex5(1) = "0" & h2.ToString() '15
Else
shex5(1) = h2.ToString() '15
End If
f2 = Val(Mid(freqfrac, 2, 1)) '1
f2 = f2 * 10
shex5(0) = f2 '10 = 0.01
End If
End If
End Sub
Private Function SendHexStr(ByVal hs) As String
Dim sStr As String = ""
Dim s1 As String = ""
Dim freq As String = ""
Dim freqfrac As String = ""
Dim ppos As Integer = 0
Dim frac As Boolean = False
'fill the array with Hex '00'
For i As Integer = 0 To 4
shex5(i) = "00"
Next
freq = hs
freq = Replace(freq, ",", ".")
s1 = freq
'copy the fraction part if any - 500.01 - 501.50
ppos = InStr(1, freq, ".", CompareMethod.Text)
If ppos > 0 Then
'copy only the integer part as frequency
s1 = Mid(s1, 1, ppos - 1)
'the fraction part
freqfrac = Mid(freq, ppos + 1, Len(freq) - ppos)
'correct input error
If Len(freqfrac) = 1 Then freqfrac = freqfrac & "0"
If Len(freqfrac) = 0 Then freqfrac = freqfrac & "00"
frac = Not frac 'fraction part = true 0.01..0.99
End If
'final hex-str array position is depending on the freq value
'insert the Hex str into array with inverted order from right to left = the final string
Dim dd As Double = 0
Dim bitpos As Integer = 1 'default Hex-array position
Dim le As Integer = Len(s1)
Dim v100000, v1000, v100, vdec As Integer
If le = 3 Then 'value is multiplied by 100
' below 1000 and over 99.99
'00 00 30 00 00 = 300
'00 10 30 00 00 = 301
'00 10 31 00 00 = 311
v100 = Val(Mid(s1, 1, 2))
vdec = Val(Mid(s1, 3, 1))
ElseIf le = 4 Then
'Freq Integer over 999.99 and below 10.000
'9900 - value * 1000
v1000 = Val(Mid(s1, 1, 1))
v100 = Val(Mid(s1, 2, 2))
vdec = Val(Mid(s1, 4, 1))
'freq Integer over 9999.99 and below 100.000,00
ElseIf le = 5 Then
'12345
v1000 = Val(Mid(s1, 1, 2))
v100 = Val(Mid(s1, 3, 2))
vdec = Val(Mid(s1, 5, 1))
'freq Integer upto > 999.999,99
ElseIf le = 6 Then
'123456
v100000 = Val(Mid(s1, 1, 1))
v1000 = Val(Mid(s1, 2, 2))
v100 = Val(Mid(s1, 4, 2))
vdec = Val(Mid(s1, 6, 1))
'freq Integer upto > 1.999.999,99 stop x ICOM R 8500
ElseIf le = 7 Then
'1234567
v100000 = Val(Mid(s1, 1, 2))
v1000 = Val(Mid(s1, 3, 2))
v100 = Val(Mid(s1, 5, 2))
vdec = Val(Mid(s1, 7, 1))
End If
If le = 3 Then 'value is multiplied by 10
'310
' hex array position 0 1 2 3 4 | 2 1 0
'we use only the first 3 byte |10 15 31| 00 00 = 310 + 1.50 + 0.01 (10/10)
bitpos = 2
shex5(4 - bitpos) = v100.ToString()
bitpos = bitpos + 1
'bitpos start with 3 = byte 1
ElseIf le = 4 Then 'value is multiplied by 1000
shex5(4 - bitpos) = "0" & v1000.ToString() 'is less then 10, below 10.000
bitpos = bitpos + 1
'bitpos start with 2 = byte 2
ElseIf le = 5 Then 'value is multiplied by 10000
shex5(4 - bitpos) = v1000.ToString() 'is > 9999.99 and less then 100.000
bitpos = bitpos + 1
'bitpos start with 2 = byte 2
ElseIf le = 6 Then 'upto 999.999,99
shex5(4) = "0" & v100000.ToString()
'bitpos start with 1 = byte 3
ElseIf le = 7 Then 'upto 1.999.999,99 ICOM R8500 limit
'90 78 56 34 12 = 1,234,567,89
shex5(4) = v100000.ToString()
'bitpos start with 1 = byte 3
End If
'123
If le = 3 Then
' + vdec
If vdec * 10 > 0 Then _
shex5(4 - bitpos) = vdec * 10.ToString()
If frac Then
InsertDec(freqfrac)
End If
End If
'1234, 12345
If (le = 4 Or le = 5) Then
' + v100 + vdec
If v100 < 10 Then
sStr = "0" & v100.ToString
Else
sStr = v100.ToString
End If
If v100 > 0 Then _
shex5(4 - bitpos) = sStr.ToString()
'else we do not consider, Hex value = already "00"
bitpos = bitpos + 1
If vdec * 10 > 0 Then _
shex5(4 - bitpos) = vdec * 10.ToString()
If frac Then
InsertDec(freqfrac)
End If
End If
'123456 + 1234567
If le = 6 Or le = 7 Then
' + v1000 + v100 + vdec
If v1000 > 9 Then
shex5(4 - bitpos) = v1000.ToString()
bitpos = bitpos + 1
Else
shex5(4 - bitpos) = "0" & v1000.ToString()
bitpos = bitpos + 1
End If
If v100 < 10 Then
sStr = "0" & v100.ToString
Else
sStr = v100.ToString
End If
If v100 > 0 Then _
shex5(4 - bitpos) = sStr.ToString()
'else we do not consider, Hex value = already "00"
bitpos = bitpos + 1
If vdec * 10 > 0 Then _
shex5(4 - bitpos) = vdec * 10.ToString()
If frac Then
InsertDec(freqfrac)
End If
End If
sStr = ""
For i As Integer = 0 To 4
sStr = sStr & shex5(i).ToString() & " "
Next
Return sStr
End Function
'--------------------------------------------- '---------------------------------------------
Jimi提出的使用ToBcd5函数的最终过程
Private Sub HexFreq5Byte(ByVal sfreq)
'Using the ToBcd5 Function proposed by Jimi
'
'This procedure is only returning the correct Number considering the Fraction part
'For a use where always 5 bytes are requested this procedure must be extended
' and the returned bytes must be inserted into a 5-Byte BCD.
' A Radio connected to a Com-Port is always requesting a FIX BCD-Byte number.
' We must transmit and receive Bytes together with other Parameters.
'
' I will have to do that extension
Dim pPos As Integer = 0
Dim frac As Boolean = False
Dim value As Double = 0.0
Dim ssfreq As String = Replace(sfreq, ",", ".")
Dim sStr As String = ""
Dim hfreq As String = ""
Dim sp As String = " " '1 space dividing bytes
'eventual correction
ssfreq = Replace(ssfreq, ",", ".")
Try
'Adjust the Fraction part
'When Fraction (frac) is True the end result must be divided by 100
pPos = InStr(1, ssfreq, ".", CompareMethod.Text)
If pPos > 0 Then
'the fraction part
sStr = Mid(ssfreq, pPos + 1, Len(ssfreq) - pPos)
'correct input error
If Len(sStr) = 1 Then ssfreq = ssfreq & "0"
If Len(sStr) = 0 Then ssfreq = ssfreq & "00"
frac = Not frac 'fraction part = true 0.01..0.99
End If
hfreq = ""
sStr = ""
ssfreq = Replace(sfreq, ".", "")
ssfreq = Replace(sfreq, ",", "")
'get the BCD Bytes
'the function is returning the nr of bytes used as "bcd5bytes"
Dim ret As Byte() = New Byte(bcd5bytes) {}
ret = ToBcd5(Val(ssfreq))
sStr = ""
'Adjust the Byte with "0" in front or behind
For i As Integer = 0 To bcd5bytes - 1
sStr = Hex(ret(i))
If Len(sStr) = 1 Then
If sStr = "0" Then
sStr = sStr + "0"
Else
sStr = "0" & sStr
End If
End If
'insert a space between the bytes if you need it
hfreq = hfreq + sStr & sp 'sp = 1 space
Next
hfreq = Trim(hfreq)
'cut the spaces between the bytes x adding values
hfreq = Replace(hfreq, " ", "")
'Convert to Number
'2 Byte = 4 Digit. Read first the last byte pos 3 + 4
'counter is a double to get out of the 'While loop'.
Dim counter As Double = bcd5bytes * 2 - 1
Dim s1 As String = hfreq
sStr = ""
While counter > 0 'read BCD/Byte from right to left
sStr = sStr & Mid$(s1, counter, 2)
counter = counter - 2
If counter = 0 Then counter = 1
End While
'adjust the return value and the fraction part if any
value = Val(sStr)
If value > 0.0 Then
If frac Then value = value / 100
'The end result
sStr = value.ToString("f2")
End If
Catch ex As Exception
MsgBox("Value exceeding Frequency maximum.")
End Try
结束子