'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...        es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                   CALENDARIO PERPETUO
DECLARE SUB normas ()
DECLARE SUB entrada ()
DECLARE SUB cuadro (v!, h!, l!, a!)
DECLARE SUB SALIDA ()
DECLARE FUNCTION MESES! (mes)
SCREEN 0
entrada
inicio:
CLS
cuadro 1, 1, 80, 6
LOCATE 2, 1: PRINT "º CALENDARIO PERMANENTE AUTOMµTICO   HECHO EN RONDA   J.M.G.B.  NOVIEMBRE 1995 º"
PRINT "º"; STRING$(78, 196); "º"
PRINT "º Funciona seg£n las normas del calendario gregoriano usado desde 1582."
PRINT "º Introducir una fecha valida para obtener el dia de la semana."
cuadro 23, 1, 80, 3
cuadro 9, 3, 25, 3
cuadro 12, 3, 25, 3
cuadro 15, 3, 25, 3
CLEAR
WHILE INKEY$ <> "": WEND

DO
   LOCATE 24, 2: PRINT " ESCRIBIR UN NéMERO ENTRE 1 Y 31 Y PULSAR ENTER";
   LOCATE 10, 5: PRINT SPACE$(20)
   LOCATE 10, 5: INPUT "DIA: ", dia$
   dia = VAL(dia$)
LOOP UNTIL dia > 0 AND dia < 32
LOCATE 24, 2: PRINT " ESCRIBIR EL MES CON NéMERO Y PULSAR ENTER: ENERO=1 FEBRERO=2 ETC...";

DO
   LOCATE 13, 5: PRINT SPACE$(20)
   LOCATE 13, 5: INPUT "MES: ", me$
   mes = VAL(me$)
LOOP UNTIL mes > 0 AND mes < 13
LOCATE 24, 2: PRINT " ESCRIBIR EL A¥O Y PULSAR ENTER. PARA A¥OS ANTES DE CRISTO PONER UN - DELANTE";
LOCATE 16, 5: INPUT "A¥O: ", ann$
ann = VAL(ann$)
IF ann = 0 THEN : LOCATE 16, 9: PRINT ann; SPACE$(15)





DIFERENCIA = (((1996 - ann) * 365) - MESES(mes) - dia + 1)
DIFERENCIA = DIFERENCIA + (INT(DIFERENCIA / 1460))
SELECT CASE ann
   CASE IS >= 1996: semana = ABS(DIFERENCIA MOD 7) + 1
   CASE IS < 1996: semana = 8 - ABS(DIFERENCIA MOD 7)
      IF semana = 8 THEN : semana = 1
END SELECT
SELECT CASE semana
   CASE 1: SEM$ = " LUNES"
   CASE 2: SEM$ = " MARTES"
   CASE 3: SEM$ = " MI�RCOLES"
   CASE 4: SEM$ = " JUEVES"
   CASE 5: SEM$ = " VIERNES"
   CASE 6: SEM$ = " SµBADO"
   CASE 7: SEM$ = " DOMINGO"
END SELECT
cuadro 16, 36, 40, 5
LOCATE 18, 40: PRINT "DIA DE LA SEMANA ="; SEM$
cuadro 23, 1, 80, 3
LOCATE 24, 3: PRINT "PULSAR <ESCAPE> PARA SALIR, <ENTER> PARA SEGUIR O <TAB> PARA VER LAS NORMAS.";
salir:
DO
   KBD$ = INKEY$
LOOP WHILE KBD$ = ""
SELECT CASE KBD$
   CASE CHR$(13): GOSUB inicio
   CASE CHR$(27): SALIDA
   CASE CHR$(9): normas: GOSUB salir
   CASE ELSE: BEEP: GOSUB salir
END SELECT

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                              
SUB cuadro (v, h, l, a)
LOCATE v, h: PRINT "É"; STRING$(l - 2, 205); "»";
FOR vv = v + 1 TO v + a - 2
   LOCATE vv, h: PRINT "º"; SPACE$(l - 2); "º";
NEXT
LOCATE v + a - 1, h: PRINT "È"; STRING$(l - 2, 205); "¼";
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                              
SUB entrada
CLS
cuadro 8, 21, 40, 11
LOCATE 11, 25: PRINT "CALENDARIO PERMANENTE AUTOMµTICO"
LOCATE 13, 25: PRINT "         HECHO EN RONDA"
LOCATE 15, 25: PRINT "            J.M.G.B."
SLEEP 3
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                              
FUNCTION MESES (mes)
SELECT CASE mes
CASE 1: MESES = 0
CASE 2: MESES = 31
CASE 3: MESES = 31 + 28
CASE 4: MESES = 31 + 28 + 31
CASE 5: MESES = 31 + 28 + 31 + 30
CASE 6: MESES = 31 + 28 + 31 + 30 + 31
CASE 7: MESES = 31 + 28 + 31 + 30 + 31 + 30
CASE 8: MESES = 31 + 28 + 31 + 30 + 31 + 30 + 31
CASE 9: MESES = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31
CASE 10: MESES = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30
CASE 11: MESES = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
CASE 12: MESES = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30
END SELECT
END FUNCTION

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                              
SUB normas
cuadro 8, 2, 78, 14
LOCATE 9, 2: PRINT "º NORMAS DE FUNCIONAMIENTO DEL CALENDARIO GREGORIANO"
PRINT " º"; STRING$(76, 196); "º"
PRINT " º Los a¤os de 365 dias se dividen en doce meses"
PRINT " º Los meses de ABR, JUN, SET y NOV tienen 30 dias"
PRINT " º Los meses de ENE, MAR, MAY, JUL, AGO, OCT y DIC tienen 31 dias"
PRINT " º El mes de FEB tiene 28 dias"
PRINT " º Desde el a¤o -46 los a¤os m£ltiplo de 4 tienen un dia 29 FEB. = BISIESTOS"
PRINT " º Los dias 5 al 14 de coctubre (a.i.) del a¤o 1582 NO EXISTIERON"
PRINT " º Desde el a¤o 1582 los a¤os acabados en 00 no son bisiestos"
PRINT " º Desde ese a¤o los a¤os m£ltiplo de 400 son bisiestos aunque acaben en 00"
PRINT " º Las semanas SIEMPRE tienen siete dias y su orden no var¡a NUNCA"
LOCATE 20, 54: PRINT "* Seg£n LAROUSSE Juvenil"
LOCATE 24, 3: PRINT "PULSA <ESCAPE> PARA SALIR DEL PROGRAMA O BIEN PULSA <ENTER> PARA VOLVER.    ";
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                              
SUB SALIDA
CLS
cuadro 11, 21, 40, 5
LOCATE 13, 27: PRINT "GRACIAS POR USAR EL PROGRAMA"
COLOR 0, 0
END SUB