تابع تبدیل عدد BCD به باینری

Private Function BCDToBinary(ByVal lngNum As Long) As String
Dim strResult As String
Dim lngResult1 As Long
Dim strResult2 As String
Dim lngCount As Long

    lngResult1 = lngNum
    lngCount = lngNum

    Do While lngCount > 0
        lngResult1 = lngResult1 Mod 2
        strResult = Trim(strResult) & Trim(Str(lngResult1))
        lngCount = lngCount 2
        lngResult1 = lngCount
    Loop
    For lngCount = Len(strResult) To 1 Step -1
        strResult2 = Trim(strResult2) & Mid(strResult, lngCount, 1)
    Next lngCount
BCDToBinary = Trim(strResult2)
End Function

نظرات 0 + ارسال نظر
برای نمایش آواتار خود در این وبلاگ در سایت Gravatar.com ثبت نام کنید. (راهنما)
ایمیل شما بعد از ثبت نمایش داده نخواهد شد