Calendario

{ paulogp }
Program Peda_05; {Constroi um calendario}

Uses
    WinCrt;

Const
    Esp = 38;
    Semana = ['1','2','3','4','5','6','7'];

Var
    Ano,Mes,Dia,Total,AnoBi,Mudanca,Numero,Contador,IOErro: Integer;
    Tecla,Cdia: Char;


Begin
    Repeat
        ClrScr;
        WriteLn('Calendario!');
        WriteLn('~~~~~~~~~~~');
        WriteLn('Programado por: Paulo G.P.');
        WriteLn;
        Repeat
            WriteLn;
            Write('Introduza o ano: ');
            ReadLn(Ano);
        Until Ano > 0;
        Repeat
            WriteLn;
            Write('Introduza o mes: ');
            ReadLn(Mes);
        Until (Mes>=1) and (Mes<=12);
        WriteLn;
        WriteLn;
        WriteLn('1 - Segunda-feira');
        WriteLn('2 - Terca-feira');
        WriteLn('3 - Quarta-feira');
        WriteLn('4 - Quinta-feira');
        WriteLn('5 - Sexta-feira');
        WriteLn('6 - Sabado');
        WriteLn('7 - Domingo');
        WriteLn;
        Write('Numero do dia da semana em que o mes se inicia: ');
        Repeat
            Cdia:=ReadKey;
        Until Cdia in Semana;
        Val(Cdia,Dia,IOErro);
        ClrScr;
        WriteLn;
        Case Mes of
            1: Write('Janeiro':Esp);
            2: Write('Fevereiro':Esp);
            3: Write('Marco':Esp);
            4: Write('Abril':Esp);
            5: Write('Maio':Esp);
            6: Write('Junho':Esp);
            7: Write('Julho':Esp);
            8: Write('Agosto':Esp);
            9: Write('Setembro':Esp);
            10: Write('Outubro':Esp);
            11: Write('Novembro':Esp);
            12: Write('Dezembro':Esp);
        End;
        Case Mes of
            1,3,5,7,8,10,12: Total:= 31;
            4,6,9,11: Total:= 30;
            2: Begin
                    AnoBi:=(AnoBi-1900) div 100;
                    Total:=28;
                    If Odd(AnoBi)=True then
                        If (Ano mod 4)=0 then Total:=29;
                End;
        End;
        WriteLn(' de ',Ano);
        WriteLn;
        WriteLn;
        WriteLn('     2-feira  3-feira  4-feira  5-feira  6-feira  Sabado  Domingo');
        WriteLn('  ===================================================================');
        WriteLn(' ');
        Mudanca:=1;
        Numero:=0;
        Contador:=0;
        Repeat
            Mudanca:=Mudanca+1;
            Contador:=Contador+1;
            If Contador>=Dia then
            Begin
                Numero:=Numero+1;
                Write(Numero:9);
            End else
            Write(' ':9);
            If Mudanca mod 8 = 0 then
            Begin
                Mudanca:=1;
                WriteLn;
                WriteLn(' ');
            End;
        Until Numero=Total;
        WriteLn;
        WriteLn;
        WriteLn;
        WriteLn;
        Write('Repetir o programa (s/n)? ');
        Tecla:=ReadKey;
    Until (Tecla='N') or (Tecla='n');
    DoneWinCrt;
End.