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

Thảo luận trong 'Tin học cấp II' bắt đầu bởi khanhduy2311, 17 Tháng sáu 2021.

Lượt xem: 41

  1. khanhduy2311

    khanhduy2311 Học sinh mới Thành viên

    Bài viết:
    9
    Điểm thành tích:
    6
    Nơi ở:
    Bình Định
    Trường học/Cơ quan:
    Trường Trung học cơ sở An Hòa
    Sở hữu bí kíp ĐỖ ĐẠI HỌC ít nhất 24đ - Đặt chỗ ngay!

    Đọc sách & cùng chia sẻ cảm nhận về sách số 2


    Chào bạn mới. Bạn hãy đăng nhập và hỗ trợ thành viên môn học bạn học tốt. Cộng đồng sẽ hỗ trợ bạn CHÂN THÀNH khi bạn cần trợ giúp. Đừng chỉ nghĩ cho riêng mình. Hãy cho đi để cuộc sống này ý nghĩa hơn bạn nhé. Yêu thương!

    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.
     
Chú ý: Trả lời bài viết tuân thủ NỘI QUY. Xin cảm ơn!

Draft saved Draft deleted

CHIA SẺ TRANG NÀY