Джоэл ответил 2 сентября 2016 года :
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. Некоторые радиолюбители Rad ios запрашивают 5 байт.
Большое спасибо за ваш ответ, Джими.
Эта подпрограмма работает, но в обоих случаях 4-байт + 5-байт мой результат BCD неверно Результат без дробной части
4-байтовая функция всегда возвращает 4 байта
5-байтовая функция
возвращает Nr-байтов на основе входных данных -Ценность. В этом случае возвращающие байты должны быть вставлены в правый байт дополнительного 5-байтового массива? Фракция часть является проблемой. Возможно, требуется 2. Вызов функции
В качестве примера попробуйте получить действительный результат с обеими функциями: Входное значение: 439700.11
Я корректирую одиночные возвращаемые значения с "0" перед или позади. Возможно, этого недостаточно.
Частоты: Гц x 1000 = КГц * 1000 = МГц * 1000 = ГГц С 4 байтами мы достигаем 1 ГГц - 1. 999999,99
Данные 1 Данные 2 Данные 3 Данные 4 100/10 Гц 10/1 кГц 1 МГц / 100 кГц 100/10 МГц 01 00 97 43 (439700,01 кГц) 50 00 01 07 (7100,50 кГц)
Пример: 4-байтовый вход функции: sfreq = "7000.00" sfreq = Заменить (sfreq, ".", "") Результат: 00 70 00 00, что неверно Ввод: sfreq = "70000.00" Результат: 00 00 07 00, что неверно
4-байтовый
Dim sp As String = "" '1 пробел Dim ret As Byte () = Новый байт (3) {}' Все байты начинаются с 0 Dim hfreq, sStr As String 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 лет go я написал 2 функции для преобразования в BCD. Обе функции читают любой номер и всегда возвращают правильный результат BCD. Я также использовал эти функции для объяснения логики c, стоящей за преобразованием в BCD.
Я уже не так молод, но все еще программирую для таких радиолюбителей, как я.
Вот 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
'------ --------------------------------------- '---------- -----------------------------------
Последняя процедура с использованием функции ToBcd5, предложенная 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