Bài 18: Ví dụ về cách viết và sử dụng chương trình con

program tg;

uses crt;

var x,y,z:real;

begin

clrscr;

readln(x,y,z);

if not((x+y>z) and (x+z>y) and (y+z>x)) then write('NO') else write('YES');

readln;

end.

USES crt;

VAR a,b,c:integer;

PROCEDURE xet(x,y,z:integer);

Begin

if (x+y>z) or (y+z>x) or (z+x>y) then

writeln('Do la ba canh cua tam giac')

else writeln('Ba canh do khong phai ba canh tam giac');

End;

{.------------------------------------}

BEGIN

clrscr;

write('Nhap a:'); readln(a);

write('Nhap b:'); readln(b);

write('Nhap c:'); readln(c);

xet(a,b,c);

readln;

END.

Program Tam_giac;
Var a,b,c,cv,dt,p:real;
Begin
write(' Nhap a=');readln(a);
write(' Nhap b=');readln(b);
write(' Nhap c=');readln(c);
if (a+b)<=c or (a+c)<=b or (b+c)>a then
write(' A,b,c khong phai 3 canh tam giac')
else
cv:=a+b+c;
p:=cv/2;
dt:sprt((P*(P-a)*(P-b)*(P-c));
write(' Dien tich tam giac',Dt:7:3);
write(' Chu vi tam giac:', Cv:7:3);
readln;
End.
Gõ vào rồi kiểm tra kết quả xem

uses crt;

var s:string; i:integer;

begin

clrscr;

writeln('hay nhap xau');readln(s);

while s[1]=' ' do delete(s,1,1);

while s[length(s)]=' ' do delete(s,length(s),1);

for i:= 1 to length(s) do while (s[i]=' ') and (s[i+1]=' ') do delete(s,i,1) ;

s[1]:=upcase(s[1]);

for i:=1 to length(s) do if s[i-1]=' ' then s[i]:=upcase(s[i]);

writeln(s);

readln;

end.

Bài 1: 

function min(a,b:longint):longint;

begin

min:=a;

if min>b then min:=b;

end;

Bài 2: 

function canhhuyen(a,b:real):real;

var c:real;

begin

c:=sqrt(sqr(a)+sqr(b));

canhhuyen:=c;

end;

Bài 1: 

function canbac2(x:longint):real;

begin

canbac2:=sqrt(x);

end;

Bài 2: 

function tong(n:longint):longint;

var s,i:longint;

begin

s:=0;

for i:=1 to n do 

  s:=s+i;

tong:=s;

end;

*Cách có sử dụng chương trình con:

uses crt;

var st:string;

{--------------chuong-trinh-con---------------}

function doixau(st:string):string;

var i,d:integer;

begin

   d:=length(st);

   for i:=1 to d do

     st[i]:=upcase(st[i]);

   doixau:=st;

end;

{-------------chuong-trinh-chinh---------------}

begin

clrscr;

write('Nhap xau:'); readln(st);

writeln('Xau doi sang chu hoa la: ',doixau(st));

readln;

end.

*Cách không sử dụng chương trình con:

uses crt;

var st:string;

i,d:integer;

begin

clrscr;

write('Nhap xau:'); readln(st);

d:=length(st);

for i:=1 to d do 

 st[i]:=upcase(st[i]);

writeln('Xau sau khi doi la: ',st);

readln;

end.

Cách 1: Có sử dụng chương trình con

uses crt;

var st:string;

{------------chuong-trinh-con-------------------}

function doi(st1:string):string;

var i,d:integer;

begin

d:=length(st1);

for i:=1 to d do 

  st1[i]:=upcase(st1[i]);

doi:=st1;

end;

{-------------------chuong-trinh-chinh--------------------}

begin

clrscr;

write('Nhap xau:'); readln(st);

writeln(doi(st));

readln;

end.

Cách 2: Không sử dụng chương trình con

uses crt;

var st:string;

i,d:integer;

begin

clrscr;

write('Nhap xau:'); readln(st);

d:=length(st);

for i:=1 to d do 

  st[i]:=upcase(st[i]);

writeln(st);

readln;

end.