-
Lenguaje
Pascal
-
Descripción
Calendario
Para cambiar de mes presione las teclas ← (flecha izquierda) y → (flecha derecha).
Para cambiar de año presione las teclas ↑ (flecha arriba) y ↓ (flecha abajo).
Para terminar el programa presione la tecla ESC.
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
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
program calendario;
uses crt, dos;
const borde = #205#205#205#205#205#205#205#205#205;
const months : array[0..11] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
const year_regular : array[0..11] of integer = ( 0, 3, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5);
const year_bisiesto: array[0..11] of integer = ( 0, 3, 4, 0, 2, 5, 0, 3, 6, 1, 4, 6);
const nombres : array[0..11] of string = (
' Enero ', ' Febrero ', ' Marzo ', ' Abril ',
' Mayo ', ' Junio ', ' Julio ', ' Agosto ',
'Septiembre', ' Octubre ', 'Noviembre ', 'Diciembre ');
var meses : array[0..11] of integer;
var tecla, i, dia, modulo : integer;
var day, year, mes, dayofweek: word;
begin
for i:=0 to 11 do
meses[i] := months[i];
getdate (year, mes , day, dayofweek);
dec (mes);
repeat
begin
if (((year mod 4) = 0) and ((year mod 100) <> 0)) or ((year mod 400) = 0) then
begin
meses[1] := 29;
modulo := year_bisiesto[mes];
end
else
begin
meses[1] := 28;
modulo := year_regular[mes];
end;
dia := 1 - ((year - 1) mod 7 + ((year - 1) div 4 - (3 * ((year - 1) div 100 + 1)) div 4) mod 7 + modulo + 1) mod 7;
clrscr;
writeln (' '#17, nombres[mes], #16' '#30, year, #31);
writeln (#201, borde, #203, borde, #203, borde, #203, borde, #203, borde, #203, borde, #203, borde, #187);
write (#186' Domingo '#186' Lunes '#186' Martes '#186'Mi'#130'rcoles'#186' Jueves '#186' Viernes ');
writeln (#186' S'#160'bado '#186);
writeln (#204, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #185);
while dia <= meses[mes] do
begin
for i:=0 to 6 do
begin
if (dia<1) or (dia>meses[mes]) then
write (#186' ')
else
write (#186' ', dia:2, ' ');
inc (dia);
end;
writeln (#186);
if dia<=meses[mes] then
writeln (#204, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #185)
else
writeln (#200, borde, #202, borde, #202, borde, #202, borde, #202, borde, #202, borde, #202, borde, #188);
end;
writeln ('Presione '#27' y '#26' para cambiar de mes.');
writeln ('Presione '#24' y '#25' para cambiar de a'#164'o.');
writeln ('Presione ESC para salir.');
repeat
tecla := ord (readkey);
until (tecla=0) or (tecla=27);
if tecla = 0 then
case ord (readkey) of
72: inc (year);
80: dec (year);
77:
if mes<11 then
inc (mes)
else
begin
inc (year);
mes := 0;
end;
75:
if mes <> 0 then
dec (mes)
else
begin
dec (year);
mes := 11;
end;
end;
end;
until tecla = 27;
end.
uses crt, dos;
const borde = #205#205#205#205#205#205#205#205#205;
const months : array[0..11] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
const year_regular : array[0..11] of integer = ( 0, 3, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5);
const year_bisiesto: array[0..11] of integer = ( 0, 3, 4, 0, 2, 5, 0, 3, 6, 1, 4, 6);
const nombres : array[0..11] of string = (
' Enero ', ' Febrero ', ' Marzo ', ' Abril ',
' Mayo ', ' Junio ', ' Julio ', ' Agosto ',
'Septiembre', ' Octubre ', 'Noviembre ', 'Diciembre ');
var meses : array[0..11] of integer;
var tecla, i, dia, modulo : integer;
var day, year, mes, dayofweek: word;
begin
for i:=0 to 11 do
meses[i] := months[i];
getdate (year, mes , day, dayofweek);
dec (mes);
repeat
begin
if (((year mod 4) = 0) and ((year mod 100) <> 0)) or ((year mod 400) = 0) then
begin
meses[1] := 29;
modulo := year_bisiesto[mes];
end
else
begin
meses[1] := 28;
modulo := year_regular[mes];
end;
dia := 1 - ((year - 1) mod 7 + ((year - 1) div 4 - (3 * ((year - 1) div 100 + 1)) div 4) mod 7 + modulo + 1) mod 7;
clrscr;
writeln (' '#17, nombres[mes], #16' '#30, year, #31);
writeln (#201, borde, #203, borde, #203, borde, #203, borde, #203, borde, #203, borde, #203, borde, #187);
write (#186' Domingo '#186' Lunes '#186' Martes '#186'Mi'#130'rcoles'#186' Jueves '#186' Viernes ');
writeln (#186' S'#160'bado '#186);
writeln (#204, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #185);
while dia <= meses[mes] do
begin
for i:=0 to 6 do
begin
if (dia<1) or (dia>meses[mes]) then
write (#186' ')
else
write (#186' ', dia:2, ' ');
inc (dia);
end;
writeln (#186);
if dia<=meses[mes] then
writeln (#204, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #206, borde, #185)
else
writeln (#200, borde, #202, borde, #202, borde, #202, borde, #202, borde, #202, borde, #202, borde, #188);
end;
writeln ('Presione '#27' y '#26' para cambiar de mes.');
writeln ('Presione '#24' y '#25' para cambiar de a'#164'o.');
writeln ('Presione ESC para salir.');
repeat
tecla := ord (readkey);
until (tecla=0) or (tecla=27);
if tecla = 0 then
case ord (readkey) of
72: inc (year);
80: dec (year);
77:
if mes<11 then
inc (mes)
else
begin
inc (year);
mes := 0;
end;
75:
if mes <> 0 then
dec (mes)
else
begin
dec (year);
mes := 11;
end;
end;
end;
until tecla = 27;
end.