|
گر عدد N در مبنای ۱۰ باشد و بخواهیم ان را به مبنای ۲ ببریم بجای تقسیمات متوالی بر ۲ عدد را در ۵
بطریق زیر ضرب میکنیم . اگر N زوج باشد با ضرب در ۵ صفر خارج قسمت بعنوان یک رقم بحساب
میاوریم . ولی اگر عدد فرد باشد پس از کسر واحد از ان و ضرب در ۵ از صفرش صرف نظر میکنیم .
با اين كد ميتونين يه عدد رو از مبناي ۲ تا ۳۶ به يه عدد ديگه با مبناي توي همين بازه تبديل كنين.كد از
۳ تا تابع تشكيل شده كه يكيش عدد از از مبناي n به مبناي ۱۰ مياره يكي از مبناي ۱۰ به مبناي n و
سومي هم با ادغام اين ۲ تا تابع يك عدد رو از يك مبنا به مبناي ديگه ميبره.چون عددي كه به اين تابع
ميديم ميتونه مبناش بيشتر از ۱۰ باشه بايد از نوع رشته اي باشه مثلا "FFFFF1" در مبنای 16 یا "
HCAA10" در مبناي ۱۸ يا بيشتر. تابع اول عدد ورودي رو ميگيره بعد مبناي ورودي بعد مبناي خروجي و
جواب رو هم به همون دليلي كه براي وروديش گفتم به صورت رشته برميگردونه:
Public Function BaseNto10(ByVal Number As String, ByVal _
FromBase As Byte) As Long
Dim Number_Base10 As Long
Dim Cnt As Long
Dim NumberLen As Long
Dim Digit As Integer
NumberLen = Len(Number)
For Cnt = 1 To NumberLen
Digit = Asc(UCase$(Mid$(Number, Cnt, 1)))
If (FromBase < 11) Then
If (Digit > 57 Or Digit < 48) Then
BaseNto10 = 0
Exit Function
End If
Else
If (Digit < 48 Or (Digit > 57 And Digit < 65) Or Digit > 54 + FromBase) Then
BaseNto10 = 0
Exit Function
End If
End If
If (Digit > 47 And Digit < 58) Then
Digit = Digit - 48
Else
Digit = Digit - 55
End If
Number_Base10 = Number_Base10 + Digit * FromBase ^ (NumberLen - Cnt)
Next
BaseNto10 = Number_Base10
End Function
Public Function Base10ToN(ByVal Number As Long, ByVal ToBase As Byte) _
As String
Dim Number_NewBase As String
Dim Temp As Long, Reminder As Long
Dim SDigit As String
Temp = Number
Do While (True)
If (Temp < ToBase) Then
If (Temp < 10) Then
SDigit = Temp
Else
SDigit = Chr$(55 + Temp)
End If
Number_NewBase = SDigit & Number_NewBase
Exit Do
End If
Reminder = Temp Mod ToBase
Temp = Temp \ ToBase
If (Reminder < 10) Then
SDigit = Reminder
Else
SDigit = Chr$(55 + Reminder)
End If
Number_NewBase = SDigit & Number_NewBase
Loop
Base10ToN = Number_NewBase
End Function
Public Function ChangeBase(ByVal Number As String, ByVal _
FromBase As Byte, ByVal ToBase As Byte) As String
ChangeBase = Base10ToN(BaseNto10(Number, FromBase), ToBase)
End Function
براي استفاده از تابع هم , مثلا براي بردن عدد "123456" از مبنای 7 به مبنای 2 از این کد میشه استفاده کرد : Call MsgBox(ChangeBase("123456", 7, 2))
|
با اين برنامه كوچك قادر خواهيد بود كه اعداد مبناي 2، مبناي 8، مبناي 16 و كد اسكي معادل آنها را به طور همزمان يكجا داشته باشيد. عدد مي تواند در فرم هاي 4 بيتي، 8 بيتي، 16 بيتي و 32 بيتي باشد. همچنين با يك كليك مي توانيد معكوس عدد ، شيفت به راست و شيفت به چپ عدد را هم ببينيد. چرخش عدد به راست و چپ هم يكي از قابليتهاي جالب اين برنامه كوچك است. نتايج بر روي همه قسمتها، همزمان و با تغيير هر كدام از قسمتها تغيير مي كنند.
دانلود برنامه : 