PROGRAMA 'Calendario'
IGUAL AREA N10 DIA-SEL
IGUAL AREA FECHA FECHA-DESP
SACAR PARAMETROS FECHA FECHA-DESP
10 EJECUTA RUTINA CALENDARIO
SI DIA-SEL = 0 FIN
OPCION TERMINAL AREA 1 /DESPLEGAR
ESCRIBIR TERMINAL FECHA-DESP
OPCION TERMINAL AREA 1 /TERMINAR
EJECUTA 10
*
OPCION TERMINAL AREA 1 /RENGLON /POS. 10 20 /LONG. 3 40 $
/MARCO /CONFIRMAR /COLOR BLANCO BLANCO NEGRO $
/CAMPOS 'Fecha seleccionada' FECHA-DESP /VAR. /ESC.
*
RUTINA CALENDARIO
*
* Esta rutina sirve para desplegar un calenario y que el
* usuario pueda seleccionar una fecha si asi lo desea.
*
IGUAL AREA GRAF-EST FIGURA-BASE FIGURA-MES
IGUAL AREA N10 DIM-X DIM-Y SEPX SEPY SEPX2 SEPY2 SEPY4 $
X Y YL1 YL2 YL3 XT1 XT2 XT3 YT1 YT2 YT3 XR0 YR0 TRX TRY $
LA LX I J XRM
IGUAL AREA X2 XDIAS
IGUAL AREA X3 XMES
IGUAL AREA X4 XAN
IGUAL AREA FECHA FECHA-BASE FECHA-1DM FECHA-1DPM FECHA-PRO
IGUAL AREA N10 DIF-D DIF-M DIF-A SEMANA NUM-DIA NUM-MES $
DIA-PRO
VECTOR X RANGO 1 8
VECTOR Y RANGO 1 6
*
* Area para desplegar el calendario
*
OPCION TERMINAL AREA 8000 /MENU /POS. 2 10 /LONG. 20 60 $
/COLOR GRIS GRIS NEGRO $
/TECLAS-DE-FUNCION 2 'Terminar' $
/SELECCIONAR-MARCA /CAMPOS $
FIGURA-MES DIA-SEL /VAR-SEL.
*
* Formar figura base
*
FORMAR IMAGEN FIGURA-BASE /X-Y-NORMAL $
/INICIO 0 0 'TRANSPARENTE' /VARIAS-INSTRUCCIONES $
/MEDIDA-AREA 8000 DIM-X DIM-Y
*
* Dibujar un rectangulo en el area de imagen para que sirva
* de marco al area.
*
FORMAR IMAGEN FIGURA-BASE $
/EFECTO-LINEAS 'LLENO' 50 $
/RECTANGULO 0 0 DIM-X DIM-Y 'AZUL' 'LLENO' 'TRANSPARENTE' $
/NO-OPCIONES-FIGURAS
*
* Dividir el eje Y en 9 renglones y calcular la Yp de cada uno.
* Se usara 2 para el titulo, 1 para el letreros de "Do Lu ..."
* y 6 para poner los dias del mes Se dejan un espaciado de
* 5 arriba y abajo, 4 mas para las 2 lineas
*
SEPY = DIM-Y - 14 / 9
SEPY2 = SEPY / 2
SEPY4 = SEPY2 / 2
YL1 = DIM-Y - SEPY - 5
YL2 = YL1 - SEPY
YL3 = 6 * SEPY + 7
Y ( 1 ) = 5 * SEPY + 5
Y ( 2 ) = 4 * SEPY + 5
Y ( 3 ) = 3 * SEPY + 5
Y ( 4 ) = 2 * SEPY + 5
Y ( 5 ) = SEPY + 5
Y ( 6 ) = 5
*
* Dividir el eje X en 7 partes una para cada dia de la semana
* menos un espaciado de 10 a ambos lados
*
SEPX = DIM-X - 20 / 7
SEPX2 = SEPX / 2
X ( 1 ) = 10
X ( 2 ) = X ( 1 ) + SEPX
X ( 3 ) = X ( 2 ) + SEPX
X ( 4 ) = X ( 3 ) + SEPX
X ( 5 ) = X ( 4 ) + SEPX
X ( 6 ) = X ( 5 ) + SEPX
X ( 7 ) = X ( 6 ) + SEPX
X ( 8 ) = X ( 7 ) + SEPX
*
* Poner las figuras para seleccionar el mes
*
* Triangulo mes izquierdo con linea de 3 pixeles y efecto
* de rombos en su interior.
*
XT1 = X ( 1 )
YT1 = YL1
XT2 = XT1 + SEPX2
YT2 = YT1 + SEPY2
XT3 = XT1 + SEPX2
YT3 = YT1 - SEPY2
FORMAR IMAGEN FIGURA-BASE $
/EFECTO-LINEAS 'LLENO' 30 $
/TRIANGULO XT1 YT1 XT2 YT2 XT3 YT3 $
'ROJO' 'ROMBOS' 'CELESTE-B' 101
*
* Triangulo mes derecho, poner el triangulo igual y cancelar
* las opciones
*
XT1 = X ( 3 )
YT1 = YL1
XT2 = XT1 - SEPX2
YT2 = YT1 + SEPY2
XT3 = XT1 - SEPX2
YT3 = YT1 - SEPY2
FORMAR IMAGEN FIGURA-BASE $
/TRIANGULO XT1 YT1 XT2 YT2 XT3 YT3 $
'ROJO' 'ROMBOS' 'CELESTE-B' 102 $
/NO-OPCIONES-FIGURAS
*
* Rectangulo entre ellos, solido de color rojo
*
XR0 = X ( 2 ) - SEPX2
YR0 = YL1 - SEPY4
TRX = SEPX
TRY = SEPY2
FORMAR IMAGEN FIGURA-BASE $
/RECTANGULO XR0 YR0 TRX TRY 'ROJO'
*
* Texto mes
*
FORMAR IMAGEN FIGURA-BASE $
/TEXTO X ( 2 ) YL1 'C-M' 'Mes' 'SUIZO' SEPY2 0 $
'TRANSPARENTE' 'CELESTE-B'
*
* Poner las figuras para seleccionar el a¤o
* Triangulo a¤o izquierdo
*
XT1 = X ( 6 )
YT1 = YL1
XT2 = XT1 + SEPX2
YT2 = YT1 + SEPY2
XT3 = XT1 + SEPX2
YT3 = YT1 - SEPY2
FORMAR IMAGEN FIGURA-BASE $
/EFECTO-LINEAS 'LLENO' 30 $
/TRIANGULO XT1 YT1 XT2 YT2 XT3 YT3 $
'ROJO' 'ROMBOS' 'CELESTE-B' 103
*
* Triangulo a¤o derecho
*
XT1 = X ( 8 )
YT1 = YL1
XT2 = XT1 - SEPX2
YT2 = YT1 + SEPY2
XT3 = XT1 - SEPX2
YT3 = YT1 - SEPY2
FORMAR IMAGEN FIGURA-BASE $
/TRIANGULO XT1 YT1 XT2 YT2 XT3 YT3 $
'ROJO' 'ROMBOS' 'CELESTE-B' 104 $
/NO-OPCIONES-FIGURAS
*
* Rectangulo entre ellos
*
XR0 = X ( 7 ) - SEPX2
YR0 = YL1 - SEPY4
TRX = SEPX
TRY = SEPY2
FORMAR IMAGEN FIGURA-BASE $
/RECTANGULO XR0 YR0 TRX TRY 'ROJO'
*
* Texto a¤o
*
FORMAR IMAGEN FIGURA-BASE $
/TEXTO X ( 7 ) YL1 'C-M' 'A¤o' 'SUIZO' SEPY2 0 $
'TRANSPARENTE' 'CELESTE-B'
*
* Poner letrero de dias, es decir Do Lu ...
*
I = 1
LA = SEPY - 4
5 LX = X ( I ) + SEPX2
CONVERTIR 'DLMMJVS' A XDIAS /POS. I 1
CONVERTIR 'ouaiuia' A XDIAS /POS. I 2
FORMAR IMAGEN FIGURA-BASE $
/TEXTO LX YL3 'C' XDIAS 'SU-N' LA 0 'TRANSPARENTE' 'NEGRO'
I = I + 1
SI I < 8 EJECUTA 5
XR0 = DIM-X / 2
TRX = SEPX + SEPX2 - 4
TRY = SEPY - 3
*
* Poner una linea entre los dias y las flechas de seleccion del
* mes y a¤o, en forma opcional poner un elipce donde se pondra
* el a¤o y el mes, preparar para dibujar los dias.
*
FORMAR IMAGEN FIGURA-BASE $
/LINEA 0 YL2 DIM-X YL2 20 'AZUL' $
/EFECTO-LINEAS 'LLENO' 1 $
/USAR-COLOR-MARCO $
* /ELIPCE XR0 YL1 TRX TRY 0 360 'BLANCO' $
* 'LINEAS-VERTICALES' 'GRIS' $
/REDONDEADO $
/FIN-DE-INSTRUCCIONES
*
* Sacar de fecha a desplegar cual es el primer dia de la
* semana 1=do 2=lu, ...
*
10 FECHA-1DM = FECHA-DESP / 100
FECHA-1DM = FECHA-1DM * 100 + 1
FECHA-BASE = 19960101
SI FECHA-DESP < FECHA-BASE FECHA-DESP = FECHA-BASE
RESTAR FECHA-BASE A FECHA-1DM DIF-D DIF-M DIF-A
SEMANA = DIF-D + 1 / 7
NUM-DIA = SEMANA * -7 + DIF-D + 2
*
* Sacar dia primero de proximo mes
*
FECHA-1DPM = FECHA-1DM
SUMAR 1 MES A FECHA-1DPM
*
* Sacar el mes y desplegar mes y a¤o
*
NUM-MES = DIF-A * -12 + DIF-M + 1
CONVERTIR 'EFMAMJJASOND' A XMES /POS. NUM-MES 1
CONVERTIR 'neabauugecoi' A XMES /POS. NUM-MES 2
CONVERTIR 'ebrrynloptvc' A XMES /POS. NUM-MES 3
CONVERTIR FECHA-DESP A XAN /POS. 1 1 /LONG. 4
LA = SEPY - 2
LX = X ( 4 ) + SEPX2
FORMAR IMAGEN FIGURA-MES CON FIGURA-BASE /VARIAS-INSTRUCCIONES $
/TEXTO LX YL1 'C' XAN 'SU-N' LA 0 'TRANSPARENTE' 'NEGRO' $
/TEXTO LX YL2 'C' XMES 'SU-N' LA 0 'TRANSPARENTE' 'NEGRO'
*
* Formar el mes
*
FECHA-PRO = FECHA-1DM
DIA-PRO = 1
I = NUM-DIA
J = 1
MOVER ' ' A XDIAS
TRX = SEPX - 6
TRY = SEPY - 6
LA = SEPY - 8
*
* Rectangulo del dia
*
20 XR0 = X ( I ) + 3
YR0 = Y ( J ) + 3
XRM = X ( I ) + SEPX2
SI DIA-PRO < 10 CONVERTIR DIA-PRO A XDIAS /POS. 4 1
SI DIA-PRO >= 10 CONVERTIR DIA-PRO A XDIAS /POS. 3 1 /LONG. 2
*
SI FECHA-DESP <> FECHA-PRO FORMAR IMAGEN FIGURA-MES $
/RECTANGULO XR0 YR0 TRX TRY 'ROJO' 'ROMBOS' 'GRIS' DIA-PRO $
/TEXTO XRM YR0 'C' XDIAS 'SU-N' LA 0 'TRANSPARENTE' 'CELESTE-B'
*
SI FECHA-DESP = FECHA-PRO FORMAR IMAGEN FIGURA-MES $
/RECTANGULO XR0 YR0 TRX TRY 'ROJO' 'LLENO' 'ROJO' DIA-PRO $
/TEXTO XRM YR0 'C' XDIAS 'SU-N' LA 0 'TRANSPARENTE' 'CELESTE-B'
I = I + 1
SI I < 8 EJECUTA 22
I = 1
J = J + 1
22 DIA-PRO = DIA-PRO + 1
SUMAR 1 DIA A FECHA-PRO
SI FECHA-PRO < FECHA-1DPM EJECUTA 20
FORMAR IMAGEN FIGURA-MES /FIN-DE-INSTRUCCIONES
*
OPCION TERMINAL AREA 8000 /DESPLEGAR
ESCRIBIR TERMINAL FIGURA-MES
LEER TERMINAL EJECUTA 100 DIA-SEL
OPCION TERMINAL AREA 8000 /TERMINAR
*
SI DIA-SEL > 100 EJECUTA 30
CONVERTIR DIA-SEL A FECHA-DESP /POS. 3 7 /LONG. 2
RETORNO
30 SI DIA-SEL = 101 SUMAR -1 MES A FECHA-DESP
SI DIA-SEL = 102 SUMAR 1 MES A FECHA-DESP
SI DIA-SEL = 103 SUMAR -1 ANOS A FECHA-DESP
SI DIA-SEL = 104 SUMAR 1 ANOS A FECHA-DESP
EJECUTA 10
100 DIA-SEL = 0
RETORNO