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
The trick here is to be aware that simply using pValue /= 10 will round the value so if for instance the argument is "16", the first part of the byte will be correct, but the result of the division will be 2 (as 1.6 will be rounded up). Therefore I use the Math.Floor method.
This function is working perfectly and i'm using the result also in a reverse order. I've tried several adjustments, but something i'm missing.
My question is:
Is it possible to extend the 4 Byte upto 5 Bytes? I'm using it for converting Frequencies to BCD. Some Radio Amateur Radios are requesting 5 Bytes.
Many thanks for your answer Jimi.
This Routine is working but in both cases, 4-Bytes + 5-Bytes my Result BCD is wrong Result without Fraction part
The 4-Byte function is always returning 4 Bytes
The 5-Byte function
is returning Nr-of-Bytes based on the Input-Value. In this case the returning bytes must inserted into the right Byte of a addition 5-Byte array ? The Fraction part is a problem. Maybe it requires a 2. Function Call
By Example try to get a valid result with both functions: Input value: 439700.11
I'm adjusting the single return values with "0" in front or behind. Maybe not enough.
Frequencies: Hz x 1000 = Khz * 1000 = MHz * 1000 = GHz With 4 Bytes we reach 1 GHz - 1. 999999.99
Data 1 Data 2 Data 3 Data 4 100/10Hz 10/1 KHz 1MHz/100KHz 100/10MHz 01 00 97 43 (439700.01 KHz) 50 00 01 07 (7100.50 KHz)
Example: 4-Byte Function Input: sfreq = "7000.00" sfreq = Replace(sfreq,".","") Result: 00 70 00 00 which is wrong Input: sfreq = "70000.00" Result: 00 00 07 00 which is wrong
4-Byte
Dim sp As String = " " '1 space Dim ret As Byte() = New Byte(3) {} 'All bytes are init with 0's Dim hfreq, sStr As String Dim ddouble As Double Dim ssfreq As String = "700000" 'we input always decimals #####.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
I would like to use this 2 Functions as i believe they are faster then my own Functions. 10 years ago i wrote 2 Functions for converting to BCD. Both Functions are reading any Number and returning always the right BCD result. I also used this Functions for explaining the logic behind the conversion to BCD.
I'm not that young anymore but still programming for Radio Amatuers like me.
Here the 2 Functions sfreq must be "7000" or "7000.01" NOT "7.000,01" You Call: hfreq = SendHexStr(sfreq) You Call: 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
'--------------------------------------------- '---------------------------------------------
The final procedure using the ToBcd5 Function proposed by Jimi
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
End Sub
