Một số bài tập Pascal phần 3 - Tham khảo

201/Làm tròn số thực:
[CODE] Program Lam_tron;
Var
so:Real;
le:Integer;
(*---------------*)
FUNCTION Tron(so:Real;le:Integer):Real;
Var
i,n:LongInt;
Begin
For i:=1 To le+1 Do
so:=so*10;
n:=Trunc(so);
If (n Mod 10) >= 5 Then
n:=(n Div 10) +1
Else
n:=n Div 10;
so:=n;
For i:=1 To le Do
so:=so/10;
Tron:=so;
End;
(*---------------*)
BEGIN
Writeln(`LAM TRON SO THUC`);
Writeln(` Su dung ham`);
Writeln(`----------------`);
Write(`-Nhap so: `);
Readln(so);
Write(`-Can bao nhieu so le: `);
Readln(le);
Writeln;
Writeln(` KET QUA`);
Writeln(`*So nhap vao = `,so:12:10);
Writeln(`*So lam tron = `,Tron(so,le):12:le);
Writeln;
Write(` Bam phim de ket thuc `);
Readln
END. [/CODE]

202/Loang màu:
[CODE] Program Loang_mau;
Uses Crt;
Const
St=` Chao mung ban da den voi THPTXuanLoc.CoM `;
Var
k:Integer;
Procedure Mau(nen,chu:Integer);
Begin
TextBackGround(nen);
TextColor(chu);
End;
BEGIN
TextMode(C80);
TextBackGround(Black);
ClrScr;
For k:=2 To 23 Do
Begin
Mau(k Mod 8,(k+4) Mod 8 + 8);
GotoXY(1,k);
Write(St)
End;
Readln
END. [/CODE]

203/Máy tính tay:
[CODE] Program May_tinh_tay;
Var
so1,so2,kq:Real;
toantu,tiep:Char;
thuchien:Boolean;
Begin
Writeln(` MAY TINH TAY`);
Writeln(`Thuc hien 4 phep tinh so hoc`);
Writeln(`----------------------------`);
Repeat
Write(`-Bam so: `);
Readln(so1);
Write(`-Phep toan(+,-,*,/): `);
Readln(toantu);
Write(`-Bam so: `);
Readln(so2);
thuchien:=True;
Case toantu Of
`+` :kq:=so1+so2;
`-` :kq:=so1-so2;
`*` :kq:=so1*so2;
`/` :If so2 <> 0 Then
kq:=so1/so2
Else
thuchien:=False;
Else thuchien:=False;
End;
If thuchien Then
Writeln(`+Ket qua = `,kq:6:2)
Else
Writeln(`+Khong lam duoc`);
Writeln;
Write(`-Thuc hien tiep khong ? (C/K) `);
Readln(tiep);
Until Upcase(tiep) = `K`;
Writeln;
Writeln(` Bam phim de ket thuc`);
Readln
End. [/CODE]

204/Năm nhuận hay năm thường:
[CODE] Program Nam_nhuan;
Var
nam:Word;
nhuan:boolean;
Begin
Writeln(`NAM NHUAN HAY NAM THUONG`);
Writeln(`------------------------`);
Write(`-Nhap vao nam can kiem tra: `);
Readln(nam);
If nam Mod 100 = 0 Then
Nhuan:=(nam Mod 400)=0
Else
Nhuan:=(nam Mod 4)=0;
Write(`Nam: `,nam, ` la: `);
If nhuan Then
Writeln(`nam nhuan`)
Else
Writeln(`nam thuong ( khong nhuan)`);
Writeln;
Writeln(` Bam phim de ket thuc`);
Readln
End. [/CODE]

205/Ngày thứ mấy trong tuần:
[CODE] Program Thu_trong_tuan;