Pascal/Turbo Pascal - calendario en free pascal

   
Vista:

calendario en free pascal

Publicado por jonathan (4 intervenciones) el 01/12/2008 19:59:41
Hola necesito ayuda para hacer un programa que al ingresarle una fecha (mes y año) el me muestre en pantalla el calendario de dicho mes.

el programa toma como referencia el año 2000 en adelante, ademas se debe tomar en cuenta el año bisiestro. el programa sera comparado con las fechas que estan en la PC yb deben coincidir en cualquier año y fecha.

el programa debe mostrar en pantalla tanto el calendario por mes y año.

D L M M J V S
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
19 20 21 22 23 24 25
25 25 26 27 28 29 30
31

ESTO ES UN EJEMPLO DE COMO DEBE MOSTRAR EN PANTALLA SELECCIONADO CUALQUIER MES AL AZAR DE CUALQUIER AÑO A PARTIR DEL 2000 TIPO CALENDARIO DE COMPUTADORA
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:calendario en free pascal

Publicado por Dani (159 intervenciones) el 01/12/2008 21:19:38
Haz preguntas concretas demostrando que te has esforzado en hacerlo tú, entonces te ayudaremos.

Si no, lee mi mensaje con asunto "Hago programas, doy clases"
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

calendario en free pascal

Publicado por Adolfo Eduardo navegantex@yahoo.com (6 intervenciones) el 11/10/2011 06:17:08
Esta pregunta es muy parecida a esta: http://www.lawebdelprogramador.com/foros/Pascal_Turbo_Pascal/1289562-sugerencias_para_hacer_calendario_en_pascal.html

Pero aquí te doy mi respusta otra vez, sólo te hago la observación que le hice a Juan: la visualición se altera por el proceso de copiado y pegado, sí te interesa el código correcto .PAS mándame un correo y te lo envío.


Program C6_P7;
Uses Crt;
Const d1=1 ;
Var d,m,a : Integer;
n,nd : LongInt;
Salir_SN : Char;

Procedure Instrucciones_C6_P7;
Begin
TextColor (White);
Write ('*****************************');
TextColor (Green);
Write (' Dedicado para M.E.Z. de A.Eduardo G.A. ');
TextColor (White);
WriteLn ('**');
WriteLn;
WriteLn ('Este programa solicita una fecha en el formato: 21/octubre/1980 para visualizar');
WriteLn ('un calendario donde se podr saber que d¡a de la semana fue; el intervalo per- ');
WriteLn ('mitido para el a¤o es de [1,32767]. Pese a que todos los meses se consideran de');
WriteLn ('31 dias no existe error en las fechas reales.');
WriteLn;
WriteLn ('*************************************************************** 7/Enero/2007 **')
{programa en construcci¢n, pues existe un desplazamiento de 2 dias en las fechas}
End;

Procedure LeerDia (Var dn : Integer);
Var Error,b1 : Integer;
Begin
TextColor (Green);
Write ('D¡a: ');
Repeat
GoToXY (6,10);
TextColor (White);
Write (' ': 80);
GoToXY (6,10);
ReadLn (dn);
Error := IOResult;
Case dn Of
1..31 : b1:=0
Else b1:=1
End;
If (Error<>0) Or (b1<>0)
Then Begin
TextColor (Yellow);
Write (#7);
GoToXY (1,35);
If Error<>0
Then Write ('El dato ingrasado es de tipo incorrecto. ');
GoToXY (1,35);
If b1<>0
Then Write ('Los dias de un mes solo pueden ser del 1 al 31, ambos inclusive.');
GoToXY (1,35);
If (Error<>0) And (b1<>0)
Then Write ('El dato ingresado esta fuera de los par metros permitidos. ')
End
Until (Error=0) And (b1=0);
GoToXY (1,35);
Write (' ': 80)
End;

Procedure LeerMes (Var mn : Integer);
Var Error,b1 : Integer;
mes : String;
Begin
TextColor (Green);
GoToXY (1,11);
Write ('Mes: ');
Repeat
GoToXY (6,11);
TextColor (White);
Write (' ':80);
GoToXY (6,11);
ReadLn (mes);
Error := IOResult; {rara vez ocurrira}
If (mes='enero')Or(mes='febrero')Or(mes='marzo')Or(mes='abril')Or(mes='mayo')Or
(mes='junio')Or(mes='julio')Or(mes='agosto')Or(mes='septiembre')Or
(mes='octubre')Or(mes='noviembre')Or(mes='diciembre')
Then b1:=0
Else b1:=1;
If (Error<>0) Or (b1<>0)
Then Begin
TextColor (Yellow);
GoToXY (1,35);
Write (#7);
If Error<>0
Then Begin
WriteLn ('El dato ingresado es de tipo incorrecto. ');
Write (' ')
End;
If b1<>0
Then Begin
WriteLn ('El dato ingresado esta fuera de los par metros permitidos; adem s,');
Write ('racuerde que el mes debe ser escrito en min£sculas.')
End
End
Until (Error=0) And (b1=0);
If mes='enero' Then mn:= 1;
If mes='febrero' Then mn:= 2;
If mes='marzo' Then mn:= 3;
If mes='abril' Then mn:= 4;
If mes='mayo' Then mn:= 5;
If mes='junio' Then mn:= 6;
If mes='julio' Then mn:= 7;
If mes='agosto' Then mn:= 8;
If mes='septiembre' Then mn:= 9;
If mes='octubre' Then mn:=10;
If mes='noviembre' Then mn:=11;
If mes='diciembre' Then mn:=12;
GoToXY (1,35);
WriteLn (' ':79);
WriteLn (' ':80)
End;

Procedure LeerAnio (Var an : Integer);
Var Error,b1 : Integer;
Begin
TextColor (Green);
GoToXY (1,12);
Write ('A¤o: ');
Repeat
GoToXY (6,12);
TextColor (White);
Write (' ':80);
GoToXY (6,12);
ReadLn (an);
Error := IOResult;
If (1<=an)And(an<=MaxInt)
Then b1:=0
Else b1:=1;
If (Error<>0)Or(b1<>0)
Then Begin
TextColor (Yellow);
Write (#7);
GoToXY (1,35);
If Error<>0
Then Write ('El dato ingresado es de tipo incorrecto. ');
GoToXY (1,35);
If b1<>0
Then Write ('El a¤o ingresado esta fuera del intervalo permitido. ');
GoToXY (1,35);
If (Error<>0)And(b1<>0)
Then Write ('El dato ingresado esta fuera de los par metros permitidos.')
End
Until (Error=0)And(b1=0);
GoToXY (1,35);
Write (' ':80)
End;

Procedure Calendario (mc,ac : Integer;
nc : LongInt);
Var mesc : String;
Begin
Case mc Of
1 : mesc := 'ENERO';
2 : mesc := 'FEBRERO';
3 : mesc := 'MARZO';
4 : mesc := 'ABRIL';
5 : mesc := 'MAYO';
6 : mesc := 'JUNIO';
7 : mesc := 'JULIO';
8 : mesc := 'AGOSTO';
9 : mesc := 'SEPTIEMBRE';
10 : mesc := 'OCTUBRE';
11 : mesc := 'NOVIEMBRE';
12 : mesc := 'DICIEMBRE'
End;
TextColor (Yellow);
GoToXY (25,20);
Write (mesc,' de ',ac,' ');
GoToXY (25,22);
TextColor (Green);
WriteLn ( 'DO LU MA MI JU VI SA');
WriteLn;
TextColor (White);
Case nc Of
0 : Begin
WriteLn (' 1 2 3 4 5 6 7');
WriteLn (' 8 9 10 11 12 13 14');
WriteLn (' 15 16 17 18 19 20 21');
WriteLn (' 22 23 24 25 26 27 28');
WriteLn (' 29 30 31')
End;
1 : Begin
WriteLn (' 1 2 3 4 5 6');
WriteLn (' 7 8 9 10 11 12 13');
WriteLn (' 14 15 16 17 18 19 20');
WriteLn (' 21 22 23 24 25 26 27');
WriteLn (' 28 29 30 31')
End;
2 : Begin
WriteLn (' 1 2 3 4 5');
WriteLn (' 6 7 8 9 10 11 12');
WriteLn (' 13 14 15 16 17 18 19');
WriteLn (' 20 21 22 23 24 25 26');
WriteLn (' 27 28 29 30 31')
End;
3 : Begin
WriteLn (' 1 2 3 4');
WriteLn (' 5 6 7 8 9 10 11');
WriteLn (' 12 13 14 15 16 17 18');
WriteLn (' 19 20 21 22 23 24 25');
WriteLn (' 26 27 28 29 30 31')
End;
4 : Begin
WriteLn (' 1 2 3');
WriteLn (' 4 5 6 7 8 9 10');
WriteLn (' 11 12 13 14 15 16 17');
WriteLn (' 18 19 20 21 22 23 24');
WriteLn (' 25 26 27 28 29 30 31')
End;
5 : Begin
WriteLn (' 1 2');
WriteLn (' 3 4 5 6 7 8 9');
WriteLn (' 10 11 12 13 14 15 16');
WriteLn (' 17 18 19 20 21 22 23');
WriteLn (' 24 25 26 27 28 29 30');
WriteLn (' 31')
End;
6 : Begin
WriteLn (' 1');
WriteLn (' 2 3 4 5 6 7 8');
WriteLn (' 9 10 11 12 13 14 15');
WriteLn (' 16 17 18 19 20 21 22');
WriteLn (' 23 24 25 26 27 28 29');
WriteLn (' 30 31')
End
End
End;

Procedure Salir (Var BS : Char);
Begin
TextColor (Blue);
Write ('¨Desea salir del programa (S/N)? : ');
TextColor (White);
Repeat
BS := ReadKey;
Case BS Of
'S','s' : BS := 's';
'N','n' : BS := 'n'
Else Write (#7)
End
Until (BS='s') Or (BS='n');
WriteLn (BS);
WriteLn;
WriteLn ('*******************************************************************************')
End;

Begin {programa maestro}
Repeat
ClrScr;
Instrucciones_C6_P7;
WriteLn;
d:=0;
m:=0;
a:=0;
LeerDia (d); d:=d1; {realmente no importa el d¡a introducido por el usuario}
LeerMes (m);
LeerAnio(a);
Case m Of
1,2 : n:=a + (31*(m-1)) + d - ((a-1) div 4 ) - ((3*((a+99) div 100)) div 4)
Else n:=a + (31*(m-1)) + d - (((4*m)+23) div 10) - ( a div 4 ) - ((3*((a div 100) + 1)) div 4)
End;
nd:=(n Mod 7);
Calendario (m,a,nd);
WriteLn;WriteLn;WriteLn;
Write ('d:',d,' m:',m,' a:',a, ' nd:',nd);
GoToXY (1,45);
Salir (Salir_SN)
Until Salir_SN='s'
End.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar