*******
Funciones de Conversion DECIMAL-BINARIO; BINARIO-DECIMA y HEXADECIMAL-DECIMAL
*******
*/ LAS CINCO FUNCIONES DEBERAN INCLUIRSE EN LA LIBRERIA */
*---------------- codigo fuente -------------------------*
*/ prBinario.Fnt() */
* 20/Noviembre de 2001 -
* Actualizacion: Agosto 2002
* Procedimientos para obtener el valor decimal de cadenas binarias */
Function prBinario
Parameters cBinaryString
Local aValores, cClonedString, nAcumul, nValorDecimal, nAplicaDecimales
Declare aValores (30,3)
nAcumul = 0
nValorDecimal = 0.000000000000000000
Store 0 To aValores
nAplicaDecimales = 0
*/ (1) Determinamos la matriz de datos */
For i= 0 To Alen(aValores,1)-1
If i > Alen(aValores,1) Then
Exit
Endif
nAplicaDecimales = Iif(nAplicaDecimales = 0, nAplicaDecimales + 2, nAplicaDecimales
* 2)
aValores[i+1,1] = 2^i
aValores[i+1,2] = 1/nAplicaDecimales
Next
If Len(cBinaryString) > 25 Then
* Esto es configurable, pero 25 caracteres es mas que suficiente, segun
mi experiencia ...
Wait window 'Favor de verificar la cadena, ya que esta es demasiado larga!!'
timeout 5
?? Chr(7)
Wait Clear
Return (0)
EndIf
*/ Determinar si hay o no caracteres decimales en la cadena binaria */
If At('.',cBinarystring) > 0 Then
cParteEntera = Left(cBinarystring,At('.',cBinarystring)-1)
cParteDecimal = SubStr(cBinaryString,at('.',cBinaryString)+1,Len(cBinaryString)-at('.',cBinaryString))
cClonedString = GetMirror(cParteEntera)
Else
*/ (2) - Procemos a calcular en base a la longitud de la cadena */
*/ ---> Invertimos el orden de los caracteres para calcular consecutivo
*/
cParteEntera = ''
cParteDecimal = ''
cClonedString = GetMirror(cBinaryString)
EndIf
*/ (3) - Procedemos a calcular el valor en Base 10 de la cadena entera*/
For i=1 To Len(Alltrim(cClonedString))
nAcumul = Iif(Val(Substr(cClonedString,i,1)) = 1, aValores[i,1],0) + nAcumul
Next
*/ (4) - Ahora los decimales... a base 10 */
If !Empty(cParteDecimal) then
For i=1 To Len(Alltrim(cParteDecimal))
nValorDecimal = Iif(Val(Substr(cParteDecimal,i,1)) = 1, aValores[i,2],0)
+ nValorDecimal
Next
EndIf
*/ Determinamos el valor total incluyendo decimales en Base 10 */
nAcumul = Round((nAcumul + nValorDecimal),6)
Return (nAcumul)
*/ prDecToBin.Fnt() */
* 04/Diciembre de 2001 -
* Procedimientos para obtener el valor binario de cadenas decimales */
Function prDecToBin
Parameters nDecimal, nDeep
Local cBinaryString
*/ Descripcion de Parametros:
*-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
*/ nDecimal - Es el numero determinado por el usuario para conversion a
BINARIO */
*/ nDeep - Representa la profundidad del cálculo de exactitud de Decimales...
cuando <nDecimal> contempla fraccion decimal. */
*-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
*/ Nota: Para transformar un numero de Base (10) a su equivalente en BINARIO,
se aplicará el método de divisiones sucesivas entre 2 */
*/ Descripcion del Método:
*
* (1) El numero original en base 10 se divide entre 2 SIN OBTENER DECIMALES
y SE ANOTA EL RESIDUO QUE SERA 1 (Uno) ó 0 (Cero)
* (2) El resultado (cociente) obtenido en el paso anterior se vuelve a
dividir entre 2, anotando los residuos (1, 0)
* (3) Se repite el paso 2 hasta obtener cociente cero.
* (4) Se recogen los residuos obtenidos desde el último HACIA EL PRIMERO
y esa cadena será el VALOR BINARIO DEL NUMERO BASE 10
*-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
*/ Ejemplo:
*
* Convertir el numero 29 (Base 10) en su equivalente BINARIO---------------
[Metodo de divisiones sucesivas entre 2]
*
*
* Cocientes Residuos
* ------------- ------------
* 29 1
* 14 0
* 7 1
* 3 1
* 1 1
* 0
*
* Valor binario del Número 29 (base 10) = '11101'
*----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
*/ Inicia programacion para los procesos descritos:
*/
*/ Si recibo 0 ó Vacío .... */
If nDecimal = 0 Or Empty(nDecimal) Then
Return (0)
Endif
*/ Determinamos la parte decimal, si existe */
nPDecimal = nDecimal - INT(nDecimal)
lPDecimal = Iif(nPDecimal = 0,.F.,.T.)
*/ Inicia proceso de Aplicacion de método */
*/ (1) - Almaceno el primer RESIDUO, aplicando el Mod(x,2)
cBinaryString = ALLTRIM(STR(Mod(nDecimal,2)))
rControl = INT(nDecimal/2)
Do While .T.
*/ Aqui aplico el Mod() a la primera division del numero original
cBinaryString = (cBinaryString + ALLTRIM(STR(Mod(rControl,2))))
*/ Aqui aplico la siguiente division ... */
rControl = INT(rControl/2)
*/ Si es cociente 1, entonces fin de la historia, encadenamos el ultimo
ciclo '1' y salimos...
If rControl = 1
cBinaryString = (cBinaryString + '1')
Exit
EndIf
*/ Se el cociente es CERO, ya no hay nada que hacer, salimos y fin... */
If rControl = 0
Exit
EndIf
EndDo
?? chr (7)
cBinaryString = GetMirror(cBinaryString)
*/ Iniciamos la Fase II - Calculo de fraccion decimal */
If lPDecimal Then
cBinaryString = cBinaryString + '.'
For i=1 TO nDeep
If (nPDecimal * 2) >= 1
cBinaryString = cBinaryString + '1'
Else
cBinaryString = cBinaryString + '0'
Endif
*/ Aqui evaluamos antes del Ciclo */
nPDecimal = nPDecimal * 2
If nPDecimal >= 1 Then
nPDecimal = nPDecimal - INT(nPDecimal)
Endif
Next
EndIf
Return (cBinaryString)
*******************************************
*/ prHexaDecimal.Fnt() */
*/ 04/Diciembre/2001 */
* Procedimientos para obtener el valor decimal de cadenas hexadecimales*/
Function prHexadecimal
Parameters cHexaString
Local cHexaCadena,aValores, cClonedString, nAcumul, nValorDecimal, nAplicaDecimales
Declare aValores (30,3)
nAcumul = 0
nValorDecimal = 0.000000000000000000
Store 0 To aValores
nAplicaDecimales = 0
cHexaCadena = '123456789ABCDEF'
*/ Esta matriz contempla los valores posicionales de la cadena */
aValores[1 ,1] = 16^0
aValores[2 ,1] = 16^1
aValores[3 ,1] = 16^2
aValores[4, 1] = 16^3
aValores[5 ,1] = 16^4
aValores[6 ,1] = 16^5
aValores[7 ,1] = 16^6
aValores[8 ,1] = 16^7
aValores[9 ,1] = 16^8
aValores[10,1] = 16^9
aValores[11,1] = 16^10
aValores[12,1] = 16^11
aValores[13,1] = 16^12
aValores[14,1] = 16^13
aValores[15,1] = 16^14
aValores[16,1] = 16^15
aValores[17,1] = 16^16
aValores[18,1] = 16^17
aValores[19,1] = 16^18
aValores[20,1] = 16^19
*/ Aplicamos el ciclo de evaluacion a la cadena recibida */
rPos = Len(cHexaString)
rPosX= 0
*/ Aplicamos un contador decremental */
For i=rPos To 0 Step -1
If i= 0 Then
Exit
EndIf
rPosX = rPosX + 1
rValor = VAL(Substr(cHexaString,rPosX,1))
If rValor = 0 Then
rValor = At(Substr(cHexaString,rPosX,1),cHexaCadena)
EndIf
nAcumul = nAcumul + (rValor * aValores[i,1])
Next
Return (nAcumul)
***********************************************
* Area de funciones de operaci¢n ... *
***********************************************
FUNCTION GetMirror
PARAMETERS ccadena
nRef = 0
nLen = LEN (ccadena)
cnwcadena = ''
* ALLTRIM(cCadena)
* RIGHT(cCadena,1)
*
DO WHILE .T.
cnwcadena = cnwcadena + SUBSTR(ccadena,(nLen-nRef),1)
nRef = nRef + 1
IF (nRef > nLen)
EXIT
ELSE
LOOP
ENDIF
ENDDO
RETURN (ALLTRIM(cnwcadena))
ENDFUNC
*/ Revierte el Efecto "Espejo", establecido por GetMirror(cString) */
FUNCTION ResetMirror
PARAMETERS cnwcadena
***
nRef = 1
nLen = LEN (cnwcadena)
cncadena = RIGHT(cnwcadena,1)
DO WHILE .T.
* 5 - 1...len(cNwCadena)
cncadena = cncadena + SUBSTR(cnwcadena,(nLen-nRef),1)
nRef = nRef + 1
IF (nRef > nLen)
EXIT
ELSE
LOOP
ENDIF
ENDDO
RETURN (cncadena)
ENDFUNC
Comentarios sobre la versión: Versión 1 (4)
Quiero comentar que esta metodologia de evaluacion de valores BINARIOS en conjunto de funciones es de lo mejor que he visto, ya la implante en un Sistema de Visual Fox Pro y estoy transfiriendo tu codigo a Visual C y estoy seguro que bajo estas directrices va a funcionar genialmente. Sigue aportando soluciones tan buenas como estas y te mando un gran saludo.
Wilson Ontiveros
Monterrey, NL.
FUNCIONES DE TEXTO
excelente pero con los ciclo de repeticion