Chương trình con có code

CHƯƠNG TRÌNH CON
Người viết : Trần Quang Linh
Nguồn Tài Liệu : Thầy Lê Văn Hưng

Thủ Tục và Hàm
Bài Tập :
Bài 1 Dùng thủ tục giải và biện luận phương trình
bậc hai ax^2+bx+c=0.
Bài Làm:
program bai_1;
uses crt;
var a,b,c: longint;
procedure giai_2 (a1,b2,c3 :longint);
var d : longint;
begin
if a1 = 0 then writeln(' khong phai phuong trinh bac hai')
else
begin
d:= b2*b2-4*a1*c3;
if d < 0 then writeln('Phuong trinh vo nghiem')
else if d = 0 then writeln(' x1 = x2 = ',-b2/2*a1)
else


writeln(' x1 = ',(-b2+sqrt(d))/(2*a1),' x2= ',(-b2-sqrt(d))/(2*a1));
end;
end;
begin
clrscr;
writeln(' nhap a,b,c ');
readln(a,b,c);

giai_2(a,b,c);
readln
end.

Bài 2 Hãy viết lại thủ tục Insert đối với một chuỗi kí
tự cho trước tùy ý.
Bài Làm:
program bai_2;
uses crt;
var xaucon,xaume:string;
sl: byte;
procedure demo_insert(s1,s2:string; vt:byte);
var ra:string;
i:byte;
begin
ra:='';
if vt = 1 then ra:=s1+s2 else
if vt > length(s2) then ra:=s2+s1 else
begin
for i:=1 to (vt-1) do ra:=ra+s2[i];


ra:=ra+s1;
for i:=vt to length(s2) do ra:=ra+s2[i];
end;
s2:=ra;
write('KET QUA :',s2);
end;
Begin
clrscr;

writeln(' THU TUC INSERT !!!');
write('nhap xau can chen:'); readln(xaucon);
write('nhap xau chen vao:'); readln(xaume);
write('nhap vi tri chen:'); readln(sl);
demo_insert(xaucon,xaume,sl);
readln
end.

Bài 3 Xây dựng thủ tục sau:
-

-

Thủ tục nhập vào 3 cạnh tam giác.
Thủ tục kiểm tra xem có phải tam giác hay
không? Đúng thì tính diện tích tam giác.
Thủ tục tính đường trung tuyến tam giác.

Bài Làm :
Program bai_3;
uses crt;
var a,b,c:real;

procedure nhapvao(a,b,c:real);


begin
write('nhap canh thu nhat cua tam giac :');
readln(a);
write('nhap canh thu hai cua tam giac :');

readln(b);
write('nhap canh thu ba cua tam giac:');
readln(c);
end;

procedure Kiem_s(a,b,c:real);
var s,p:real;
i:byte;
begin
if (a+b>c) and (a+c>b) and (b+c>a) then
begin
writeln(' La 1 tam giac');
p:=(a+b+c)/2;
s:=sqrt(p*(p-a)*(p-b)*(p-c));
writeln;
write('muon lay bao nhieu chu so sau dau phay:');
readln(i);
writeln;
write(' Co dien tich la:',s:0:i);
end
else writeln('Day khong pai tam giac');
end;
procedure trung_tuyen(a,b,c:real);


var i: byte;
begin
write('muon lay bao nhieu chu so sau dau phay:');
readln(i);
writeln('Trung tuyen ma: ',sqrt((2*b*b+2*c*c-a*a)/4):0:i);

writeln('Trung tuyen mb: ',sqrt((2*a*a+2*c*c-b*b)/4):0:i);
writeln('Trung tuyen mc: ',sqrt((2*b*b+2*a*a-c*c)/4):0:i);
end;
Begin
clrscr;
nhapvao(a,b,c);
Kiem_s(a,b,c);
trung_tuyen(a,b,c);
readln
End.

Bài 4 Xây dựng thủ tục giải phương trình x+y+z=12
trong phạm vi số nguyên không âm với điều kiện
x<4
Bài làm:
program bai_4;
uses crt;
procedure giai;
var i,j,k,m:longint;
begin
write('muon xem toc do bao nhieu nhap bang giay: ');
readln(m);


for i:=0 to 3 do
for j:=0 to 12 do
for k:=0 to 12 do
begin
if (i+j+k) = 12 then writeln('x =

',i,' y =

',j,'

z=

',k );

delay(m);
end;
end;
Begin
clrscr;
giai;
readln
End.

Bài 5 Cho số N,a,b,c tự nhiên . giải phương trình sau
trong phạm vi số nguyên không âm x+y+z=N điều
kiện xBài Làm :
Program bai_5;
uses crt;
var a,b,c,n,x,y,z,i,m:longint;
Begin
clrscr;
writeln(' Giai phuong trinh x+y+z=N ');
write('Nhap dieu kien xreadln(a,b,c,n);
if a+b+c-3

Begin
write('Vo nghiem !!! '); readln;
exit;
End
else Begin
write('muon xem toc do bao nhieu nhap bang giay: ');
readln(m);
for x:=0 to a-1 do
for y:=0 to b-1 do
for z:=0 to c-1 do
Begin
if x+y+z=n then writeln('x = ',x,'

y = ' ,y,'

z=

',z);

delay(m);
End;
End;
readln;
End.

Bài 6 Viết thủ tục Compare(s1,s2:string; var
kq:string) thực hiện công việc sau : so sánh hai xâu
s1 và s2 ,tìm tất cả các kí tự có trên hai xâu . xâu kết

quả chỉ chứa mỗi kí tự 1 lần.
Bài Làm :
program bai_6;
uses crt;
var s11,s21:string;
procedure compare(s1,s2:string );


var kq:string;
i:byte;
begin
kq:='';
for i:=1 to length(s1) do
begin
if pos(s1[i],s2) <>0 then kq:=kq+s1[i] ;
while pos(s1[i],s2) <>0 do
begin
delete(s2,pos(s1[i],s2),1);
end;
end;
writeln('KQ:',kq);
end;
begin
clrscr;
write('nhap s1:'); readln(s11);
write('nhap s2:'); readln(s21);
compare(s11,s21);
readln
end.

Bài 7 Viết hàm tính D(st1,st2) , với U ,V là hai xâu kí
tự bất kì , tổng số các kí tự không giống nhau trong
hai xâu trên , mỗi kí tự chỉ được nhớ 1 lần .
Bài Làm :
program Bai_7;


uses crt;
var xauvao,xauvao1 : string;
function D(s1,s2:string ) : byte ;
var tg:string;
i:byte;
begin
tg:='';
for i:=1 to length(s1) do
if pos(s1[i],s2) <> 0 then { kiểm tra xem có phần tử s1[i] giống trong s2 }
begin
tg:=tg+s1[i];
while pos(s1[i],s2) <> 0 do
delete(s2,pos(s1[i],s2),1); { xoá hết phần tử giống nhau trên
s2}
end;
for i:=1 to length(tg) do
if pos(tg[i],s1) <> 0 then
begin
while pos(tg[i],s1) <> 0 do
delete(s1,pos(tg[i],s1),1);{ xoá hết phần tử giống nhau trên
s1}
end;
D:=length(s1)+length(s2);

end;
Begin
clrscr;
write('Nhap Xau : '); readln(xauvao);


write('Nhap Xau : '); readln(xauvao1);
writeln('So phan tu khac nhau la :',D(xauvao,xauvao1));
readln
End.

Bài 8 Viết các chương trình thực hiện công việc
sau :
1.
2.
3.

Nhập dữ liệu (nhập số tự nhiên n).
Phân tích thành thừa số nguyên tố .
Thoát khỏi chương trình.

Bài Làm :
program bai_8;
uses crt;
var n:longint;
procedure nhap;
begin
write('Nhap So:');
readln(n);
end;

function kiem_so_ngto(a:longint):longint;
var i,j :integer;
begin
j:=0;
for i:=1 to a do
if a mod i = 0 then inc(j);
if j = 2 then kiem_so_ngto:=0;
end;


procedure phan_tich(n:longint);
var a1:longint;
begin
write('Phan tich ',n,' = ');
a1:=2;
while n <> 1 do
begin
if n mod a1 =0 then
begin
write(a1,'.');
n:=n div a1;
end
else inc(a1);
end;
end;
procedure thoat;
begin
writeln;
writeln('Thoat Enter !');
end;

Begin
clrscr;
nhap;
if (n>1) and (kiem_so_ngto(n) > 0) then phan_tich(n) else writeln('Khong
the phan tich thanh thua so cac so nguyen to .');
thoat;
readln


End.