Utilizamos Cookies de terceros para generar estadísticas de audiencia y mostrar publicidad personalizada analizando tu navegación. Si sigues navegando estarás aceptando su uso. Más información X
PortadaForo AyudaTutoriales
Trucos Conversión numérica (Visual Basic)

Conversión numérica (Visual Basic)

Autor: Enviado por: Hurricane - Enviado con fecha: 27-04-2005 20:13:24.
Las siguientes funciones les van a servir para realizar conversiones numéricas de Decimal a una base cualquiera y viceversa.


Const NumChars = "0123456789ABCDEF"

Rem Transforma un número en decimal
Rem S = Número (cualquier base)
Rem NumBase = Número de la Base
Rem 2=Binario, 8=Octal, 10=Decimal, 16=Hexadecimal
Rem Si hay un error, retorna -1.
Function ToDec(ByVal S As String, ByVal NumBase As Integer) As Long
Dim R As Long, I As Integer, P As Integer
R = -1
S = UCase(S)
If (NumBase = 2) Or (NumBase = 8) Or (NumBase = 10) Or (NumBase = 16) Then
R = 0
For I = 1 To Len(S)
P = InStr(NumChars, Mid(S, I, 1))
If (P = 0) Or (P > NumBase) Then
R = -1
Exit For
End If
R = R + (P - 1) * (NumBase ^ (Len(S) - I))
Next I
End If
ToDec = R
End Function


Rem Transforma un número decimal en otras bases
Rem N = Número a convertir
Rem NumBase = Número de la Base
Rem 2=Binario, 8=Octal, 10=Decimal, 16=Hexadecimal
Rem Si hay un error, retorna una cadena vacía.
Function FromDec(ByVal N As Long, ByVal NumBase As Integer) As String
Dim S As String
S = ""
If ((NumBase = 2) Or (NumBase = 8) Or (NumBase = 10) Or (NumBase = 16)) And (N >= 0) Then
Do
S = Mid(NumChars, (N Mod NumBase) + 1, 1) + S
N = Fix(N / NumBase)
Loop Until (N = 0)
End If
FromDec = S
End Function


Rem Convierte de Cualquier base a cualquier base.
Rem N = Núero a convertir
Rem fromBase = Base de origen (2, 8, 10, 16)
Rem toBase = base destino (2, 8, 10, 16)
Function Convert(ByVal N As String, ByVal fromBase As Integer, ToBase As Integer) As String
Dim Nm As Long, S As String
Nm = ToDec(N, fromBase)
If (Nm = -1) Then
S = ""
Else
S = FromDec(Nm, ToBase)
End If
Convert = S
End Function



Espero les sea de utilidad. Saludos ;-)
InicioBlog
^ SubirAviso legal
Política Privacidad
Configurarequipos20 Octubre 2019