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

sin imagen de perfil

Funciones de cadenagráfica de visualizaciones


FoxPro/Visual FoxPro

Publicado el 4 de Septiembre del 2002 por J. Alberto Sanchez Sarabia
45.816 visualizaciones desde el 4 de Septiembre del 2002
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()

Versión 1
estrellaestrellaestrellaestrellaestrella(4)

Publicado el 4 de Septiembre del 2002gráfica de visualizaciones de la versión: Versión 1
45.817 visualizaciones desde el 4 de Septiembre del 2002
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
*******
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)

22 de Enero del 2004
estrellaestrellaestrellaestrellaestrella
Hola, Alberto

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.
Responder
20 de Noviembre del 2005
estrellaestrellaestrellaestrellaestrella
FUNCIONES DE FECHA
FUNCIONES DE TEXTO
Responder
20 de Noviembre del 2005
estrellaestrellaestrellaestrellaestrella

excelente pero con los ciclo de repeticion
Responder
20 de Noviembre del 2005
estrellaestrellaestrellaestrellaestrella
gracia por su atencion un saludo
Responder

Comentar la versión: Versión 1

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios...
CerrarCerrar
CerrarCerrar
Cerrar

Tienes que ser un usuario registrado para poder insertar imágenes, archivos y/o videos.

Puedes registrarte o validarte desde aquí.

Codigo
Negrita
Subrayado
Tachado
Cursiva
Insertar enlace
Imagen externa
Emoticon
Tabular
Centrar
Titulo
Linea
Disminuir
Aumentar
Vista preliminar
sonreir
dientes
lengua
guiño
enfadado
confundido
llorar
avergonzado
sorprendido
triste
sol
estrella
jarra
camara
taza de cafe
email
beso
bombilla
amor
mal
bien
Es necesario revisar y aceptar las políticas de privacidad

http://lwp-l.com/s301