Utilizamos cookies propias y de terceros para mejorar la experiencia de navegación, y ofrecer contenidos y publicidad de interés.
Al continuar con la navegación entendemos que se acepta nuestra política de cookies.
Iniciar sesión Cerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta

Código de FoxPro/Visual FoxPro - Funciones de cadena

Titulo:local

Funciones de cadena

Autor:J. Alberto Sanchez Sarabia (jalberto58@terra.com.mx)
Lenguaje:FoxPro/Visual FoxPro
Código programado en Visual Foxpro 6.0 (Funciona Bien en anteriores hasta la v2.6)

1) prBinario(cadBinaria)
2) prDecToBin(cadDecimal)
3) prHexaDecimal(cadHexa)
4) getMirror(Cadena)-Invierte una cadena de texto: ALBERTO = 0TREBLA
5) ResetMirror(cadena)-Revierte efecto GetMirror()

******* 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