Question

[Đỗ Quốc An]

viết chương trình in lịch lên màn hình trong pascal

Answer 1

[Châu Trần Vũ Ngọc]

(* Date & Time: 13/01/13 01:37am

Author: NV Nhan *)

Program doingay_calender;

Uses Crt; {Unit}

Type

kq=string[25];

Var

cont: char; {Variable to repeat program}

d, m, y, j, k: integer;

Function doithu(d, m, y: integer):kq; {Ham nay tra ve thu cua ngay can xem}

Const

ngaythang: array[0..11] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

Var tong, i: integer;

Begin

tong := (y-1)*365 + (y-1) div 4;

If (y mod 4) = 0 then ngaythang[1]:=29; {Nam nhuan}

For i:=0 to m-2 do tong := tong + ngaythang[i];

tong := tong+d; {tong so ngay tu 01/01/01 den dd/mm/yyyy}

Case (tong mod 7) of

0: doithu:='Thu Bay';

1: doithu:='Chu Nhat';

2: doithu:='Thu Hai';

3: doithu:='Thu Ba';

4: doithu:='Thu Tu';

5: doithu:='Thu Nam';

6: doithu:='Thu Sau';

End; {End case}

End; {End function}

Function doingayi(d, m, y:integer):integer; {Ham nay tra ve 1 so: neu la t2 thi tra ve 0, t3 thi tra ve 1...}

Const

ngaythang: array[0..11] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

Var tong, i: integer;

Begin

tong := (y-1)*365 + (y-1) div 4;

If (y mod 4) = 0 then ngaythang[1]:=29; {Nam nhuan}

For i:=0 to m-2 do tong := tong + ngaythang[i];

tong := tong+d; {tong so ngay tu 01/01/01 den dd/mm/yyyy}

Case (tong mod 7) of

2: doingayi:=0; {Monday}

3: doingayi:=1;

4: doingayi:=2;

5: doingayi:=3;

6: doingayi:=4;

0: doingayi:=5;

1: doingayi:=6; {Sunday}

End; {End case}

End; {End function}

Function max_day(m, y:integer):integer; {Number day of a month in year}

Begin

Case m of

1, 3, 5, 7, 8, 10, 12: max_day:=31;

4, 6, 9, 11: max_day:=30;

2: If y mod 4 = 0 then max_day:=29 else max_day:=28;

End; {End case}

End; {End function}

{Main program}

Begin

Repeat {To repeat application until viewer press 'k'}

Clrscr; {Clear screen}

{Main code}

gotoxy((80-length('Nhap ngay muon xem: ')) div 2, 3); {Center align}

textcolor(white); {Text color}

write('Nhap ngay muon xem: '); read(d, m, y);

If (y<=0) or (m>12) or (m<1) or (d<1) or (d>31) or (((m=4) or (m=6) or (m=9) or (m=11)) and (d=31)) or (((y mod 4)<>0) and (m=2) and (d>28)) or ((m=2) and (d>29)) then {Dong dieu kien ghep kiem tra dung dinh dang ngay}

Begin

gotoxy((80-length('Nhap lai ngay thang nam!')) div 2, 5); {Center Align}

textcolor(3); {Color: aqua}

writeln('Nhap lai ngay thang nam!');

delay(1000);

cont:='c';

End else {When date, month, year are true}

Begin

gotoxy((80-length('Ngay 00/00/0000 la thu xxx ')) div 2, 5); {Center Align}

textcolor(2); {color: Green}

write('Ngay ');

If d<10 then write('0', d) else write(d); write('/');

If m<10 then write('0', m) else write(m); write('/');

write(y, ' la '); {Write Ngay xx/xx/xxx la thu xxx}

textcolor(red); {Color: Red}

write(doithu(d, m, y)); {In ra thu can xem}

textcolor(7); {Color: Gray}

writeln('.');

gotoxy((80-length('-----')) div 2, 6);

write('-----');

gotoxy((80-length('Lich thang xx nam xxxx')) div 2, 7); {Center Align}

writeln('Lich thang ', m, ' nam ', y);

writeln;

gotoxy(28, 9);

textcolor(yellow);

writeln(' 2 3 4 5 6 7 CN'); {Print month's calender}

gotoxy(28, 11);

For j:=0 to doingayi(1, m, y)-1 do write(' ');

For k:=1 to max_day(m, y) do

Begin

If k=d then

Begin

textcolor(red);

write(k:3);

End else

Begin

textcolor(white);

write(k:3);

End;

If doingayi(k, m, y)=6 then

Begin

writeln; writeln; write(' ');

End;

End;

writeln; writeln; {End program and play again?}

write('Muon tiep tuc nua khong? c/k '); cont:=readkey;

End;

Until cont='k'; {End repeat}

End. {End Code}

Cái này mình tham khảo trên mạng nha, ko phải của mình làm!