一个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