Thư Viện Các Dạng Bài Tập Pascal của Tin Học 1 1 P- 123docz.net

151/Chạy chử 2:

Program Chu_Chay;

Uses Crt;

Const

a='Nha sach Minh Khai, 249 Nguyen Thi Minh Khai, Quan 1, Tp Ho Chi Minh ';

b='Tel: 8 331 124, 9 250 590 ';

c='Chuyen phat hanh cac giao trinh tin hoc phuc vu hoc sinh, sinh vien';

d='Chan thanh cam on quy doc gia';

Function Lap(Kt:Char; N:Integer): String;

Var Tam:String; K:Integer; Begin Tam:=' '; For K:=1 To N Do Tam:=Tam+Kt; Lap:=Tam; End; {---}

Procedure WriteXY(X,Y:Integer; St:String);

Begin GotoXY(X,Y); Write(St); End; {---} Function Min(a,b:Integer):Integer; Begin If a < b Then Min:=a Else Min:=b; End; {---} Procedure Chuchay(St:String); Var k:Integer; Tin:String; Begin Tin:=Lap(' ',68)+'<<' +St+' '; For k:=1 To Length(Tin) Do Begin TextColor(k MOD 16); WriteXY(6,8,Copy(Tin,k,Min(68,Length(Tin)-k+1))); Delay(100); End; End; {---} Procedure Khung(x1,y1,x2,y2:Integer); Var k:Integer; Begin TextColor(14); WriteXY(x1,y1,#201); For k:=x1+1 To x2-1 Do Write(#205); Write(#187); WriteXY(x1,y2,#200); For k:=x1+1 To x2-1 Do

Write(#205);

Write(#188);

For k:=y1+1 To y2-1 Do

Begin WriteXY(x1,k,#186); WriteXY(x2,k,#186); End; End; {---} BEGIN TextBackGround(1); ClrScr; TextColor(3+Blink); GotoXY(30,4); Writeln('NAM HOC 1999 -2000'); Khung(5,7,75,9); Repeat Chuchay(a); Chuchay(b); Chuchay(c); Chuchay(d); Until KeyPressed; END.

152/Chuỗi đối xứng:

Program Chuoi_Doi_Xung;

Var

St:String;

i,l:Byte;

Begin

Writeln('CHUOI DOI XUNG');

Writeln(' ---');

Write('-Nhap chuoi: ');

Readln(St);

l:=Length(St);

i:=1;

While (i < l Div 2) And (St[i] = St[l-i+1]) Do

Begin

i:=i+1;

If i < (l Div 2) Then

Writeln('+Chuoi nay doi xung')

End;

While (i < l Div 2) And (St[i] <> St[l-i+1]) Do

Begin

i:=i+1;

If i < (l Div 2) Then

Writeln('+Chuoi nay khong doi xung')

End;

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln End. 153/Phép trừ: Program Phep_Tru; Var so1,so2,hieu :Integer; Begin

Writeln(' CHUONG TRINH THUC HIEN PHEP TRU SO HOC');

Writeln(' co toi da 4 ky so');

Write('-Nhap so thu nhat = ');

Readln(so1);

Write('-Nhap so thu hai = ');

Readln(so2); hieu:= so1-so2; Writeln; Writeln; Writeln('---'); Writeln; Writeln(' ',so1:4); Writeln(' - ',so2:4); Writeln(' ---'); Writeln(' = ',hieu:5); Readln End.

154/Diện tích hình thang:

Program Hinh_thang;

Var

a,b,h:Integer;

S:Real;

Begin

Writeln('CHUONG TRINH TINH DIEN TICH HINH THANG');

Write('-Cho biet day ngan = ');

Readln(a);

Write('-Cho biet day dai = ');

Readln(b);

Write('-Cho biet chieu cao = ');

Readln(h);

S := 0.5 * (a + b) * h;

Writeln('+Dien tich hinh thang = ',s:6:2,' met vuong');

Readln

End.

155/Diện tích tam giác:

Program Tam_Giac;

Var

a,b,c:Integer;

p,s:Real;

Begin

Writeln('CHUONG TRINH TINH DIEN TICH TAM GIAC');

Write('-Cho biet canh thu nhat = ');

Readln(a);

Write('-Cho biet canh thu hai = ');

Readln(b);

Write('-Cho biet canh thu ba = ');

Readln(c);

p := 0.5 * (a + b + c);

s := sqrt(p*(p-a)*(p-b)*(p-c));

Writeln('+Dien tich hinh tam giac = ',s:6:2,' met vuong');

Readln

End.

156/Tính lực hút giữa 2 vật:

Program Luc_hut;

CONST

Var

m1,m2,d,f:Real;

Begin

Writeln('CHUONG TRINH TINH LUC HUT GIUA 2 VAT');

Write('-Khoi luong m1 (gam) = ');

Readln(m1);

Write('-Khoi luong m2 (gam) = ');

Readln(m2);

Write('-Khoang cac giua 2 vat (Cm) = ');

Readln(d);

f := g * m1 * m2 / sqr(d);

Writeln('+Luc hut giua 2 vat = ',f:6:2);

Readln End. 157/Tính lương: Program Tinh_luong; Var Ten:String; nc,pc,tam:Integer; bl,hs,tt,cl:Real; Begin

Writeln('CHUONG TRINH TINH LUONG');

Writeln('---');

Write('-Cho biet ho ten : ');

Readln(ten);

Write('-Cho biet bac luong : ');

Readln(bl);

Write('-Cho biet ngay cong : ');

Readln(nc);

Write('-Cho biet he so trach nhiem : ');

Readln(hs);

Write('-Cho biet phu cap khu vuc = ');

Readln(pc);

Write('-Cho biet so tien da tam ung ky 1 = ');

Readln(tam);

tt := ((bl/30 * nc * hs)+pc);

cl := tt - tam;

Writeln;

Writeln('+Ong (Ba) : ',ten:24);

Writeln('+Tien luong trong thang = ',tt:10:2,' dong');

Writeln('+So tien con linh = ',cl:10:2,' dong');

Writeln(' Bam phim <Enter> de ket thuc');

Readln End. 158/Tính PigNet: Program Pignet; Var Ten:String; Tuoi:Integer; lon,nho,tb,tl,cao,pig:Real; Begin

Writeln('CHUONG TRINH TINH PIGNET');

Writeln('---');

Write('-Cho biet ho ten : ');

Readln(ten);

Write('-Cho biet tuoi : ');

Write('-Cho biet chieu cao : ');

Readln(cao);

Write('-Cho biet trong luong : ');

Readln(tl);

Write('-So do vong nguc luc hit vao = ');

Readln(lon);

Write('-So do vong nguc luc tho ra = ');

Readln(nho);

tb := 0.5 * (lon-nho);

pig := cao - (tb + tl);

Writeln;

Write('+Ong (Ba) : ',ten:24);

Writeln(' , ',tuoi,' tuoi');

Writeln('+Co so do Pignet = ',pig:6:2);

Readln

End.

159/Tính thể tích hình cầu:

Program Hinh_cau;

Var

s:integer;

r,v:Real;

Begin

Writeln('CHUONG TRINH TINH THE TICH HINH CAU');

Writeln('---');

Write('Cho biet dien tich hinh tron = ');

Readln(s);

r:=Sqrt(s/4*3.1416);

v:=4/3 * 3.1416 *r*r*r;

Writeln('*The tich hinh cau la : ',V:6:2,' met khoi');

Readln

End.

160/Cộng thêm giây vào giờ hiện hành:

Program Cong_giay;

Var

gio,phut,giay,them:Integer;

Begin

Writeln('CONG THEM GIAY VAO GIO HIEN HANH');

Writeln('---');

Writeln('Nhap vao gio:phut:giay hien hanh');

Write('-Gio : '); Readln(gio); Write('-Phut: '); Readln(phut); Write('-Giay: '); Readln(giay);

Write('-Cho biet so giay muon cong them: ');

Readln(them); If (giay+them) < 60 Then giay:=giay+them Else Begin giay:=((giay+them)-60); phut:=phut+1; If phut >=60 Then Begin phut:=phut-60; gio:=gio+1;

End;

Writeln;

Writeln('+Sau khi cong them so giay vao, gio moi la:');

Writeln(' ',gio,' : ',phut,' : ',giay);

Writeln;

Writeln('Bam phim <Enter> de ket thuc');

Readln

End.

161/Đoán số bạn đang nghĩ trong đầu:

Program Doan_so; Var tren,duoi,giua:Integer; chon:Word; Begin tren:=100; duoi:=1;

While duoi < tren Do

Begin

Writeln('DOAN SO BAN DANG NGHI TRONG DAU');

Writeln('---');

giua:=(tren+duoi) Div 2;

Writeln('-So cua ban Ty: ',giua);

Writeln('-Neu go so 0 se ngung');

Writeln('-Neu ban Ty noi so ',giua,' nho hon thi ban Teo go 1 ');

Write('-Neu ban Ty noi so ',giua,' lon hon thi ban Teo go 2 ');

Readln(chon); If chon = 0 Then exit; If chon = 1 Then duoi:=giua Else tren:=giua End; Readln End.

162/Đổi chổ 2 số nguyên:

Program Doi_cho;

Var

so1,so2:Integer;

Begin

Writeln('DOI CHO 2 SO NGUYEN');

Writeln('---');

Write('-Nhap so thu nhat: ');

Readln(so1);

Write('-Nhap so thu hai : ');

Readln(so2);

so1:=so1+so2;

so2:=so1-so2;

so1:=so1-so2;

Writeln('SAU KHI CHUYEN CHO');

Writeln('+So thu nhat bay gio la: ',so1);

Writeln('+So thu hai bay gio la : ',so2);

Readln

End.

Program Doi_cho;

Var

so1,so2:Integer;

(*---*)

PROCEDURE Doi(Var n,m:Integer);

Var tam:Integer; Begin tam:=n; n:=m; m:=tam; End; (*---*) BEGIN

Writeln('DOI CHO 2 SO');

Writeln('Dung thu tuc');

Writeln('---');

Write('-Nhap so thu nhat: ');

Readln(so1);

Write('-Nhap so thu hai: ');

Readln(so2);

Writeln('=================');

Writeln(' Truoc khi doi cho');

Writeln('+So thu nhat = ',so1);

Writeln('+So thu hai = ',so2);

Writeln(' Sau khi doi cho');

Doi(so1,so2);

Writeln('*So thu nhat : ',so1);

Writeln('*So thu hai : ',so2);

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

Readln

END.

164/Đổi chử thường ra chử hoa:

Program Doi_chu_hoa;

Var

Chuoi:String;

(*---*)

PROCEDURE Doi(Var St:String);

Var

i:Byte;

Begin

For i:=1 To Length(St) Do

St[i]:=Upcase(St[i]);

End;

(*---*)

BEGIN

Writeln('DOI CHU THUONG RA CHU HOA');

Writeln(' Dung thu tuc');

Writeln('---');

Write('-Nhap mot chuoi ky tu : ');

Readln(Chuoi);

Writeln;

Doi(Chuoi);

Writeln('+Doi ra chu hoa = ',chuoi);

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

END.

165/Đổi nhiệt độ sang Farenheit:

Program Doi_nhiet_do; Var t:Real; tiep:Char; (*---*) FUNCTION Doi(x:Real):Real; Begin Doi:=((9*x/5) + 32); End; (*---*) BEGIN Repeat

Writeln('DOI DO BACH PHAN SANG DO FARENHEIT');

Writeln(' Su dung ham');

Writeln('---');

Write('-Nhap do bach phan: ');

Readln(t);

Writeln('*Doi sang do Farenheit = ',Doi(t):6:2);

Writeln;

Write('-Co tiep tuc khong ? (c/k) ');

Readln(tiep);

Until tiep='k' ;

END.

166/Đổi nhiệt độ sang Celcius:

Program Doi_do_F_C;

Var

f,c:Real;

Begin

Writeln('DOI DO FAHRENHEIT SANG CELCIUS');

Write('-Cho biet do Fahrenheit : ');

Readln(f);

c:=((f-32) * 5)/9;

Writeln;

Writeln(f:5:2,' do Fahrenheit doi sang do Celcius = ',c:5:2,#248);

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

167/Đổi Mike sang KM:

Program Doi_do_Mile_Km; Const Km_Mile=1.609344; Var m,k:Real; Begin

Writeln('DOI MILE SANG Km');

Write('-Cho biet so Mile can doi: ');

Readln(m);

k:=m * Km_Mile;

Writeln;

Writeln(m:5:2,' dam Anh doi thanh = ',k:5:2,' Km');

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

End.

168/Đổi ngày ra thứ trong tuần:

Program Thu_trong_tuan; Var d:1..31; m:1..14; y:1900..2000; a:Integer; Begin

Writeln('DOI NGAY RA THU TRONG TUAN');

Writeln(' Lich the ky 20');

Writeln('---'); Repeat Write('-Ngay ( so 0 de ngung): '); Readln(d); If d = 0 Then Exit; Write('-Thang: '); Readln(m); Write('-Nam: '); Readln(y); If m < 3 Then Begin m:=m+12; Dec(y); End;

a:=d+2*m+(3*(m+1) Div 5)+y+(y Div 4) + 1;

a:=a Mod 7;

Case a Of

0 :Begin

Write('Ngay ',d:2,' / ',m:2,' / ',y:4);

Writeln(' la ngay Thu Bay');

End;

1 :Begin

Write('Ngay ',d:2,' / ',m:2,' / ',y:4);

Writeln(' la ngay Chu Nhat');

End;

Else

Begin

Write('Ngay ',d:2,' / ',m:2,' / ',y:4);

Writeln(' la ngay ',a);

End;

Until d=0;

End.

169/Đổi hệ 10 sang hệ 16:

Program Doi_he_so; Var n:Integer; (*---*) FUNCTION Doi(so:Integer):String; Const ky_so:Array[0..15] Of Char =('0','1','2','3','4','5', '6','7','8','9','A','B','C','D','E','F'); Var tam1:Integer; tam2:String;

Begin

tam1:=Hi(so);

tam2:=ky_so[tam1 Shr 4] + ky_so[tam1 And $0F];

tam1:=Lo(so);

Doi:=tam2+ky_so[tam1 Shr 4] +Ky_so[tam1 And $0F]

End;

(*---*)

BEGIN

Repeat

Writeln('DOI SO HE 10 SANG HE 16');

Writeln(' Su dung ham ');

Writeln('---');

Writeln('Nhap mot so nguyen tu -32768 den 32767');

Write('neu nhap so 0 se ket thuc ');

Readln(n);

Writeln;

Writeln('+So he 10 la = ',n);

Writeln('+Doi sang he 16 la = ',Doi(n));

Writeln;

Until n=0;

END.

170/Đổi hệ 10 sang hệ 16 (code 2):

Program Doi_he_16; Var n,so,chuso:Integer; tiep:Char; Begin Writeln('DOI SO HE 10 SANG HE 16'); Writeln('---'); Repeat Write('-Nhap so he 10 = '); Readln(so); n:=4096; {16 luy thua 3} Write('+Ky so he 16= '); Repeat chuso:=so Div n; Case chuso Of 0..9:Write(chuso); 10 .. 15:Write(chr(chuso + 55)); End;

so:=so- n*(so Div n);

n:=n Div 16;

Until n=0;

Writeln;

Write('-Co thuc hien tiep khong ? (C/K) ');

Readln(tiep);

Until Upcase(tiep)='K';

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

171/Đổi hệ 10 sang hệ 2:

Program Doi_so_he_2;

Var

n,so:Integer;

tiep:Char;

Writeln('DOI SO HE 10 SANG HE 2');

Writeln('---');

Repeat

Write('-Nhap so nguyen he 10: ');

Readln(so);

n:=16384; {Gan n= 2 luy thua 14}

Writeln;

Write('+So he 2 la ');

Repeat

Write(so Div n);

so:=so - n * (so Div n);

n:= n Div 2;

Until n=0;

Writeln;

Write('-Tiep tuc nua khong (C/K) ');

Readln(tiep);

Until Upcase(tiep)='K';

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

172/Đổi hệ 16 sang hệ 10:

Program Doi_he_so; Var Ky_so:String; (*---*) FUNCTION Doiso(x:String):Integer; Var j,tong,nhan,so:Integer; tam:Char; Begin tong:=0; nhan:=1;

For j:= length(x) Downto 1 Do

Begin

tam:=x[j];

If Ord(tam)= 32 Then

tam:='0';

If tam in['0'..'9','A'..'F'] Then {Toan tu in}

Begin so:=Ord(tam) - 48; If so > 9 Then so:=so-7; tong:=tong + so*nhan; End Else Begin Doiso:=0; Exit; End; nhan:=nhan*16 End; Doiso:=tong; End; (*---*) BEGIN Writeln('DOI SO HE 16 SANG HE 10');

Writeln('---');

Repeat

Write('Nhap ky so he 16 (go kk de dung): ');

Readln(ky_so);

Writeln;

Writeln('+Doi sang he 10 la = ',Doiso(ky_so));

Writeln;

Until ky_so='kk';

END.

173/Đổi số ra chử:

Program Doi_So_ra_chu; TYPE ChuSo='0'..'9'; Donvi=(Muoi,Tram); Phamvi= 0..999; CONST

KS:Array[ChuSo] Of String=(' ','mot ',' hai',' ba',

' bon',' nam',' sau',' bay',' tam',' chin');

DV:Array[DonVi] Of String[6]=(' muoi ',' tram');

Var n:Phamvi; sn,s:String; Dodai:Byte; Begin Writeln('DOI SO RA CHU'); Writeln('---'); Writeln;

Write('-Nhap mot so tu 0 den 999: ');

Readln(n); Str(n,sn); DoDai:=Length(sn); Case DoDai Of 1: s:=KS[sn[1]]; 2: Begin If Sn[1] = '1' Then s:='muoi' Else s:=KS[sn[1]]+DV[Muoi]; If sn[2] = '5' Then s:=s+'lam' Else s:=s+KS[sn[2]]; End; 3: Begin s:=KS[sn[1]]+DV[Tram]; Case sn[2] Of '0' : If sn[3] <> '0' Then s:=s+'le'; '1' : s:=s+'muoi'; Else s:=s+KS[sn[2]]+DV[Muoi]; End; If (sn[3]='5') And (sn[2] <>'0') then s:=s+'lam' Else s:=s+KS[sn[3]]; End; End;

Writeln(s);

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

readln

End.

174/Đổi số hệ thập phân sang hệ bất kì:

Program Doi_thap_phan_ra_he_bat_ky;

Var

He10,N,Y,HeN:Word;

He,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE BAT KY');

Writeln(' ---');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10);

N:=He10;

Write('-Doi sang he nao: ');

Readln(HeN);

He:=' ';

Repeat

Y:=He10 Mod HeN;

If Y < 10 Then

Str(Y, Tam)

Else

Tam:=Chr(Y+55);

He:=Tam + He;

He10:= He10 Div HeN;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la : ',N);

Writeln('+Doi sang he: ',HeN:2,' la: ',He);

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

175/Đổi số hệ thập phân sang hệ bất phân:

Program Doi_thap_phan_ra_bat_phan;

Var

He10,N,Y:Word;

He8,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE BAT PHAN');

Writeln(' ---');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10); N:=He10; He8:=' '; Repeat Y:=He10 Mod 8; Str(Y, Tam); He8:=Tam + He8;

He10:= He10 Div 8;

Until He10 = 0;

Writeln;

Writeln('+Doi sang he 8 la: ',He8);

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

176/Thập phân sang nhị phân:

Program Doi_thap_phan_ra_nhi_phan;

Var

He10,N,Y:Word;

He2,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE NHI PHAN');

Writeln(' ---');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10); N:=He10; He2:=' '; Repeat Y:=He10 Mod 2; Str(Y, Tam); He2:=Tam + He2;

He10:= He10 Div 2;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la : ',N);

Writeln('+Doi sang he 2 la: ',He2);

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

177/Thập phân sang thập lục:

Program Doi_thap_phan_ra_thap_luc;

Var

He10,N,Y:Word;

He16,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE THAP LUC PHAN');

Writeln(' ---');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10); N:=He10; He16:=' '; Repeat Y:=He10 Mod 16; If Y < 10 Then Str(Y, Tam) Else Tam:=Chr(Y+55); He16:=Tam + He16;

He10:= He10 Div 16;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la : ',N);

Writeln('+Doi sang he 16 la: ',He16);

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

178/Đổi tên tháng từ số ra chử:

Program In_ten_thang; Var n:Byte; (*---*) FUNCTION thang(x:Byte):String; Const Ten_thang:Array[1..12] Of String=('Gieng','Hai','Ba', 'Tu','Nam','Sau','Bay','Tam','Chin','Muoi','Mot','Chap'); Begin

thang:=' Thang '+Ten_thang[x];

End;

(*---*)

BEGIN

Writeln('DOI TEN THANG TU SO RA CHU');

Writeln(' Su dung ham');

Writeln('---');

Write('-Thang : ');

Readln(n);

If (n < 1) And (n > 12) Then

Write('Khong hop le')

Else

Write(thang(n));

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

Readln

END.

179/Đổi tiền sao cho số tờ ít nhất:

Program Doi_tien; Var sotien:LongInt; (*---*) PROCEDURE Doi(St:LongInt); Const Loai:Array[1..6] Of Integer =(50,20,10,5,2,1); Var i,soto:Integer; Begin i:=1; Repeat

soto:=st Div loai[i];

If soto <> 0 Then

Writeln(soto,' to loai ',loai[i],' ngan dong');

st:=st Mod loai[i]; i:=i+1; Until st=0; End; (*---*) BEGIN

Writeln('DOI TIEN SAO CHO SO TO IT NHAT');

Writeln(' Dung thu tuc');

Writeln('---');

Repeat

Readln(Sotien);

Doi(Sotien);

Writeln;

Until sotien=0;

END.

180/Đổi số ra chử HOA:

Program Doi_So_Ra_Chu; Var Tiep:Char; Chuoitk,Chuoikq:String; So:0..999; Tram,Chuc,Donvi:0..9; Begin Tiep:='C'; While UpCase(Tiep)='C' Do Begin {$R+}

Chuoitk:='MOT HAI BA BON NAM SAU BAY TAM CHIN';

Write('-Nhap so can doi: ');

Readln(so); If So = 0 Then Writeln('So khong') Else Begin Tram:=So Div 100; Chuc:=(So-Tram * 100) Div 10; Donvi:= So Mod 10; Chuoikq:=' ';

If (Donvi > 0) And (Donvi <> 5) Then

Chuoikq :=Chuoikq + Copy(Chuoitk,4* Donvi -3,4);

If (Donvi = 5) And (Chuc = 0) Then

Chuoikq :=Chuoikq + ' NAM';

If (Donvi = 5) And (Chuc > 0) Then

Chuoikq := Copy(Chuoitk,4 * Chuc-3,4)+' LAM';

If (Donvi = 5) And (Chuc = 1) Then

Chuoikq := ' LAM';

If Chuc = 1 Then

Chuoikq:='MUOI'+chuoikq;

If (Chuc > 1) And (Donvi = 0) Then

Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI ';

If (Chuc > 1) And (Donvi = 1) Then

Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI '+Chuoikq;

If (Chuc > 1) And (Donvi > 1) And (Donvi <>5) Then

Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI '+Chuoikq;

If (Tram > 0) And (Chuc=0) And (Donvi=0) Then

Chuoikq:=Copy(Chuoitk,4*Tram-3,4)+' TRAM ';

If (Tram > 0) And (Chuc = 0) And (Donvi > 0) Then

Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM LINH '+ Copy(Chuoitk,4*Donvi-3,4);

If (Tram > 0) And (Chuc = 1) And (Donvi = 0) Then

Chuoikq := Copy(Chuoitk,4*Tram-3,4)+ 'TRAM MUOI';

If (Tram > 0) And (Chuc >= 2) And (Donvi = 0) Then

Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI';

If (Tram > 0) And (Chuc <> 0) And (Donvi > 0) Then

Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI '+

Copy(Chuoitk,4*Donvi-3,4);

If (Tram > 0) And (Chuc <> 0) And (Donvi = 5) Then

Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI LAM';

End;

Writeln;

Write('+Tiep tuc nua khong (C/K) ');

Readln(Tiep);

End;

End.

181/Chương trình tham quan:

Program Du_lich; Uses Crt; TYPE Diadiem=Set of 1..5; Var ng1,ng2,ng3,Ba,Hai,Mot:DiaDiem; ch1,ch2,ch3,i:Byte; (*---*) PROCEDURE Den(i:Byte); Begin Case i Of 1:Write('Da Lat '); 2:Write('Vung Tau '); 3:Write('Nha Trang '); 4:Write('Hue '); 5:Write('Ha Noi '); End; End; (*---*) BEGIN ClrScr;

Writeln('CHUONG TRINH THAM QUAN');

Writeln('---');

Writeln(' 1-Da Lat');

Writeln(' 2-Vung Tau');

Writeln(' 3-Nha Trang');

Writeln(' 4-Hue');

Writeln(' 5-Ha Noi');

Writeln('Chon noi nao, go cac so tu 1 den 5');

Writeln('1-Nguoi thu nhat chon 3 noi:');

Write(' -Noi thu nhat: ');

Readln(ch1);

Write(' -Noi thu hai: ');

Readln(ch2);

Write(' -Noi thu ba: ');

Readln(ch3);

ng1:=[ch1,ch2,ch3];

Writeln('2-Nguoi thu hai chon 3 noi:');

Write(' -Noi thu nhat: ');

Readln(ch1);

Write(' -Noi thu hai: ');

Readln(ch2);

Write(' -Noi thu ba: ');

Readln(ch3);

ng2:=[ch1,ch2,ch3];

Writeln('3-Nguoi thu ba chon 3 noi:');

Write(' -Noi thu nhat: ');

Readln(ch1);

Write(' -Noi thu hai: ');

Readln(ch2);

Readln(ch3); ng3:=[ch1,ch2,ch3]; Ba:=ng1 * ng2 * ng3; Hai:=(ng1*ng2-ng3) + (ng2*ng3-ng1) + (ng3*ng1-ng2); Mot:=ng1 + ng2 +ng3; Writeln;

Writeln('*Cac noi ma ca 3 nguoi deu chon: ');

For i:=1 To 5 Do

If i In Ba Then

Den(i);

Writeln;

Writeln('*Noi chi co 2 nguoi chon: ');

For i:=1 To 5 Do

If i In Hai Then

Den(i);

Writeln;

Writeln('*Noi chi co 1 nguoi chon: ');

For i:=1 To 5 Do

If i In Mot Then

Den(i);

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

Readln

END.

182/Gấp giấy có độ dày 1 mét:

Program gap_giay;

Var

day:Real;

solan:Integer;

Begin

Writeln('GAP GIAY CO DO DAY 1 MET');

Writeln('---'); day:=0.1; solan:=0; While day < 1000 Do Begin day:=day * 2; solan:=solan+1; End; Writeln;

Writeln('+Phai gap toi: ',solan,' lan');

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

183/Giải phương trình trùng phương:

Program Phuong_trinh_trung_phuong; Var n,k:0..4; y:Array[1..2] Of Real; a,b,c,delta:Real; Begin

Writeln('GIAI PHUONG TRINH TRUNG PHUONG');

Writeln('---');

Repeat

Write('-Nhap he so a: ');

Until a <> 0; Write('-Nhap he so b: '); Readln(b); Write('-Nhap he so c: '); Readln(c); Delta:=b*b-4*a*c; If Delta < 0 Then Begin y[1]:=-1; y[2]:=-1; End; If Delta = 0 Then Begin y[1]:=-1; y[2]:=-b/(2*a); End; If Delta > 0 Then Begin y[1]:=(-b+sqrt(Delta))/(2*a); y[2]:=(-b-sqrt(Delta))/(2*a); End; n:=0;

Writeln(' KET QUA');

for k:=1 to 2 Do If y[k] > 0 Then Begin Writeln(' +X1= ',Sqrt(y[k]):5:3); Writeln(' +X2= ',-Sqrt(y[k]):5:3); Inc(n,2) End Else If y[k] = 0 Then Begin Writeln('X = 0'); Inc(n); End; If n=0 Then

Writeln('Phuong trinh vo nghiem')

Else

Writeln('Phuong trinh co ',n,' nghiem');

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

Readln

End.

184/Gửi tìm tiết kiệm:

Program Gui_tiet_kiem; Var x,y:Real; thang:Word; tiep:Char; Begin

Writeln('GUI TIEN TIET KIEM');

Writeln('---');

Repeat

Write('-So tien hien co: ');

Readln(x);

Write('-So tien muon co: ');

thang:=0;

Repeat

inc(thang);

x:= x *1.015;

Until x >=y;

Writeln('+Thoi gian can gui: ',thang,' thang');

Writeln;

Write('-Co tiep tuc nua khong (C/K) ');

Readln(tiep); Until Upcase(tiep)='K'; End. 185/Hàm X mũ N: Program X_mu_n; Var x:Integer; n:Word; (*---*) FUNCTION ham_mu(i:Integer;k:Word):LongInt; Begin If k = 0 Then ham_mu:=1 Else ham_mu:=i*ham_mu(i,k-1); End; (*---*) BEGIN Writeln('HAM X MU N'); Writeln('---'); Write('-Nhap X = '); Readln(x); Write('-Nhap N = '); Readln(n);

Writeln('*Ket qua = ',Ham_mu(x,n));

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

Readln

END.

186/Hoán vị 2 con trỏ thay cho hoán vị nội dung:

Program Hoan_Vi_Chuoi; Uses Crt; VAR Chuoi1,Chuoi2,Tam :^String; Begin ClrScr;

Writeln('HOAN VI 2 CON TRO THAY CHO HOAN VI NOI DUNG');

Writeln('---');

Writeln;

New(Chuoi1);

New(Chuoi2);

Chuoi1^ := 'Giao trinh Turbo Pascal 7.0';

Chuoi2^ := 'Giao trinh FoxPro 2.6';

Writeln;

Writeln('NOI DUNG BAN DAU CUA 2 CHUOI');

Writeln('---');

Writeln;

Writeln('-Chuoi thu nhat: ',Chuoi1^);

Writeln;

Writeln('NOI DUNG SAU KHI HOAN VI 2 CON TRO');

Writeln('---');

Writeln;

Tam := Chuoi1;

Chuoi1 := Chuoi2;

Chuoi2 := Tam;

Writeln('-Chuoi thu nhat: ',Chuoi1^);

Writeln('-Chuoi thu hai : ',Chuoi2^);

Dispose(Chuoi1);

Dispose(Chuoi2);

Writeln;

Write(' Bam <Enter> . . . ');

Readln;

End.

187/Hướng dẫn mua vé máy bay:

Program Huong_dan;

Var

chon:Byte;

Begin

Writeln('HUONG DAN MUA VE MAY BAY');

Writeln('---');

Writeln(' 1-Tp Ho Chi Minh di Ha Noi');

Writeln(' 2-Tp Ho Chi Minh di Da Nang');

Writeln(' 3-Tp Ho Chi Minh di Nha Trang');

Writeln(' 4-Tp Ho Chi Minh di Phu Quoc');

Writeln(' 5-Tp Ho Chi Minh di Con Dao');

Writeln(' 6-Tp Ho Chi Minh di Paris');

Writeln(' 7-Tp Ho Chi Minh di London');

Writeln(' 8-Tp Ho Chi Minh di Moscow');

Writeln(' 9-Tp Ho Chi Minh di Bac Kinh');

Writeln(' 10-Tp Ho Chi Minh di Tokyo');

Write('-Chon tuyen nao, go vao so tuong ung (1 - 10): ');

Readln(chon);

Case chon of

1 :Writeln(' Xin moi den quay ve so 1');

2 :Writeln(' Xin moi den quay ve so 2');

3 :Writeln(' Xin moi den quay ve so 3');

4 :Writeln(' Xin moi den quay ve so 4');

5 :Writeln(' Xin moi den quay ve so 5');

6 :Writeln(' Xin moi den quay ve so 6');

7 :Writeln(' Xin moi den quay ve so 7');

8 :Writeln(' Xin moi den quay ve so 8');

9 :Writeln(' Xin moi den quay ve so 9');

10 :Writeln(' Xin moi den quay ve so 10');

Else Writeln('-Khong co tuyen bay nay');

End;

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

188/In các số khác nhau của dãy số:

Program So_khac_nhau;

CONST

M=100;

TYPE

DayNguyen=Array[1..M] Of Integer; Var a:DayNguyen; i,n:Integer; x:DaySo; Begin

Writeln('IN CAC SO KHAC NHAU CUA DAY SO');

Writeln('---');

Repeat

Write('Nhap bao nhieu so: ');

Readln(n);

Until N <= M;

For i:=1 To N Do

Begin

Write('-Phan tu thu: ',i,' = ');

Readln(a[i]);

End;

x:=[];

For i:=1 To N Do

If Not (a[i] In x) Then

Begin

Write(a[i],', ');

x:=x+[a[i]];

End;

Writeln;

Write(' Bam phim <Enter> de ket thuc ');

Readln

End.

189/In dãy Fibonaci:

Program Day_so_Fibonaci;

Var

n,j,pj,pj1,pj2:Integer;

Begin

Writeln('IN DAY SO FIBONACI');

Writeln('---'); Write('-Nhap so N= '); Readln(n); j:=2; pj:=1; pj1:=1; While j <> n Do Begin pj2:=pj1; pj1:=pj; pj:=pj1+pj2; j:=j+1; End; Writeln;

Writeln('+So hang thu ',n,' cua day Fibonaci = ',pj);

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

190/In lá cờ nước mĩ ra màn hình:

Program Co_My;

Var

Begin

Writeln('IN LA CO NUOC MY RA MAN HINH');

Writeln('---');

Write('-Nhap chieu rong_1: ');

Readln(rong1);

Write('-Nhap chieu rong_2: ');

Readln(rong2);

Write('-Nhap chieu dai_1: ');

Readln(dai1);

Write('-Nhap chieu dai_2: ');

Readln(dai2);

For i:=1 To rong1 Do

Begin

If odd(i) Then

Begin

For j:=1 To (dai1 Div 2) Do

Write('*',' '); If odd(dai1) Then Write(' ','*'); End Else Begin

For j:=1 To (dai1 Div 2) Do

Write(' ','*'); If odd(dai1) Then Write(' '); End; For j:=1 to dai2 Do Write('='); Writeln; End;

For i:=1 To rong2 Do

Begin For j:=1 To dai1+dai2 Do Write('='); Writeln; End; Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

191/In xen kẻ các dấu sao:

Program In_xen_ke;

Var

dai,rong,i,j:Byte;

Begin

Writeln('IN XEN KE CAC DAU SAO');

Writeln('---');

Write('-Nhap chieu dai: ');

Readln(dai);

Writeln('-Nhap chieu rong: ');

Readln(rong);

For i:=1 To rong Do

Begin

If i Mod 2 = 0 Then

For j:=1 To dai Div 2 Do

Write(' *') {dau trang va dau sao}

For j:=1 To dai Div 2 +dai Mod 2 Do

Write('* '); {dau sao va dau trang}

Writeln;

End;

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

192/Khảo sát 2 đường tròn:

Program Khao_Sat_Hai_Duong_Tron; TYPE DuongTron = RECORD R : Real; x, y : Real; End; VAR Dt1, Dt2 : DuongTron;

Kc, Tong, Hieu : Real;

BEGIN

Writeln('KHAO SAT 2 DUONG TRON');

Writeln('---');

Writeln;

Writeln('*Duong tron thu nhat');

Write(' +Ban kinh: ');

Readln(Dt1.R); Write(' +Toa do x: '); Readln(Dt1.x); Write(' +Toa do y: '); Readln(Dt1.y); writeln;

Writeln('*Duong tron thu hai');

Write(' +Ban kinh: ');

Readln(Dt2.R); Write(' +Toa do x: '); Readln(Dt2.x); Write(' +Toa do y: '); Readln(Dt2.y); Kc := Sqrt(Sqr(Dt1.x - Dt2.x) + Sqr(Dt1.y - Dt2.y)); Tong := Dt1.R + Dt2.R; Hieu := ABS(Dt1.R - Dt2.R);

If (Kc = 0) AND (Hieu = 0) Then

Writeln('-Hai duong tron trung nhau')

Else

If (Hieu > Kc) Then

Writeln('-Hai duong tron long nhau')

Else

If (Tong = Kc) OR (Hieu = Kc) Then

Writeln('-Hai duong tron tiep xuc nhau')

Else

If (Tong > Kc) AND (Hieu < Kc) Then

Writeln('-Hai duong tron cat nhau')

Else

If (Tong < Kc) Then

Writeln('-Hai duong tron o ngoai nhau');

Readln

END.

Program Khoi_lap_phuong;

Var

a,b,c,m,n,tam:Integer;

Begin

Writeln('KHOI LAP PHUONG CHUI QUA KHUNG CHU NHAT');

Writeln('---');

Writeln(' *Nhap so lieu cho khoi lap phuong');

Write('-Canh thu nhat: ');

Readln(a);

Write('-Canh thu hai : ');

Readln(b);

Write('-Canh thu ba : ');

Readln(c);

Writeln(' *Nap so lieu cho khung chu nhat');

Write('-Canh thu nhat: ');

Readln(m);

Write('-Canh thu hai : ');

Readln(n); If (a>b) Then Begin tam:=a; a:=b; b:=tam; End; If (b>c) Then Begin tam:=b; b:=c; c:=tam; End; If (a>b) Then Begin tam:=a; a:=b; b:=tam; End; If (m>n) Then Begin tam:=m; m:=n; n:=tam; End;

If (a<m) And (b<n) Then

Writeln('+Khoi lap phuong chui qua duoc khung chu nhat')

Else

Writeln('+Khoi lap phuong khong chui qua duoc khung chu nhat');

Writeln;

Writeln(' Bam phim <Enter> de ket thuc');

Readln

End.

194/Kiểm phiếu bầu cử chi đoàn:

Program Bau_cu; CONST Max=100; ucv=5; tke:Array[1..5] Of Word =(0,0,0,0,0); TYPE stt=1..ucv;

phieubau=Set of stt; Var Phieu:Array[1..Max] Of Phieubau; n,n1,i:1..Max; j:1..ucv; Ch:Char; Bau:0..5; Begin

Writeln('KIEM PHIEU BAU CU CHI DOAN TN');

Writeln('---');

Write('-Cho biet so nguoi tham gia bau (1..100): ');

Readln(n);

{Gan tat ca cac tap hop bang rong}

FillChar(Phieu, Sizeof(Phieu), #0);

{Nhap phieu bau cua tat ca cac cu tri}

For i:=1 To N Do

Begin

Write('-Cu tri thu ',i);

For j:=1 To ucv Do

Begin

Write(' +Chon ung cu vien thu ',j,' (C/K) ? ');

Readln(Ch);

Thư Viện Các Dạng Bài Tập Pascal của Tin Học 1 1 Phần 3 151/Chạy chử 2: