Código fuente para wabal.

Procedimientos: conversión de números a letras

2010-08-17T20:22:00.003+02:00

Conversión de números a letras

El procedimiento que a continuación se describe, nos muestra el código fuente que nos permitirá convertir un numero a su correspondiente literal de texto.

proc conv_let(numero=8)

field=m
; declaracion de variables para obtener el resultado de la conversion
dcl num_numericos$=20(100)
dcl num_terminaciones$=15(15)
; array
dcl array_calculo(20)
; contadores varios
dcl var_contadores_0%
dcl var_contadores_1%
endloc

; se inician las data
for var_contadores_0=1 to 100
read=0:num_numericos(var_contadores_0)
next var_contadores_0
for var_contadores_0=1 to 15
read=0:num_terminaciones(var_contadores_0)
next var_contadores_0

; iniciar calculo y comprobaciones

array_calculo(1)=numero

if array_calculo(1)=1
print=1:tab(3,9),"UN EURO ."
goto &final
endif
if int(abs(array_calculo(1)))>99999999
num_convertido=gener(10,".")
endif

array_calculo(1)=array_calculo(1)/1000000
array_calculo(2)=fix(array_calculo(1))
if array_calculo(2)=0 : goto &2300
if array_calculo(2)>1 : goto &2200
num_convertido=includ(index(num_convertido,"."),num_terminaciones(10))
goto &2300
&2200
num_convertido=includ(index(num_convertido,"."),num_numericos(conv(array_calculo(2))))
num_convertido=includ(index(num_convertido,"."),num_terminaciones(11))
&2300
array_calculo(6)=array_calculo(1)
array_calculo(1)=fp(array_calculo(6))*1000
array_calculo(2)=fix(array_calculo(1))
if array_calculo(2)=0 : goto &2800
array_calculo(3)=array_calculo(2)/100
array_calculo(4)=fix(array_calculo(3))
if array_calculo(4)=0 : goto &2400
num_convertido=includ(index(num_convertido,"."),num_terminaciones(conv(array_calculo(4))))
&2400
array_calculo(5)=fp(array_calculo(3))*100
if array_calculo(5)=0 : goto &2600
if array_calculo(4)<>1 : goto &2500
num_convertido=includ(index(num_convertido,".")-1,num_terminaciones(13))
&2500
if array_calculo(2)=1
num_convertido=includ(index(num_convertido,"."),num_terminaciones(12))
goto &2800
endif
num_convertido=includ(index(num_convertido,"."),num_numericos(conv(array_calculo(5))))
goto &2700
&2600
if array_calculo(4)=0 : goto &2800
&2700
num_convertido=includ(index(num_convertido,"."),num_terminaciones(12))
&2800
array_calculo(2)=fp(array_calculo(1))*1000
array_calculo(3)=array_calculo(2)/100
array_calculo(4)=fix(array_calculo(3))
if array_calculo(4)<>0 : num_convertido=includ(index(num_convertido,"."),num_terminaciones(conv(array_calculo(4))))
array_calculo(5)=fp(array_calculo(3))*100
array_calculo(7)=fp(array_calculo(5))*1000
array_calculo(7)=fix(array_calculo(7))/1000
array_calculo(8)=fp(array_calculo(7))
array_calculo(8)=fp(array_calculo(8))*100
array_calculo(8)=fix(array_calculo(8))
array_calculo(9)=fix(array_calculo(8))
array_calculo(5)=fix(array_calculo(5))
if array_calculo(5)<>0
if array_calculo(4)=1 : num_convertido=includ(index(num_convertido,".")-1,num_terminaciones(13))
num_convertido=includ(index(num_convertido,"."),num_numericos(conv(array_calculo(5))))
endif
array_calculo(2)=fix(array_calculo(2))
if array_calculo(8)>0
num_convertido=includ(index(num_convertido,"."),num_terminaciones(14))
num_convertido=includ(index(num_convertido,"."),num_numericos(conv(array_calculo(8))))
endif

; impresion del resultado final ya convertido
num_convertido=includ(index(num_convertido,"."),num_terminaciones(15))
print=1:tab(3,9),num_convertido

;fin de la ejecucion
&final
pause "Pulse enter para continuar con otro numero."

&fin

exit

; datas
DATA "UNO .","DOS .","TRES .","CUATRO .","CINCO .","SEIS .","SIETE .","OCHO .","NUEVE .","DIEZ .","ONCE .","DOCE .","TRECE .","CATORCE .","QUINCE .","DIECISEIS .","DIECISIETE .","DIECIOCHO .","DIECINUEVE .","VEINTE .","VEINTIUN .","VEINTIDOS ."
DATA "VEINTITRES .","VEINTICUATRO .","VEINTICINCO .","VEINTISEIS .","VEINTISIETE .","VEINTIOCHO .","VEINTINUEVE .","TREINTA .","TREINTA Y UN .","TREINTA Y DOS .","TREINTA Y TRES .","TREINTA Y CUATRO .","TREINTA Y CINCO .","TREINTA Y SEIS ."
DATA "TREINTA Y SIETE .","TREINTA Y OCHO .","TREINTA Y NUEVE .","CUARENTA .","CUARENTA Y UN .","CUARENTA Y DOS .","CUARENTA Y TRES .","CUARENTA Y CUATRO .","CUARENTA Y CINCO .","CUARENTA Y SEIS .","CUARENTA Y SIETE .","CUARENTA Y OCHO ."
DATA "CUARENTA Y NUEVE .","CINCUENTA .","CINCUENTA Y UN .","CINCUENTA Y DOS .","CINCUENTA Y TRES .","CINCUENTA Y CUATRO .","CINCUENTA Y CINCO .","CINCUENTA Y SEIS .","CINCUENTA Y SIETE .","CINCUENTA Y OCHO .","CINCUENTA Y NUEVE .","SESENTA ."
DATA "SESENTA Y UN .","SESENTA Y DOS .","SESENTA Y TRES .","SESENTA Y CUATRO .","SESENTA Y CINCO .","SESENTA Y SEIS .","SESENTA Y SIETE .","SESENTA Y OCHO .","SESENTA Y NUEVE .","SETENTA .","SETENTA Y UN .","SETENTA Y DOS .","SETENTA Y TRES ."
DATA "SETENTA Y CUATRO .","SETENTA Y CINCO .","SETENTA Y SEIS .","SETENTA Y SIETE .","SETENTA Y OCHO .","SETENTA Y NUEVE .","OCHENTA ."
DATA "OCHENTA Y UN .","OCHENTA Y DOS .","OCHENTA Y TRES .","OCHENTA Y CUATRO .","OCHENTA Y CINCO .","OCHENTA Y SEIS .","OCHENTA Y SIETE .","OCHENTA Y OCHO .","OCHENTA Y NUEVE .","NOVENTA .","NOVENTA Y UN .","NOVENTA Y DOS .","NOVENTA Y TRES ."
DATA "NOVENTA Y CUATRO .","NOVENTA Y CINCO .","NOVENTA Y SEIS .","NOVENTA Y SIETE .","NOVENTA Y OCHO .","NOVENTA Y NUEVE .","UN"

DATA "CIEN ."
DATA "DOSCIENTOS ."
DATA "TRESCIENTOS ."
DATA "CUATROCIENTOS ."
DATA "QUINIENTOS ."
DATA "SEISCIENTOS ."
DATA "SETECIENTOS ."
DATA "OCHOCIENTOS ."
DATA "NOVECIENTOS ."
DATA "UN MILLON ."
DATA "MILLONES ."
DATA "MIL ."
DATA "TO ."
DATA "CON ."
DATA "EUROS ."

endproc

Sintaxis

Después de haber pegado el código descrito en la bilioteca de procedimientos en la aplicación que se requiera, para obtener un buen resultado, simplemente habría que llamar al procedimiento, tal y como se describe a continuación.

conv_let(num_numerico)

Si num_numerico le damos el valor de 12,34, el procedimiento nos devolverá el resultado literal: DOCE CON TREINTA Y CUATRO EUROS. Si no se quisiera utilizar el literal "EUROS", se modificará el código fuente del procedimiento, cambiando dicho literal por el que se requiera, o bien, se puede añadir una variable de tipo alfanumerico "$", con el literal correspondiente.

A continuación se describe el código fuente en el que se muestra como se llama a dicho procedimiento:

program "num_numericosletras"

field=m
dcl num_convertido$=256
dcl num_numerico=8

#include "conversion.prc"

segment 0

do
; iniciamos la aplicacion para realizar la conversion
print=1:clear
num_convertido="."
print=1:tab(5,5),"numero a convertir"
print=1:tab(26,5),"[ ]"
ask=1,i=&fin:tab(27,5),(-n8.nn)=num_numerico
print=1:tab(27,5),(s(.)-n8.nn),num_numerico

conv_let(num_numerico)
loop

&fin
stop

eseg 0

Procedimientos: gestión de impresoras

2010-08-16T20:47:00.003+02:00

Abrir una impresora

A través de este procedimiento, asigunaremos un número de canal y nonbre de impresora para gestionar los registros de impresión.

Variables a configurar:
Num_Asign_Imp -> se le indicará al procedimiento el número de canal de la impresora
Nombre_fic_Imp -> se le indicará al prpcedimiento el nombre que se decida para la impresora

Procedimientos adjuntos:

VerError -> lo encontraremos en la sercción de "procedimientos de interface de usuario".
FicheroBloqueado -> lo encontraremos en la sercción de "procedimientos de interface de usuario".

PROC AbreImp(num_assign_Imp#,nombre_fic_Imp$=8,long_datos_Imp#,K=long_clave_Imp#)

dcl orror# ; numero de error
dcl aqui$=40 ; descripcion del error

ASSIGN=num_assign_Imp,nombre_fic_Imp,WR,SI:next,orror
aqui=" Assign "+nombre_fic_Imp
DO
OPEN=num_assign_Imp:next,orror
aqui=" OPEN "+nombre_fic_Imp
SELECT orror
CASE 0 :: BREAK
CASE 40
CFILE=num_assign_Imp,D=long_datos_Imp,K=long_clave_Imp:next,orror
IF orror<>0 : VerError(orror,aqui)
CASE 44
FicheroBloqueado(nombre_fic_Imp)
DEFAULT :: VerError(orror,aqui)
ENDSEL
LOOP
ENDPROC

Sintaxis

AbreImp(255,"TICKETS",125,K=2)

Donde:
-> 255 es el número de canal que le asignaremos a la impresora para imprimir "print=255"
-> "TICKETS" es el nombre de la impresora
-> 125 es la longitud que mide el fichero de impresras
-> 2 es la clave del fichero de impresoras.

Procedimiento: Carga de datos - actualización de un fichero con todos los paises del mundo.

2010-08-16T14:26:00.005+02:00

Cargar un fichero con todos los paises del mundo

Partiendo de dos constantes [NumeroFichero="255"] y [NombreFichero="Provincias"], este procedimiento sirve de buena utilidad para ser llamado cada vez que se inicie una sesión de trabajo (siempre y cuando utilicemos una tabla para los paises del mundo en la aplicación), para crearnos el fichero de paises, abasteciendose de unos parámetros data tanto para descripciones de los paises.

El número o nombre de las constantes declaradas, se puede cambiar con el que más convenga.

proc CreaPaises()
field=m
const NumeroFichero="255"
const NombreFichero="Paises"
field=m
dcl e% ; para en error
dcl des$=20(254) ; data para los nombres de los paises
dcl buclex%
dcl TamPais$=20 ; Tampon para busqueda por descripcion de la pais
field=m
dcl pais00$=3 ; Código del pais
dcl paisin# ; Indice
dcl pais01$=50 ; Descripción pais
endloc

; Borrado de las datas
restore

; Creacion del fichero en funcion del valor descrito en la constante NombreFichero
assign=NumeroFichero,NombreFichero,wr,mc:TamPais
cfile=NumeroFichero,K=2,D=50:NEXT,E
key=NumeroFichero,"Descripcion",50
ckey=NumeroFichero:next,e
link=NumeroFichero,"Decripcion"
clink=NumeroFichero:next,e

for buclex=1 to 254
read=0:des(buclex)
next buclex

; Carga de datos en el fichero multicriterio
for buclex=1 to 254
pais00=conv(buclex)
pais01=des(buclex)
insert=NumeroFichero,pais00,/ff:next,e,pais01,50
if e=81
modif=NumeroFichero,pais00,/ff:next,e,pais01,50
endif
next buclex

DATA "Afganistán", "Akrotiri", "Albania", "Alemania", "Andorra", "Angola", "Anguila", "Antártida"
DATA "Antigua y Barbuda", "Antillas Neerlandesas", "Arabia Saudí", "Arctic Ocean", "Argelia", "Argentina"
DATA "Armenia", "Aruba", "Ashmore andCartier Islands", "Atlantic Ocean", "Australia", "Austria", "Azerbaiyán"
DATA "Bahamas", "Bahráin", "Bangladesh", "Barbados", "Bélgica", "Belice", "Benín", "Bermudas", "Bielorrusia",
DATA "Birmania Myanmar", "Bolivia", "Bosnia y Hercegovina", "Botsuana", "Brasil", "Brunéi", "Bulgaria",
DATA "Burkina Faso", "Burundi", "Bután", "Cabo Verde", "Camboya", "Camerún", "Canadá", "Chad", "Chile", "China"
DATA "Chipre", "Clipperton Island", "Colombia", "Comoras", "Congo", "Coral Sea Islands", "Corea del Norte",
DATA "Corea del Sur", "Costa de Marfil", "Costa Rica", "Croacia", "Cuba", "Dhekelia", "Dinamarca", "Dominica",
DATA "Ecuador", "Egipto", "El Salvador", "El Vaticano", "Emiratos Árabes Unidos", "Eritrea", "Eslovaquia",
DATA "Eslovenia", "España", "Estados Unidos", "Estonia", "Etiopía", "Filipinas", "Finlandia", "Fiyi", "Francia"
DATA "Gabón", "Gambia", "Gaza Strip", "Georgia", "Ghana", "Gibraltar", "Granada", "Grecia", "Groenlandia", "Guam"
DATA "Guatemala", "Guernsey", "Guinea", "Guinea Ecuatorial", "Guinea-Bissau", "Guyana", "Haití", "Honduras"
DATA "Hong Kong", "Hungría", "India", "Indian Ocean", "Indonesia", "Irán", "Iraq", "Irlanda", "Isla Bouvet"
DATA "Isla Christmas", "Isla Norfolk", "Islandia", "Islas Caimán", "Islas Cocos", "Islas Cook", "Islas Feroe"
DATA "Islas Georgia del Sur y Sandwich del Sur", "Islas Heard y McDonald", "Islas Malvinas"
DATA "Islas Marianas del Norte", "IslasMarshall", "Islas Pitcairn", "Islas Salomón", "Islas Turcas y Caicos"
DATA "Islas Vírgenes Americanas", "Islas Vírgenes Británicas", "Israel", "Italia", "Jamaica", "Jan Mayen", "Japón"
DATA "Jersey", "Jordania", "Kazajistán", "Kenia", "Kirguizistán", "Kiribati", "Kuwait", "Laos", "Lesoto"
DATA "Letonia", "Líbano", "Liberia", "Libia", "Liechtenstein", "Lituania", "Luxemburgo", "Macao", "Macedonia"
DATA "Madagascar", "Malasia", "Malaui", "Maldivas", "Malí", "Malta", "Man, Isle of", "Marruecos", "Mauricio"
DATA "Mauritania", "Mayotte", "México", "Micronesia", "Moldavia", "Mónaco", "Mongolia", "Montserrat", "Mozambique"
DATA "Namibia", "Nauru", "Navassa Island", "Nepal", "Nicaragua", "Níger", "Nigeria", "Niue", "Noruega"
DATA "Nueva Caledonia", "Nueva Zelanda", "Omán", "Pacific Ocean", "Países Bajos", "Pakistán", "Palaos"
DATA "Panamá", "Papúa-Nueva Guinea", "Paracel Islands", "Paraguay", "Perú", "Polinesia Francesa", "Polonia"
DATA "Portugal", "Puerto Rico", "Qatar", "Reino Unido", "República Centroafricana", "República Checa"
DATA "República Democrática del Congo", "República Dominicana", "Ruanda", "Rumania", "Rusia", "Sáhara Occidental"
DATA "Samoa", "Samoa Americana", "San Cristóbal y Nieves", "San Marino", "San Pedro y Miquelón"
DATA "San Vicente y las Granadinas", "Santa Helena", "Santa Lucía", "Santo Tomé y Príncipe", "Senegal"
DATA "Seychelles", "Sierra Leona", "Singapur", "Siria", "Somalia", "Southern Ocean", "Spratly Islands"
DATA "Sri Lanka", "Suazilandia", "Sudáfrica", "Sudán", "Suecia", "Suiza", "Surinam", "Svalbard y Jan Mayen"
DATA "Tailandia", "Taiwán", "Tanzania", "Tayikistán", "TerritorioBritánicodel Océano Indico"
DATA "Territorios Australes Franceses", "Timor Oriental", "Togo", "Tokelau", "Tonga", "Trinidad y Tobago"
DATA "Túnez", "Turkmenistán", "Turquía", "Tuvalu", "Ucrania", "Uganda", "Unión Europea", "Uruguay", "Uzbekistán"
DATA "Vanuatu", "Venezuela", "Vietnam", "Wake Island", "Wallis y Futuna", "West Bank", "World", "Yemen", "Yibuti"
DATA "Zambia", "Zimbabue"
endproc

Sintaxis

CreaPaises

Procedimientos: Pedir fecha larga ($=8)

2010-08-10T21:00:00.008+02:00

Pedir fecha larga ($=8)

A través de la función que a continuación se detalla, obtendremos una fecha válida. Dicha fecha se pedirá directamente con los comandos de condición [if then else endif]. asimismo y a través de la misma pasaremos los parámetros [xFila y xColumna], para que la aplicación nos la muestre en la posición que creamos oportuna:

PROC PideFecha8(xcol#,xfil#,xfec$=8) : %
FIELD=M
DCL Mascara%
DCL Fecha$=8
FIELD=M,Fecha
DCL ano$=4,mes$=2,dia$=2
ENDLOC

mascara=MASK
MASK 811

fecha=xfec
IF (fecha==" ")
dia="00" :: mes="00" :: ano=CONV(JJANO(PT))
ENDIF
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano

&dia
REPEAT
ASK=1,I=&escape:TAB(xcol,xfil),(NN)=dia
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
UNTIL (CONV#(dia)<32)
IF dia="00"
mes="00"
ano="0000"
xfec=fecha
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
MASK mascara
EXIT (88)
ENDIF
&mes
REPEAT
ASK=1,I=&dia:TAB(xcol+3,xfil),(NN)=mes
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
UNTIL (CONV#(mes)>0) AND (CONV#(mes)<13)
SELECT CONV#(mes) ; CONTROL DE DIA DEL MES
CASE 4,6,9,11 :: IF CONV#(dia)>30 : GOTO &mes
CASE 2 :: IF CONV#(dia)>29 : GOTO &mes
ENDSEL

&ano
ASK=1,I=&mes:TAB(xcol+6,xfil),(n4)=ano
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
IF (CONV#(mes)=2) AND (MOD(CONV%(ano),4)<>0) AND (CONV#(dia)>28) : GOTO &dia
IF (CONV%(ANO)<>0) AND (CONV%(ANO)<1900) : GOTO &ANO

MASK mascara
xfec=fecha
EXIT (0)

&escape
PRINT=1:TAB(xcol,xfil),(ZZ,"/",ZZ,"/",Z4),dia,mes,ano
MASK mascara
EXIT (99)
ENDPROC

SINTAXIS

IF pidefecha8(26,19,FechaPedida?)=99 : goto &Fin

Si la función devuelve 99, es que han pulsado escape dentro de la función.
Si la función devuelve 88, es que han pulsado intro dentro de la función, pero el valor que devuelve es 00/00/0000.
Si la función devuelve 0, es que han introducido un valor válido de fecha.

Procedimiento: Carga de datos - actualización de un fichero con las provincias de España

2010-08-10T13:50:00.011+02:00

Cargar un fichero con todas las provincias de España

Partiendo de dos constantes [NumeroFichero="255"] y [NombreFichero="Provincias"], este procedimiento sirve de buena utilidad para ser llamado cada vez que se inicie una sesión de trabajo (siempre y cuando utilicemos una tabla para las provincias en la aplicación), para crearnos el fichero de provincias, abasteciendose de unos parámetros data tanto para códigos de provincia, como para descripciones de las provincias.

El número o nombre de las constantes declaradas, se puede cambiar con el que más convenga.

proc CreaProvincias()
field=m
const NumeroFichero="255"
const NombreFichero="Provincias"
field=m
dcl e% ; para en error
dcl cod$=2(51) ; data para los codigos de la provincia
dcl des$=20(51) ; data para las descripciones de las provincias
dcl buclex%
dcl TamProvincia$=20 ; Tampon para busqueda por descripcion de la provincia
field=m
dcl pv00$=2 ; Código de provincia
dcl pvin# ; Indice
dcl pv01$=50 ; Descripción provincia
endloc

; Borrado de las datas
restore

; Creacion del fichero en funcion del valor descrito en la constante NombreFichero
assign=NumeroFichero,NombreFichero,wr,mc:TamProvincia
cfile=NumeroFichero,K=2,D=50:NEXT,E
key=NumeroFichero,"Descripcion",50
ckey=NumeroFichero:next,e
link=NumeroFichero,"Decripcion"
clink=NumeroFichero:next,e

; Carga de las datas
for buclex=1 to 51
read=0:cod(buclex)
next buclex

for buclex=1 to 51
read=0:des(buclex)
next buclex

; Carga de datos en el fichero multicriterio
for buclex=1 to 51
pv00=cod(buclex)
pv01=des(buclex)
insert=NumeroFichero,pv00,/ff:next,e,pv01,50
if e=81
modif=NumeroFichero,pv00,/ff:next,e,pv01,50
endif
next buclex

data "01","02","03","04","05","06","07","08","09","10","11","12","13","14","15","16","17","18"
data "19","20","21","22","23","24","25","26","27","28","29","30","31","32","33","34","35","36"
data "37","38","39","40","41","42","43","44","45","46","47","48","49","50","66"

DATA "ALAVA","ALBACETE","ALICANTE","ALMERIA","AVILA","BADAJOZ","BALEARES","BARCELONA","BURGOS"
DATA "CACERES","CADIZ","CASTELLON","CIUDAD REAL","CORDOBA","CORUÑA","CUENCA","GERONA","GRANADA"
DATA "GUADALAJARA","GUIPUZCOA","HUELVA","HUESCA","JAEN","LEON","LERIDA","RIOJA (LA)","LUGO","MADRID"
DATA "MALAGA","MURCIA","NAVARRA","ORENSE","ASTURIAS","PALENCIA","PALMAS (LAS)","PONTEVEDRA","SALAMANCA"
DATA "STA CRUZ DE TENERIFE","CANTABRIA","SEGOVIA","SEVILLA","SORIA","TARRAGONA","TERUEL","TOLEDO"
DATA "VALENCIA","VALLADOLID","VIZCAYA","ZAMORA","ZARAGOZA","EXTRANJERO"
endproc

Sintaxix:

CreaProvincias

Procedimiento: Mostrar un cuadro de diálogo con borde doble

2010-08-10T13:01:00.011+02:00

Mostrar un cuadro de diálogo con borde doble.

Teniendo en cuenta que los simbolos del cuadro de diálogo, se obtienen manteniendo pulsada la tecla "Alt + código ASCII". Con el procedimiento que a continuación se detalla obtendremos la un cuadro de diálogo con el borde simple, tal y como muestra el ejemplo:

Proc PintaCuadroBordeDoble(Cuadro_Columna#,Cuadro_Posinicial#,Cuadro_Posfinal#,Cuadro_Ancho#)
FIELD=M
DCL Cuadro_bucle%
ENDLOC

PRINT=1:TAB(Cuadro_Columna,Cuadro_Posinicial),"╔",GENER(Cuadro_Ancho,"═"),PAINT(0,GRIS),"╗",PAINT(NEGRO,GRIS)
Cuadro_Posinicial=Cuadro_Posinicial+1
FOR Cuadro_bucle=Cuadro_Posinicial to Cuadro_PosFinal
PRINT=1:TAB(Cuadro_Columna,Cuadro_Bucle),"║",GENER(Cuadro_Ancho," "),PAINT(0,GRIS),"║",PAINT(NEGRO,GRIS)
NEXT Cuadro_bucle
Cuadro_PosFinal=Cuadro_PosFinal+1
PRINT=1:TAB(Cuadro_Columna,Cuadro_PosFinal),"╚",PAINT(0,GRIS),GENER(Cuadro_Ancho,"═"),"╝",PAINT(NEGRO,GRIS)
EndProc

Sintaxix:

PintaCuadroBordeDoble(10,10,20,40)

Procedimiento: Mostrar un cuadro de diálogo con borde simple.

2010-08-10T10:27:00.010+02:00

Mostrar un cuadro de diálogo con borde simple.

Proc PintaCuadroBordeSimple(Cuadro_Columna#,Cuadro_Posinicial#,Cuadro_Posfinal#,Cuadro_Ancho#)
FIELD=M
DCL Cuadro_bucle%
ENDLOC

PRINT=1:TAB(Cuadro_Columna,Cuadro_Posinicial),"┌",GENER(Cuadro_Ancho,"─"),PAINT(0,GRIS),"┐",PAINT(NEGRO,GRIS)
Cuadro_Posinicial=Cuadro_Posinicial+1
FOR Cuadro_bucle=Cuadro_Posinicial to Cuadro_PosFinal
PRINT=1:TAB(Cuadro_Columna,Cuadro_Bucle),"│",GENER(Cuadro_Ancho," "),PAINT(0,GRIS),"│",PAINT(NEGRO,GRIS)
NEXT Cuadro_bucle
Cuadro_PosFinal=Cuadro_PosFinal+1
PRINT=1:TAB(Cuadro_Columna,Cuadro_PosFinal),"└",PAINT(0,GRIS),GENER(Cuadro_Ancho,"─"),"┘",PAINT(NEGRO,GRIS)
EndProc

Sintaxix:

PintaCuadroBordeSimple(10,10,20,40)

Procedimiento: Cálculo Dígito de Control

2010-08-10T08:05:00.015+02:00

Cálculo dígito de control

Teniendo en cuenta que sabemos el código de banco, código de sucursal y numero de cuenta bancaria, este procedimiento nos devolverá el numero de dígito de control:

proc DigitoDeControl(xbanco$=4,xsucursal$=4,xcuenta$=10) : $=2
DCL ctr#(10) ; testigo de control
DCL cadena1$=10 ; cadena para c lculo (entidad+oficina)
DCL suma1%
DCL suma2%
DCL modulo1%,digito1$=1
DCL modulo2%,digito2$=1
DCL xDigitoControl$=2
ENDLOC
CTR(01)=01 :: CTR(02)=02 :: CTR(03)=04 :: CTR(04)=08 :: CTR(05)=05
CTR(06)=10 :: CTR(07)=09 :: CTR(08)=07 :: CTR(09)=03 :: CTR(10)=06
cadena1="00"+xbanco+xsucursal
suma1=0 :: suma2=0
FOR contador=1 TO 10
suma1=suma1+ctr(contador)*CONV(SUBSTR(cadena1,contador,1))
suma2=suma2+ctr(contador)*CONV(SUBSTR(xcuenta,contador,1))
NEXT contador
modulo1=11-CONV(INT(MOD(CONV(suma1),11)))
modulo2=11-CONV(INT(MOD(CONV(suma2),11)))
IF modulo1=10 : modulo1=1
IF modulo1=11 : modulo1=0
IF modulo2=10 : modulo2=1
IF modulo2=11 : modulo2=0
digito1=CONV(modulo1)
digito2=CONV(modulo2)
xDigitoControl=Digito1+Digito2
EXIT (xDigitoControl)
endproc

Sintaxix:

DigitoControl=DigitoDeControl("2100","1000","1234567890")