Visual Basic Numbering Functions
Submitted By:
Nad__Af
Rating:





(
Rate It)
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Visual Basic Numbering Systems Functions"
ClientHeight = 3120
ClientLeft = 45
ClientTop = 405
ClientWidth = 4680
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 208
ScaleMode = 3 'Pixel
ScaleWidth = 312
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text2
Height = 285
Left = 1440
TabIndex = 4
Text = "2"
Top = 1800
Width = 1095
End
Begin VB.TextBox Text1
Height = 285
Left = 720
TabIndex = 1
Text = "1200"
Top = 720
Width = 2775
End
Begin VB.CommandButton Command1
Caption = "&Convert"
Height = 495
Left = 1440
TabIndex = 0
Top = 2400
Width = 1095
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "Please enter a radix:"
Height = 255
Left = 1080
TabIndex = 3
Top = 1440
Width = 1815
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "Please enter a decimal number below:"
Height = 255
Left = 600
TabIndex = 2
Top = 360
Width = 3375
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
MsgBox "The quivalent representation of " & Text1 & " in radix " & Text2 & _
" is :" & vbNewLine & vbNewLine & ToRadix2(CDec(Text1), CByte(Text2)), _
vbInformation, "Visual Basic Numbering Systems Functions"
End Sub
Private Sub Text2_GotFocus()
Label2.FontBold = True
End Sub
Private Sub Text2_LostFocus()
Label2.FontBold = False
End Sub
Private Sub Text1_GotFocus()
Label1.FontBold = True
End Sub
Private Sub Text1_LostFocus()
Label1.FontBold = False
End Sub
'The 2nd version of ToRadix converts any number to any radix, because here we've
'assigned the values A, B, C, ... up to twenty ourself; however, this is not
'limited to twenty you can continue assigning as many values as you wish
'NOTE: value returned from function for radix over 10 are always BIG-ENDIANed.
'by: Nadeem Afanah
'e-mail: [[Email Removed]]
Function ToRadix2(ByVal dNum As Variant, ByVal xRad As Byte) As String
Dim length As Variant
Dim sRes As String
Dim sVal As String
Dim temp As Variant
length = (Log(dNum) / Log(xRad)) + 1
If length <> Int(length) Then length = Int(length) + 1
For I = 0 To length - 1
temp = Int(dNum / (pow(xRad, (length - I - 1))))
Select Case temp
Case Is = 10
sVal = "A"
Case Is = 11
sVal = "B"
Case Is = 12
sVal = "C"
Case Is = 13
sVal = "D"
Case Is = 14
sVal = "E"
Case Is = 15
sVal = "F"
Case Is = 16
sVal = "G"
Case Is = 17
sVal = "H"
Case Is = 18
sVal = "I"
Case Is = 19
sVal = "J"
Case Is = 20
sVal = "K"
Case Else
sVal = Int(dNum / (pow(xRad, (length - I - 1))))
End Select
sRes = sRes & sVal
temp = pow(xRad, (length - I - 1))
dNum = dNum - (Int(dNum / temp) * temp)
Next
'the following function removes any leading zeros (if any)
'you can enable the following lines of code, but i might slow down your function
Dim iC As Long
Do
If Left(sRes, 1) = "0" Then
sRes = Mid$(sRes, 2)
Else
Exit Do
End If
Loop
ToRadix2 = sRes
End Function
'=========================================================================================
'The following function is needed to calculate powers of numbers.
Function pow(ByVal Base As Long, ByVal Num As Long) As Variant
Dim I As Long
pow = CDec(Base)
If Num = 0 Then
pow = 1
Exit Function
End If
For I = 1 To Num - 1
pow = pow * Base
Next
End Function