一个Pascal语言写的计算指定年月日历信息的程序

这段代码是2013年8月我学Pascal语言的时候写的，不过今天看了一下那时的代码BUG还挺多，所以今天又加工了下。

编译环境使用的是FreePascal，代码是在Notepad++上写的，用FreePascalIDE进行调试

程序运行的截图如下：

代码如下：

program Acilia; {Write by Tsybius}

var intExit:        integer;
    intChoose:      integer;
    intYear:        integer;    {Data converted from input}
    intMonth:       integer;    {Data converted from input}

    strInput:       string[7];  {The string input}
    intCode:        integer;    {Code for function val}

    intTempYear:    integer;    {Variant for calculation}
    intDayOfWeek:   integer;    {Day of Week}

    intCalendar:    array[1 .. 42] of integer;  {Calendar}
    intTemp:        integer;

begin

    writeln('Acilia Welcomes You.');

    intExit := 0;  {When intExit becomes 1, the program shall be killed}

    repeat

        writeln('Print 1 to Search, 2 to Exit.');
        readln(intChoose);

        if intChoose = 1 then
            intChoose := 1
        else 
        begin
            if intChoose = 2 then
                intChoose := 2
            else
                intChoose := 3
        end;

        case intChoose of
        1:  {Search}
            begin

                writeln('Tell me the Year and the Month (Such as 2011-03).');
                writeln('Year from 1901 to 2100, Month from 1 to 12.');
                readln(strInput);
                writeln('The date you input is ', strInput);
                writeln('Now checking...');

                val(copy(strInput, 1, 4), intYear, intCode);
                val(copy(strInput, 6, 2), intMonth, intCode);
                writeln('Year: ', intYear, ' Month: ', intMonth);

                {Check if the year input is legal}
                if (intYear < 1900) or (intYear > 2100) then
                begin
                    writeln('Make sure the year you input is legal!');
                    continue;
                end;

                {Check if the month input is legal}
                if (intMonth < 1) or (intMonth > 12) then
                begin
                    writeln('Make sure the month you input is legal');
                    continue;
                end;

                intDayOfWeek := 1; {Sun:0 Mon:1 ... Sat:6}
                intTempYear := 1900;

                if intYear <> 1900 then
                begin
            
                    for intTempYear := 1900 to intYear - 1 do
                    begin
                    
                        if intTempYear = 1900 then
                        begin
                        
                            inc(intDayOfWeek, 365);
                            intDayOfWeek := intDayOfWeek mod 7;
                            continue;
                        
                        end;
                    
                        if intTempYear mod 4 = 0 then
                        begin
                        
                            inc(intDayOfWeek, 366);
                            intDayOfWeek := intDayOfWeek mod 7;
                            continue;
                        
                        end;
                    
                        inc(intDayOfWeek, 365);
                        intDayOfWeek := intDayOfWeek mod 7;
                    
                    end;  {Exit calculation about intTempYear}
                    
                    {Tell user the latest result}
                    writeln('January 1st in ', intTempYear);
                    writeln(' is the ', intDayOfWeek, '(st/nd/rd/th) day of the week!');
                    
                    if intMonth > 1 then intDayOfWeek := (intDayOfWeek + 31) mod 7;
                    if intMonth > 2 then 
                    begin
                        intDayOfWeek := (intDayOfWeek + 28) mod 7;
                        if (intTempYear = 2000) then inc(intDayOfWeek); 
                    end;
                    if intMonth > 3 then intDayOfWeek := (intDayOfWeek + 31) mod 7;
                    if intMonth > 4 then intDayOfWeek := (intDayOfWeek + 30) mod 7;
                    if intMonth > 5 then intDayOfWeek := (intDayOfWeek + 31) mod 7;
                    if intMonth > 6 then intDayOfWeek := (intDayOfWeek + 30) mod 7;
                    if intMonth > 7 then intDayOfWeek := (intDayOfWeek + 31) mod 7;
                    if intMonth > 8 then intDayOfWeek := (intDayOfWeek + 31) mod 7;
                    if intMonth > 9 then intDayOfWeek := (intDayOfWeek + 30) mod 7;
                    if intMonth > 10 then intDayOfWeek := (intDayOfWeek + 31) mod 7;
                    if intMonth > 11 then intDayOfWeek := (intDayOfWeek + 30) mod 7;
            
                    {Be careful that intDayOfWeek can not be 0}
                    if intDayOfWeek = 0 then intDayOfWeek := 7; 
                    
                    {Tell user the latest result}
                    writeln('First day in ', intMonth, '(st/nd/rd/th) month of ', intYear);
                    writeln(' is the ', intDayOfWeek, '(st/nd/rd/th) day of week!');
                    
                    {Calculate the calendar}
                    for intTemp := 1 to intDayOfWeek - 1 do intCalendar[intTemp] := 0;
                    
                    {Jan/Mar/May/Jul/Aug/Oct/Dec}
                    if (intMonth = 1) or (intMonth = 3) or 
                        (intMonth = 5) or (intMonth = 7)
                        or (intMonth = 8) or (intMonth = 10) or (intMonth = 12) then
                    begin
                        
                        for intTemp := intDayOfWeek to intDayOfWeek + 31 do
                            intCalendar[intTemp] := intTemp - intDayOfWeek + 1;
                            
                        for intTemp := intDayOfWeek + 31 to 42 do
                            intCalendar[intTemp] := 0;
                        
                    end;
                    
                    {Apr/Jun/Sep/Nov}
                    if (intMonth = 4) or (intMonth = 6) or 
                        (intMonth = 9) or (intMonth = 11) then
                    begin
                    
                        for intTemp := intDayOfWeek to intDayOfWeek + 30 do
                            intCalendar[intTemp] := intTemp - intDayOfWeek + 1;
                            
                        for intTemp := intDayOfWeek + 30 to 42 do
                            intCalendar[intTemp] := 0;
                    
                    end;
                    
                    {Feb}
                    if (intMonth = 2) then
                    begin
                    
                        for intTemp := intDayOfWeek to intDayOfWeek + 28 do
                            intCalendar[intTemp] := intTemp - intDayOfWeek + 1;
                        
                        for intTemp := intDayOfWeek + 28 to 42 do
                            intCalendar[intTemp] := 0;
                            
                        if (intTempYear mod 4 = 0) and (intTempYear <> 1900) then
                            intCalendar[intDayOfWeek + 28] := 29;
                    
                    end;
                    
                    {Print the calendar}
                    writeln;
                    writeln('  Mon  |  Tue  |  Wed  |  Thu  |  Fri  |  Sat  |  Sun');
                    
                    for intTemp := 1 to 42 do
                    begin
                    
                        if (intCalendar[intTemp] < 10) and (intCalendar[intTemp] > 0) then
                            write('|', ' ':3, intCalendar[intTemp], ' ':2, '|');
                        
                        if intCalendar[intTemp] >= 10 then
                            write('|', ' ':2, intCalendar[intTemp], ' ':2, '|');
                        
                        if intCalendar[intTemp] = 0 then write(' ':7, '|');
                        if intTemp mod 7 = 0 then writeln;
                    
                    end;
                    
                    writeln;
                    
                end;

            end;

        2:  {Exit}
            begin
                writeln('Prepare to Exit...');
                intExit := 1;
            end;

        3:    {Other input}
            writeln('I can not understand what you have just input!');
        end;

    until intExit = 1;  {End repeat}

    {Prepare to exit}
    writeln('Press Any Key to Continue...');
    readln;

end.

需要注意的几点：

1）关于FreePascalIDE的乱码

这个问题是由于控制台的编码方式错误导致的

解决方案在命令行属性中，在“选项”选项卡中把编码方式改成“437 (OEM-美国)”

修改后就可以看到无乱码的FreePascalIDE了

2）FreePascalIDE中编译的时候并不会对源码进行保存操作，要经常按F2保存代码，否则不慎关闭追悔莫及。这个IDE环境在关闭时是没有保存提示的，所有未保存的操作都会丢失。

END

转载于:https://my.oschina.net/Tsybius2014/blog/371864