...多給點分吧.做這種東西不簡單的啊。
Program ex;
Uses
crt;
Const
monthday: array [1..12] of integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
monthname: array [1..12] of string[10] =
('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
dayname: array [0..6] of string[10] =
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
Var
year, month, week, i, j, k: integer;
ok: boolean;
ch: char;
Procedure formline(a, b, c, d: char);
var
i: integer;
begin
write(' ', a);
for i:=1 to 5 do write(d);
write(b);
for i:=1 to 5 do write(d);
write(b);
for i:=1 to 5 do write(d);
write(b);
for i:=1 to 5 do write(d);
write(b);
for i:=1 to 5 do write(d);
write(b);
for i:=1 to 5 do write(d);
write(b);
for i:=1 to 5 do write(d);
writeln(c);
end;
Function getdayname(yy, mm: integer): integer;
var
i, k: integer;
begin
k := 1;
for i:=1 to mm - 1 do
k := k + monthday[i] + ord((i = 2) and ((yy mod 4 = 0) and (yy mod 100 <> 0) or (yy mod 400 = 0)));
getdayname := ((yy - 1) * 365 + (yy - 1) div 4 + (yy - 1) div 400 - (yy - 1) div 100 + k) mod 7;
end;
Begin
repeat
clrscr;
writeln('You can input a month of a year like ');
writeln('> 2008 8');
writeln('And the program will show the calendar of the month.');
write('> ');
while keypressed do
readkey;
readln(year, month);
clrscr;
for i:=1 to 4 do
writeln;
writeln(monthname[month], ', ', year);
writeln;
formline(#218, #194, #191, #196);
write(' '#179' ');
for i:=0 to 6 do write(dayname[i], ' '#179' ');
writeln;
formline(#195, #197, #180, #196);
j := getdayname(year, month);
ok := false;
k := 0;
i := 0;
repeat
case ok of
true: begin
inc(i);
write(' '#179' ', i:3);
if i + 1 > monthday[month] + ord((month = 2) and ((year mod 4 = 0) and (year mod 100 <> 0) or (year mod 400 = 0))) then
begin
ok := false;
j := 8;
end;
end;
false:begin
if k = j then
begin
inc(i);
ok := true;
write(' '#179' ', i:3);
end else
write(' '#179' ---');
end;
end;
inc(k);
if k = 7 then
begin
writeln(' '#179' ');
if ok then
formline(#195, #197, #180, #196) else
formline(#192, #193, #217, #196);
k := 0;
end;
until (not ok) and (k = 0);
while keypressed do
readkey;
writeln(' Press <ESC> to quit, Press otherkeys to redo.');
ch := readkey;
until ch = #27;
End.
回freebirdz,這個程序很有意思,對自己也很有用的.
回樓主,改了壹點,原來空格被系統吞了幾個,導致輸出格式有點問題.