'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...        es.geocities.com/jm00092
'
'______________________________________________________________________
'                                              CALENDARIO SUPER MODERNO              
'
'    FLECHAS HORIZONTALES = CAMBIA MES
'
'    FLECHAS VERTICALES = = CAMBIA A¥O
'
'    ESPACIO  = = = = = = = IR A FECHA ACTUAL
'
'    ESCAPE = = = = = = = = SALIR
'
'
'  EN CASO DE ERROR REVISAR INSTRUCCIONES MID$(DATE$) EN MODULO PRINCIPAL
'
DECLARE FUNCTION ndm! (n!, a!)
DECLARE FUNCTION MESES! (mes!, a!)
DECLARE FUNCTION BISIESTO! (n!)
DECLARE SUB completo (h!, v!, ann!)
DECLARE FUNCTION fecha! (dia!, mes!, ann!)
DECLARE SUB boton (h!, v!, l!, a!, c1!, c2!, c3!)
DECLARE SUB hoja (h!, v!, mes!, ann!)
DECLARE SUB cuadro (h!, v!, l!, a!, titu$)
DECLARE FUNCTION nm$ (n!)
DECLARE FUNCTION ns$ (n!)
DECLARE SUB calendario (ini!, bis!, diiia!, meees!)
DECLARE SUB letras (x!, Y!, TEXT$, escl!, clrs!, ang!, ancho!, relleno!)
SCREEN 12
PALETTE 4, 63

ELMES = VAL(MID$(DATE$, 1, 2))  '<<<<<PUEDE VARIAR 1 O 4 SEGUN CONFIG PC
ELANYO = VAL(MID$(DATE$, 7, 4))


DO
   CLS
   completo 10, 10, ELANYO
   IF ELMES = 1 THEN
      hoja 10, 300, 12, ELANYO - 1
   ELSE
      hoja 10, 300, ELMES - 1, ELANYO
   END IF
  
   hoja 220, 300, ELMES, ELANYO
  
   IF ELMES = 12 THEN
      hoja 430, 300, 1, ELANYO + 1
   ELSE
      hoja 430, 300, ELMES + 1, ELANYO
   END IF


   SOUND 3000, 1
   DO
      KBD$ = INKEY$
   LOOP WHILE KBD$ = ""
   SELECT CASE KBD$
      CASE CHR$(0) + "H": ELANYO = ELANYO - 1
      CASE CHR$(0) + "P": ELANYO = ELANYO - 1
      CASE CHR$(0) + "K"
         ELMES = ELMES - 1
         IF ELMES < 1 THEN
            ELMES = 12
            ELANYO = ELANYO - 1
         END IF
      CASE CHR$(0) + "M"
         ELMES = ELMES + 1
         IF ELMES > 12 THEN
            ELMES = 1
            ELANYO = ELANYO + 1
         END IF
      CASE " "
         ELMES = VAL(MID$(DATE$, 1, 2))  '<<<<<PUEDE VARIAR 1 O 4 SEGUN CONFIG PC
         ELANYO = VAL(MID$(DATE$, 7, 4))
   END SELECT
LOOP UNTIL KBD$ = CHR$(27)

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                        AVERIGUA SI UN A¥O ES BISIESTO           
FUNCTION BISIESTO (n)
IF (n / 4) = INT(n / 4) THEN bis = 1
IF (n / 100) = INT(n / 100) THEN bis = 0
IF (n / 400) = INT(n / 400) THEN bis = 1
IF (n / 4000) = INT(n / 4000) THEN bis = 0
BISIESTO = bis
END FUNCTION

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                    
SUB boton (h, v, l, a, c1, c2, c3)
LINE (h, v)-STEP(l - 1, a - 1), c1, B
LINE (h + 1, v + 1)-STEP(l - 2, a - 2), c2, B
LINE (h + 1, v + 1)-STEP(l - 3, a - 3), c3, BF
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                    
SUB completo (h, v, ann)
cuadro h, v, 601, 272, "a¤o" + STR$(ann)

vv = v + 20
FOR nn = 1 TO 12
   vv = vv + 20
   hh = h - 7 + (fecha(1, nn, ann) - 1) * 16
   FOR n = 1 TO ndm(nn, ann)
      dom = INT(hh / 16)
      IF dom = 6 XOR dom = 13 XOR dom = 20 XOR dom = 27 XOR dom = 34 THEN c = 4: cc = 14:  ELSE c = 0: cc = 15
      LINE (hh + 13, vv - 11)-STEP(14, 18), 8, B
      LINE (hh + 12, vv - 12)-STEP(14, 18), cc, BF
      letras hh, vv, STR$(n), 8, c, 0, 1, 1
      hh = hh + 16
   NEXT
NEXT
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                    
SUB cuadro (h, v, l, a, titu$)
boton h, v, l, a, 15, 8, 7
boton h + 4, v + 4, l - 8, 20, 9, 0, 1
letras h + 10, v + 16, titu$, 8, 15, 0, 2, 1
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                    
FUNCTION fecha (dia, mes, ann)
diferencia = (((1996 - ann) * 365) - MESES(mes, ann) - 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
fecha = semana
END FUNCTION

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                    
SUB hoja (h, v, mes, ann)
ini = fecha(1, mes, ann)
fin = ndm(mes, ann)

cuadro h, v, 184, 152, nm$(mes) + STR$(ann)

hh = (ini - 1) * 25
vv = v + 39

FOR n = 1 TO fin
   IF hh = 150 THEN c = 4 ELSE c = 0
   LINE (h + hh + 6, vv - 10)-STEP(23, 18), 8, B
   LINE (h + hh + 5, vv - 11)-STEP(23, 18), 15, BF
   letras h + hh - 3, vv, STR$(n), 8, c, 0, 2, 1
   hh = hh + 25: IF hh > 150 THEN hh = 0: vv = vv + 20
NEXT

END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                         TIPOGRAFIA VECTORIAL ESCALABLE HECHA EN RONDA             
'
'
'
SUB letras (x, Y, TEXT$, escl, clrs, ang, ancho, relleno)
IF relleno < 1 THEN : relleno = 1
FOR h = 1 TO ancho STEP relleno
FOR v = 1 TO ancho STEP relleno
ccc = POINT(x + h, Y + v)
PSET (x + h, Y + v), ccc
c$ = STR$(clrs): e$ = STR$(escl): a$ = STR$(ang)
FOR a = 1 TO LEN(TEXT$)
IF clrs > 255 THEN RANDOMIZE TIMER: c$ = STR$(INT(RND * 15) + 1)
DRAW "S" + e$ + "C" + c$ + "ta" + a$
SELECT CASE UCASE$(MID$(TEXT$, a, 1))
CASE "A": DRAW "br2 u2nnr2u2r2d4"
CASE "B": DRAW "br2 u4r2dgnlfdnl2"
CASE "C": DRAW "br2 bu4 nr2d4r2"
CASE "D": DRAW "br2 u4rfd2glbr2"
CASE "E": DRAW "br2 bu4 nr2d2nr2d2r2"
CASE "F": DRAW "br2 bu4 nr2d2nr2d2br2"
CASE "G": DRAW "br2 bu4 nr2d4r2unld"
CASE "H": DRAW "br2 u2nu2r2nu2d2"
CASE "I": DRAW "br2 nu4"
CASE "J": DRAW "br2 nur2nu4"
CASE "K": DRAW "br2 u2 nu2ne2f2"
CASE "L": DRAW "br2 nu4r2"
CASE "M": DRAW "br2 u4f2e2d4"
CASE "N": DRAW "br2 u4f4nu4"
CASE "¤": DRAW "br2 u3f3u3bunl3bd4"
CASE "¥": DRAW "br2 u3f3u3bunl3bd4"
CASE "O": DRAW "br2 bu4 nr2d4r2nu4"
CASE "P": DRAW "br2 u2nnr2u2r2d2bd2"
CASE "Q": DRAW "br2 bu4 nr2d4renu3blf"
CASE "R": DRAW "br2 u4r2d2l2f2"
CASE "S": DRAW "br2 r2u2l2u2r2BD4"
CASE "T": DRAW "br2 BU4r2nd4r2bd4"
CASE "U": DRAW "br2 nu4r2nu4"
CASE "V": DRAW "br2 bunu3fenu3bd"
CASE "W": DRAW "br2 bunu3fenu2fenu3bd"
CASE "X": DRAW "br2 br2bu2ne2nf2ng2nh2br2bd2"
CASE "Y": DRAW "br2 br2u2nh2ne2bd2br2"
CASE "Z": DRAW "br2 bu4 r4g2nlnrg2r4"
CASE "1": DRAW "br2 bu3ed4nlr"
CASE "2": DRAW "br2 bu4 r2d2l2d2r2"
CASE "3": DRAW "br2 bu4 r2d2nl2d2nl2" '"br2 bu4 r2fgnlfgnl2bl"
CASE "4": DRAW "br2 bu2 nu2r2nu2d2"
CASE "5": DRAW "br2 bu4 nr2d2r2d2nl2"
CASE "6": DRAW "br2 bu4 nr2d2nr2d2r2nu2"
CASE "7": DRAW "br2 bu4 r2d4"
CASE "8": DRAW "br2 u4r2d2nl2d2nl2"
CASE "9": DRAW "br2 bu2 nr2u2r2d4"
CASE "0": DRAW "br2 bu4 nr2d4r2nu4"
CASE "*": DRAW "br2 br2 u2nl2nu2nr2nengnhfbf "
CASE "+": DRAW "br2 br2 u2nl2nu2r2bd2"
CASE "-": DRAW "br2 bu2r2bd2"
CASE ".": DRAW "br2": PSET STEP(0, 0), clrs
CASE ",": DRAW "br2 ng"
CASE ";": DRAW "br2 ngbunuBD"
CASE ":": DRAW "br2": PSET STEP(0, 0), clrs: PSET STEP(0, -2), clrs: DRAW "bd2"
CASE "=": DRAW "br2 bunr2bu2r2bd3"
CASE ELSE: DRAW "S" + e$ + "ta" + a$ + "BR4"
END SELECT
NEXT: NEXT: NEXT
DRAW "s4"
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                    
FUNCTION MESES (mes, a)
bis = BISIESTO(a)
SELECT CASE mes
CASE 1: MESES = 0 - bis
CASE 2: MESES = 31 - bis
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
'
'______________________________________________________________________
'                                                      DIAS DE CADA MES                                                   
FUNCTION ndm (n, a)
SELECT CASE n
CASE 1: ndm = 31
CASE 2: ndm = 28 + BISIESTO(a)
CASE 3: ndm = 31
CASE 4: ndm = 30
CASE 5: ndm = 31
CASE 6: ndm = 30
CASE 7: ndm = 31
CASE 8: ndm = 31
CASE 9: ndm = 30
CASE 10: ndm = 31
CASE 11: ndm = 30
CASE 12: ndm = 31
END SELECT
END FUNCTION

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                                  NOMBRES DE LOS MESES                                                  
FUNCTION nm$ (n)
SELECT CASE n
CASE 1: nm$ = "ENERO"
CASE 2: nm$ = "FEBRERO"
CASE 3: nm$ = "MARZO"
CASE 4: nm$ = "ABRIL"
CASE 5: nm$ = "MAYO"
CASE 6: nm$ = "JUNIO"
CASE 7: nm$ = "JULIO"
CASE 8: nm$ = "AGOSTO"
CASE 9: nm$ = "SETIEMBRE"
CASE 10: nm$ = "OCTUBRE"
CASE 11: nm$ = "NOVIEMBRE"
CASE 12: nm$ = "DICIEMBRE"
CASE ELSE: nm$ = "ERROR EN MES"
END SELECT
END FUNCTION

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'                                              NOMBRE DIAS DE LA SEMANA                
FUNCTION ns$ (n)
SELECT CASE n
CASE 1: ns$ = "LUNES"
CASE 2: ns$ = "MARTES"
CASE 3: ns$ = "MIERCOLES"
CASE 4: ns$ = "JUEVES"
CASE 5: ns$ = "VIERNES"
CASE 6: ns$ = "SABADO"
CASE 7: ns$ = "DOMINGO"
CASE ELSE: ns$ = "ERROR EN SEMANA"
END SELECT
END FUNCTION