Pascal/Turbo Pascal - sugerencias para hacer calendario en pascal

sugerencias para hacer calendario en pascal, pues tengo que hacer un calendario desde el año 1900 que muestre por pantalla , alguien tiene alguna sugerencia de como hacer que se muestre de esta forma?

Enero 2007
L M X J V S D
--------------------------
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

mira no es mucho estoy usando freepascal

yo haria una matriz de 7 X 5 endonde pondria los dias del mes
obteniendo el dia en que empieza el mes , posicionandolo
con las siguientes instrucciones

Program Example8;
{ This program demonstrates the DayOfWeek function }
Uses crt,sysutils;
Begin
clrscr;
Writeln ('dia de la semana en numero: ',DayOfWeek(Date));
Writeln ('dia de la semana en palabras: ',LongDayNames[DayOfWeek(Date)]);
readkey;
End.


DayOfWeek(Date), con esta instruccion puedes empezar a obtener el dia en el que te encuentras.

Lo demas es solo jugar con la posicion de incio y el acomodo de los dias en la matriz suena complicado pero si realmente te compenetras en la idea veras que no es tan compleja

saludos y exito...

mira aqui te dejo instrucciones para determinar el primer dia del mes y a que casilla o posicion de la matriz que te recomende le corresponde:

{en este caso le indique que determine cual es el dia de la semana corresponde la siguiente fecha 01/11/2009 }

Program Example8;
{ This program demonstrates the DayOfWeek function }
Uses crt,sysutils;
var
fecha:string[14];
Tfecha:TDateTime;

Begin
clrscr;
Fecha:='01-11-2009';
TFecha:=StrToDate(Fecha);
Writeln ('dia de la semana en numero: ',DayOfWeek(Tfecha));
Writeln ('dia de la semana en palabras: ',LongDayNames[DayOfWeek(Tfecha)]);
readkey;
End.

tu respuesta:
http://foros.solocodigo.com/viewtopic.php?f=34&t=41671
http://www.pillin-slk.blogspot.com

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.

Hola Juan, resulta que al copiar mi código fuente de mi programa C6_P7.PAS que te he puesto y volverlo a probar los numeritos del calendario se desplazan; esto ocurre por que el proceso de copiado y pegado altera caracteres. Para la visualizacion correcta es necesario que tengas el código fuente original C6_P7.PAS, si te interesa mándame un correo y te lo envío.