Jump to content
The simFlight Network Forums


  • Content Count

  • Joined

  • Last visited

Everything posted by Alhashemi

  1. Hi everyone, I need some help in converting BCD to Decimal using Visual Basic 6. I searched the internet for weeks now and couldn't find a code which would convert BCD to Decimal and vice versa. I need it because I need to convert the values of the frequencies after being read by FSUIPC (They are read in BCD) to decimal and then add or subtract according to a specific reading from the parallel port. Anyhow, Visual Basic 6 gives me the decimal representation of the BCD value and I found this article: http://electronicdesign.com/Article/Artfeed=Top20 where it states that the following equation or formula : dbcd = (m*9256 + I*516 + b*26 + cc)*6 + x can be used to convert decimal to BCD. It gives the right answer up to 45. After 46, things start going wrong so in small words. It is not reliable enough. Long story short, I wrote a pretty long code to do the conversion and it works nicely yet it is complicated and difficult to amend. So could any one help me?? is there a VB code such as the dec2bcd code in C++? or is there any equation that would perfectly work? I appreciate your kind help and looking forward to hearing from you...anyone.. Thanks and buy N.B: The long code is as follows, if anyone is interested Option Explicit 'This program is for controlling COM1 Radio with two keys in the keyboard (Alt & Ctrl) Private Sub Form_Load() Dim dwResult As Long Dim Comm1_Radio As Long 'Set COM1 Radio to 118.00Mhz using BCD of 1800 which is 6144 to set the Radio 'frequency as the last digit (1) is considered to be there already Comm1_Radio = 6144 'Send frequency to Radio @ MSFS Call FSUIPC_Write(&H311A, 2, VarPtr(Comm1_Radio), dwResult) Call FSUIPC_Process(dwResult) End Sub Private Sub butOK_Click() Unload frmMain End Sub Private Sub Form_Unload(Cancel As Integer) FSUIPC_Close End Sub Private Sub Timer1_Timer() Dim dwResult As Long Dim Comm1_Radio As Long Dim Modified_Radio As Long 'The 4 Values required at conversion Dim val() As Long ReDim val(4) 'Titles of the 4 Values, val(1), val(2), val(3) and val(4) Dim i As Long 'Required integer (n) for the conversion in sequence Dim n As Long 'Read the frequency and recorded as Comm1_Radio (BCD). To control it, we need to change it to Bin -> Dec (Each 4 bits) '-> Change it -> Binary (Each digit) -> BCD again -> Send it to MSFS If FSUIPC_Read(&H311A, 2, VarPtr(Comm1_Radio), dwResult) Then If FSUIPC_Process(dwResult) Then 'Present Comm1_Radio in the following format lblComm1_Radio.Caption = Format(Comm1_Radio, "0") Else 'No reading lblComm1_Radio.Caption = "Processing: " & ResultText(dwResult) End If Else 'No reading lblComm1_Radio.Caption = "Reading: " & ResultText(dwResult) End If 'Convert the value Comm1_Radio to Binary lblbinary.Caption = DecimalToBinary(Comm1_Radio) 'Add either 2 or 3 0's to make the total 16 bit If Len(lblbinary.Caption) = 13 Then lblbinary.Caption = "000" & lblbinary.Caption ElseIf Len(lblbinary.Caption) = 14 Then lblbinary.Caption = "00" & lblbinary.Caption End If 'Bits: 1, 5, 9 and 13 For n = 1 To 16 Step 4 'Take the following 3 bits after each of the bits mentioned above lbldecimal.Caption = Mid(lblbinary.Caption, n, 4) i = i + 1 'Change each of the values to Decimal val(i) = BinaryToDecimal(lbldecimal.Caption) Next n 'Put the 4 values togather as a number = the frequency in Decimal lbldecimal1.Caption = val(1) & val(2) & val(3) & val(4) 'Check the input Label8.Caption = Inp(&H60) 'Speed the change if the user keeps the same input 'Case 1 input(Increase COMM1 Standby Frequency)******************************************************************* If Label8.Caption = 29 Then Timer1.Interval = Timer1.Interval - 1 If Timer1.Interval < 1 Then Timer1.Interval = 1 End If 'Icrease the lately converted value of COMM1 frequency by 2.5 kHz (Decimal) lblModified_Radio.Caption = lblModified_Radio.Caption + 2.5 ElseIf Label8.Caption = 56 Then Timer1.Interval = Timer1.Interval - 1 If Timer1.Interval < 1 Then Timer1.Interval = 1 End If lblModified_Radio.Caption = lblModified_Radio.Caption - 2.5 Else Timer1.Interval = 50 End If 'Get red of the decimal point without rounding Label9.Caption = CSng(lblModified_Radio.Caption) 'Convert each digit in the latest value to binary For n = 1 To 4 Label11.Caption = Mid(Label9.Caption, n, 1) If Label11.Caption = 0 Then Label12(n - 1) = "0000" Else val(n) = DecimalToBinary(Label11.Caption) Label12(n - 1).Caption = val(n) If Len(Label12(n - 1).Caption) = 1 Then Label12(n - 1).Caption = "000" & val(n) ElseIf Len(Label12(n - 1).Caption) = 2 Then Label12(n - 1).Caption = "00" & val(n) ElseIf Len(Label12(n - 1).Caption) = 3 Then Label12(n - 1).Caption = "0" & val(n) End If End If Next n 'Record the Finally coverted value as one large binary value Label10.Caption = Label12(0).Caption & Label12(1).Caption & Label12(2).Caption & Label12(3).Caption 'Convert that value to decimal to derive the BCD of the new frequency Label14.Caption = BinaryToDecimal(Label10.Caption) Comm1_Radio = Label14.Caption 'Send the new frequency to MSFS Call FSUIPC_Write(&H311A, 2, VarPtr(Comm1_Radio), dwResult) Call FSUIPC_Process(dwResult) End Sub 'Converting Decimal to Binary Public Function DecimalToBinary(ByVal pValue As Long) As String Dim C As Byte Dim SubValue As Long Dim Value As String On Error GoTo ErrorHandler SubValue = (2 ^ 31) - 1 While SubValue > 0 If pValue - SubValue >= 0 Then pValue = pValue - SubValue Value = Value & "1" Else If val(Value) > 0 Then Value = Value & "0" End If SubValue = SubValue / 2 Wend DecimalToBinary = Value Exit Function ErrorHandler: DecimalToBinary = "0" End Function 'Converting Binary to Decimal Public Function BinaryToDecimal(ByVal pValue As String) As Long Dim C As Integer Dim PosValue As Long Dim Value As Long On Error GoTo ErrorHandler PosValue = 1 For C = Len(pValue) To 1 Step -1 If Mid(pValue, C, 1) = "1" Then Value = Value + PosValue PosValue = PosValue * 2 Next BinaryToDecimal = Value Exit Function ErrorHandler: BinaryToDecimal = 0 End Function
  • Create New...

Important Information

By using this site, you agree to our Terms of Use. Guidelines Privacy Policy We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.