Tin học Thư viện các hàm ,thủ tục với số, xâu

[khanhduy2311]

[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!

ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.

MÃ:
unit Mytool;
interface
type kieumang=array[1..1000] of integer;
function ngto(n:integer):boolean;
function tongcs(n:integer):integer;
function songto(n:integer):boolean;
function ucln(a,b:integer):integer;
function tonguoc(n:integer):integer;
function sohoanhao(n:integer):boolean;
function bcnn(a,b:integer):longint;
function sodep(n:integer):boolean;
function pytago(a,b,c:integer):boolean;
procedure bo3pytago(var n:integer);
function dx(x:integer):boolean;
procedure ptnt(var n:integer);
procedure locso(var s:string);
procedure nhapday(var a:kieumang;n:integer);
procedure daoxau(var s:string);
procedure xoatrangthua(var s:string);
function luythua( n:integer):longint;
implementation
function ngto(n:integer):boolean; {1}
var i:integer;
begin
ngto:=false;
if n<2 then exit;
for i:=2 to trunc(sqrt(n)) do
if n mod i=0 then exit;
ngto:=true;
end;
function tongcs(n:longint):integer; {2}
var s:integer;
begin
s:=0;
while n<>0 do
begin
s:=s+n mod 10;
n:=n div 10;
end;
tongcs:=s;
end;
function songto(n:integer):boolean; {3}
begin
songto:=false;
if ngto(n) and ngto(tongcs(n)) then songto:=true;
end;
function ucln(a,b:integer):integer; {4}
var r:integer;
begin
while b<>0 do
begin
r:=a mod b;
a:=b;
b:=r;
end;
ucln:=a;
end;
function tonguoc(n:integer):integer; {5}
var i,s:integer;
begin
s:=0;
for i:=1 to n div 2 do
if n mod i=0 then s:=s+i;
tonguoc:=s;
end;
function sohoanhao(n:integer):boolean; {6}
begin
sohoanhao:=false;
if tonguoc(n)=n then sohoanhao:=true;
end;
function bcnn(a,b:integer):longint; {7}
var k:longint;
begin
for k:=a to a*b do
if (k mod a=0) and (k mod b=0) then break;
bcnn:=k;
end;
function sodep(n:integer):boolean; {8}
var s1,s2:string;
m,t,i:integer;
begin
sodep:=false;
str(n,s1);
for i:=1 to length(s1) do
begin
s2:='';
s2:=s2+s1;
val(s2,m);
t:=t+m*m;
end;
if ngto(m) then sodep:=true;
end;
function pytago(a,b,c:integer):boolean; {9}
begin
pytago:=false;
if (a*a+b*b=c*c) or (a*a+c*c=b*b) or (b*b+c*c=a*a) then pytago:=true;
end;
procedure bo3pytago(var n:integer); {10}
var a,b,c,g,h,i:integer;k:boolean;
begin
k:=false;
for a:=1 to n do
for b:=1 to n do
for c:=1 to n do
begin
if (a+b+c=n) then
if (pytago(a,b,c)=true) then
begin
g:=a;
h:=b;
i:=c;
k:=true;
end;
end;
if k=true then writeln(g:5,h:5,i:5) else writeln('Khong co so nao');
end;
function dx(x:longint):boolean; {11}
var s:string[10];
i:byte;
begin
str(x,s);
for i:=1 to length(s) div 2 do
if s<>s[length(s)-i+1] then
exit(false);
exit(true);
end;
procedure ptnt(var n:longint); {12}
var i: longint;s1,s2:string;
begin
i:=2;s1:='';
Write(n,'=');
While n>1 do
Begin
if n mod i = 0 then
Begin
str(i,s2);
s1:=s1+s2;
s1:=s1+'x';
n:= n div i;
s2:=' ';
End
else i:=i+1;
End;
delete(s1,length(s1),1);
write(s1);
End;
procedure locso(var s:string); {13}
var s2:string;i:byte;
begin
s2:='';
for i:=1 to length(s) do
if ord(s) in [48..57] then s2:=s2+s;
writeln(s2);
end;
procedure nhapday(var a:kieumang;n:integer); {14}
var i:integer;
begin
for i:=1 to n do
begin
write('A[',i,']=');readln(a);
end;
end;
procedure daoxau(var s:string); {15}
var i:byte;s2:string;
begin
s2:='';
for i:=length(s) downto 1 do s2:=s2+s;
writeln(s2);
end;
procedure xoatrangthua(var s:string); {16}
begin
while s[1]=#32 do delete(s,1,1);
while s[length(s)]=#32 do delete(s,length(s),1);
while pos(' ',s)<>0 do delete(s,pos(' ',s),1);
end;
function luythua(n:integer):longint; {17}
var i:integer;s:longint;
begin
if n=0 then exit else
begin
s:=1;
for i:=1 to n do s:=s*n;
luythua:=s;
end;
end;
end.