*/
Looking for work? Check out our jobs area.
*/

View VB Demo\Form1.frm

Visual Basic Numbering Functions

Submitted By: Nad__Af
Rating: starstarstarstarstar (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

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.