Kho thư viện Pascal (UNIT).

[chuonggoinhanvien]

THƯ VIỆN PASCAL
(UNIT)

Topic này là nơi dành cho các bạn share sản phẩm của mình.
Mong các bạn hãy nhiệt tình đóng góp.
Chúc các bạn thành công!
Yêu cầu:

• Trong thư viện có những hàm nào các bạn nên ghi rõ những hàm đó ra và cách dùng.
• Nếu sản phẩm chưa hoàn thiện, các bạn không nên post ở đây mà hãy lập 1 topic khác để thảo luận cho hoàn chinh rồi hãy post.
• Cấm SPAM dưới mọi hình thức.
  

​

​

[new led]

Cách tạo UNIT

I. KHÁI NIỆM UNIT là thư viện con của TP. Đó là các tập tin chứa các hằng, biến, kiểu, thủ tục và hàm có cùng một liên quan nào đó.
​ Các UNIT chuẩn của TP được chứa chung trong tập tin TURBO.TPL (TPL là chữ viết tắt của Turbo Pascal Library) gồm :
​

• Unit SYSTEM
• Unit CRT
• Unit PRINTER
• Unit DOS
• Unit OVERLAY

​ Các thư viện trên là thư viện nội trú, ngoài ra còn có các thư viện ngoại trú GRAPH.TPU, GRAPH3.TPU, …
​ Ngoài các UNIT chuẩn, TP cho phép người lập trình tạo riêng cho mình những UNIT mà nội dung cũng gồm các chương trình con (thủ tục và hàm), các biến, hằng do người lập trình định nghĩa.
​ Sau khi biên dịch (compiler) các UNIT thành mã máy (có phần mở rộng là *.TPU) thì các chương trình con đã được định nghĩa có thể gọi vào chương trình làm việc như các thủ tục và hàm chuẩn.
​ II. CÁCH TẠO UNIT Để tạo 1 UNIT, các chương trình con phải được đặt trong một tập tin, tên tập tin này bắt buộc phải trùng tên của UNIT.
​ Trong tập tin UNIT gồm các phần:

• Phần tên UNIT : bắt đầu bằng từ khóa UNIT sau đó là tên UNIT.
  Có dạng: UNIT <Unname>;
  Tên <Unname> bắt buộc phải trùng tên File khi ghi vào đĩa (chú ý không ghi phần đuôi “.PAS”).
• Phần INTERFACE (gọi là phần giao diện)
  Đây là phần khai báo tên các hằng, biến, hàm và thủ tục có giao diện với bên ngoài nghĩa là bất kì chương trình nào cũng sử dụng được các hằng, biến, hàm và thủ tục đó.
• Phần IMPLEMENTATION (gọi là phần thực hiện)
  Đây là phần kê khai nội dung của các chương trình con (thủ tục và hàm) gồm những chương trình con được kê khai trong phần giao diện và những chương trình con khác không kê khai trong phần giao diện nhưng cần thiết để phục vụ cho chương trình con có giao diện.
• Phần thân UNIT
  Đây là phần các lệnh mà khi gọi UNIT này sẽ được ưu tiên thực hiện trước. Phần này có thể có hoặc không.
• Kết thúc UNIT bằng lệnh END.

Sơ đồ UNIT có dạng như sau:
​

UNIT <Unname>;

  INTERFACE
      USES <Các Unit khác>;
      CONST <Các hằng được giao diện>;
      VAR <Các biến được giao diện>;
      PROCEDURE <Tên thủ tục được giao diện>;
      FUNCTION <Tên hàm được giao diện>;

  IMPLEMENTATION
      CONST <Các hằng không được giao diện>;
      VAR <Các biến không được giao diện>;
      PROCEDURE <Tên thủ tục>;
      {Các khai báo riêng của thủ tục}
      Begin
         <Nội dung của thủ tục>
      End;
      FUNCTION <Tên hàm>:<Kiểu hàm>;
      {Các khai báo riêng của hàm}
      Begin
         <Nội dung của hàm>
      End;
  BEGIN
      <Các lệnh nếu cần>
  END.

Chú ý: Nếu không có phần thân UNIT thì bỏ “BEGIN” và <các lệnh> nhưng phải có “END.” để kết thúc UNIT.

Chúc tất cả các bạn thành công!

[thambt029]

Unit Toan;

1 ví dụ cho các bạn dễ hiểu. UNIT Toán này tính phương trình bậc 1 và phương trình bậc 2.

UNIT Toan; //Khong duoc ghi la "TOAN.PAS"

INTERFACE
        Procedure PTB1(a, b: Real);
        Procedure PTB2(a, b, c: Real);

IMPLEMENTATION
        Procedure PTB1(a, b: Real);
        Begin
                If a <> 0 Then Writeln('Pt co 1 nghiem x = ',-b/a:0:2)
                Else
                        If b <> 0 Then Writeln('Pt vo nghiem')
                        Else
                                Writeln('Pt co vo so nghiem');
        End;
        (*============================================================*)
        Procedure PTB2(a, b, c: Real);
        Var Delta, x1, x2: Real;
        Begin
                Delta := sqr(b)-4*a*c;
                If delta < 0 then write('Pt vo nghiem')
                Else
                        If delta = 0 then write('Pt co nghiem kep x1 = x2 = ', -b/(2*a):0:2)
                        Else
                        Begin
                                x1 := (-b+sqrt(delta))/(2*a);
                                x2 := (-b-sqrt(delta))/(2*a);
                                Writeln('Pt co 2 nghiem x1 = ', x1:0:2,' | x2 = ', x2:0:2);
                        End;
                End;
        (*============================================================*)
END.

Sau khi ghi vào đĩa ta dịch UNIT bằng lệnh: Alt + F9.
Cách sử dụng UNIT Toan như sau:
Ví dụ:

Uses Crt, Toan;
Var a, b: Real;
Begin
   Read(a, b);
   Ptb1(a, b);
   Readln
End.

Chúc các bạn vui vẻ và có thêm nhiều đóng góp có ích cho diễn đàn! Xin cảm ơn!

[2edu]

Không biết có hữu ích không nhưng thấy mình thì xài nhiều^^.

Unit sort;
Interface
        const
                maxn1=200;
                maxn2=50000;
        type
                mang1=array[1..maxn1] of longint;
                mang2=array[1..maxn2] of longint;
        procedure bbsort(var a:mang1;d,c:byte);
        procedure qsort(var a:mang2;d,c:word);
        procedure swap(var a,b:longint);
Implementation
        procedure swap(var a,b:longint);
        var t:longint;
        begin
                t:=a;
                a:=b;
                b:=t;
        end;
        procedure bbsort(var a:mang1;d,c:byte);
        var
                i,j:byte;
        begin
                for j:=c downto 2 do
                        for i:=1 to j-1 do
                                if a[i]>a[j] then
                                        swap(a[i],a[j]);
        end;
        procedure qsort(var a:mang2;d,c:word);
        var
                i,j:word;
                mid:longint;
        begin
                i:=d;
                j:=c;
                mid:=a[(d+c) shr 1];
                repeat
                        while a[i]<mid do inc(i);
                        while a[j]>mid do dec(j);
                        if i<=j then
                                begin
                                        swap(a[i],a[j]);
                                        inc(i);
                                        dec(j);
                                end;
                until i>j;
                if i<c then qsort(a,i,c);
                if j>d then qsort(a,d,j);
        end;
END.

Lưu ý: sắp xếp tăng dần, bạn nào cần giảm dần thì làm thêm 1 unit nữa đảo chiều dấu nhá [IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]

[xecutkit]

Unit tìm min,max của 2 số và min max của 1 mảng 10^5 phần tử:

unit cal;
Interface
        const
                maxn=100000;
        type
                mangb=array[1..maxn] of byte;
                mangw=array[1..maxn] of word;
                mangli=array[1..maxn] of longint;
                mangint64=array[1..maxn] of int64;
        function max(a,b:byte):byte;
        function max(a,b:word):word;
        function max(a,b:longint):longint;
        function max(a,b:int64):int64;
        function min(a,b:byte):byte;
        function min(a,b:word):word;
        function min(a,b:longint):longint;
        function min(a,b:int64):int64;
        function max(a:mangb;n:longint):byte;
        function max(a:mangw;n:longint):word;
        function max(a:mangli;n:longint):longint;
        function max(a:mangint64;n:longint):int64;
        function min(a:mangb;n:longint):byte;
        function min(a:mangw;n:longint):word;
        function min(a:mangli;n:longint):longint;
        function min(a:mangint64;n:longint):int64;
Implementation
        function max(a,b:byte):byte;
        begin
                if a>b then exit(a)
                else exit(b);
        end;
        function min(a,b:byte):byte;
        begin
                if a<b then exit(a)
                else exit(b);
        end;
        function max(a,b:word):word;
        begin
                if a>b then exit(a)
                else exit(b);
        end;
        function min(a,b:word):word;
        begin
                if a<b then exit(a)
                else exit(b);
        end;
        function max(a,b:longint):longint;
        begin
                if a>b then exit(a)
                else exit(b);
        end;
        function min(a,b:longint):longint;
        begin
                if a<b then exit(a)
                else exit(b);
        end;
        function max(a,b:int64):int64;
        begin
                if a>b then exit(a)
                else exit(b);
        end;
        function min(a,b:int64):int64;
        begin
                if a<b then exit(a)
                else exit(b);
        end;
        function max(a:mangb;n:longint):byte;
        var i:longint;
        begin
                max:=a[1];
                for i:=2 to n do
                        if max<a[i] then max:=a[i];
        end;
        function min(a:mangb;n:longint):byte;
        var i:longint;
        begin
                min:=a[1];
                for i:=2 to n do
                        if min>a[i] then min:=a[i];
        end;
        function max(a:mangw;n:longint):word;
        var i:longint;
        begin
                max:=a[1];
                for i:=2 to n do
                        if max<a[i] then max:=a[i];
        end;
        function min(a:mangw;n:longint):word;
        var i:longint;
        begin
                min:=a[1];
                for i:=2 to n do
                        if min>a[i] then min:=a[i];
        end;
        function max(a:mangli;n:longint):longint;
        var i:longint;
        begin
                max:=a[1];
                for i:=2 to n do
                        if max<a[i] then max:=a[i];
        end;
        function min(a:mangli;n:longint):longint;
        var i:longint;
        begin
                min:=a[1];
                for i:=2 to n do
                        if min>a[i] then min:=a[i];
        end;
        function max(a:mangint64;n:longint):int64;
        var i:longint;
        begin
                max:=a[1];
                for i:=2 to n do
                        if max<a[i] then max:=a[i];
        end;
        function min(a:mangint64;n:longint):int64;
        var i:longint;
        begin
                min:=a[1];
                for i:=2 to n do
                        if min>a[i] then min:=a[i];
        end;
END.

[Mai Chi]

unit Simple về nhiều chức năng (toàn chức năng đơn giản thôi)
Cách sử dụng thì các bạn xem code thì biết ngay !

Unit Simple;  {tao unit co ten Simple.tpu}
Interface
  Uses crt;
  Type
    mang=array[1..100] of integer;
  Var
    m:integer;
    Function Fibo(n:integer):integer;
    Procedure KTKNcuaxau(s:string);
    Procedure XauDX(s:string);
    Function USCLN(a,b:integer):integer;
    Function NT(a:integer):boolean;
    Function TinhTongCS(a:integer):integer;
    Function GT(a:integer):longint;
    Function Luythua(a,n:integer):longint;
    Function Tong2(a,b:integer):integer;
    Function Hieu2(a,b:integer):integer;
    Function Tich2(a,b:integer):integer;
    Function Thuong2(a,b:integer):real;
    Procedure GiaiPTBac1(a,b:integer);
    Procedure GiaiPTBac2(a,b,c:integer);
    Function Tong3(a,b,c:integer):integer;
    Function Tong4(a,b,c,d:integer):integer;
    Function Tich4(a,b,c,d:integer):integer;
    Function Tich3(a,b,c:integer):integer;
    Function CP(a:integer):boolean;
    Function Lowcase(c:char):char;
    Procedure Swap(Var x,y:real);
    Procedure Phantich(n:integer);
    Function Max2(a,b:integer):integer;
    Function Max3(a,b,c:integer):integer;
    Function Min2(a,b:integer):integer;
    Function Min3(a,b,c:integer):integer;
    Procedure CSnhiphan(n:integer);
    Function Lapphuong(a:integer):integer;
    Function canbacn(x,n:integer):real;
    Function Hoanhao(n:integer):boolean;
    Function NTtuongduong(m,n:integer):boolean;
IMPLEMENTATION
  {------------------------------------------------------------------------}
  Function NTtuongduong(m,n:integer):boolean;
  Var
    D,i:longint;
  Begin
    D:=USCLN(m,n);
    I:=2;
    While d<>1 do
      Begin
        If d mod i=0 then
          Begin
            While d mod i=0 do d:=d div i;
            While m mod i=0 do m:=m div i;
            While n mod i=0 do n:=n div i;
          End;
        Inc(i);
      End;
    If m*n=1 then NTtuongduong:=True
    Else NTtuongduong:=False;
  End;
  {------------------------------------------------------------------------}
  Function Hoanhao(n:integer):boolean;
  Var
    j,t:integer;
  Begin
    t:=0;
    For j:=1 to (n div 2) do
      If n mod j=0 then
        T:=t+j;
    If t=n then
      Hoanhao:=True
    Else
      Hoanhao:=False;
  End;
  {--------------------------------------------------------------------------}
  Function canbacn(x,n:integer):real;
  Begin
    Canbacn:=Exp(1/n*Ln(x));
  End;
  {--------------------------------------------------------------------------}
  Function Lapphuong(a:integer):integer;
  Begin
    Lapphuong:=a*a*a;
  End;
  {--------------------------------------------------------------------------}
  Function Fibo(n:integer):integer;
  Var
    a:array[1..1000] of integer;
    i:integer;
  Begin
    a[1]:=1;
    a[2]:=1;
    For i:=1 to n do
      a[i]:=a[i-1]+a[i-2];
    Fibo:=a[i];
  End;
  {--------------------------------------------------------------------------}
  Procedure CSnhiphan(n:integer);
  Var
    a:array[1..100] of integer;
    i,j:integer;
  Begin
    i:=0;
    While n>=1 do
      Begin
        i:=i+1;
        If n Mod 2 =0 Then a[i]:=0
        Else a[i]:=1;
        n:= n div 2;
      End;
    For j:=i downto 1 do write(a[j]);
  End;
  {--------------------------------------------------------------------------}
  Function Max2(a,b:integer):integer;
  Begin
    Max2:=a;
    If b>a then max2:=b;
  End;
  {--------------------------------------------------------------------------}
  Function Min2(a,b:integer):integer;
  Begin
    Min2:=a;
    If b<a then min2:=b;
  End;
  {--------------------------------------------------------------------------}
  Function Max3(a,b,c:integer):integer;
  Var
    m:integer;
  Begin
    m:=a;
    If b>m then m:=b;
    If c>m then m:=c;
    max3:=m;
  End;
  {--------------------------------------------------------------------------}
  Function Min3(a,b,c:integer):integer;
  Var
    m:integer;
  Begin
    m:=a;
    If b<m then m:=b;
    If c<m then m:=c;
    Min3:=m;
  End;
  {--------------------------------------------------------------------------}
  Procedure Phantich(n:integer);
  Var
    i:integer;
  Begin
    i:=2;
    While n<>1 do
      Begin
        If n mod i=0 then
          Begin
            Write(i:5,'³',i:2);
            n:=n div i;
          End
        Else
          i:=i+1;
      End;
    Write(n:5,'³');
    Readln;
  End;
  {--------------------------------------------------------------------------}
  Procedure Swap(Var x,y:real);
  Var
    Temp:real;
  Begin
    Temp:=x;
    x:=y;
    y:=temp;
  End;
  {--------------------------------------------------------------------------}
  Function Lowcase(c:char):char;
  Begin
    If c in ['A'..'Z'] then Lowcase:=chr(ord(c)+32)
    Else Lowcase:=c;
  End;
  {--------------------------------------------------------------------------}
  Function CP(a:integer):boolean;
  Var
    i:integer;
  Begin
    For i:=1 to a div 2 do
      If sqr(i)=a then
        Begin
          CP:=True;
          Exit;
        End;
    CP:=False;
  End;
  {--------------------------------------------------------------------------}
  Function Tich4(a,b,c,d:integer):integer;
  Begin
    Tich4:=a*b*c*d;
  End;
  {--------------------------------------------------------------------------}
  Function Tich3(a,b,c:integer):integer;
  Begin
    Tich3:=a*b*c;
  End;
  {--------------------------------------------------------------------------}
  Function Tong3(a,b,c:integer):integer;
  Begin
    Tong3:=a+b+c;
  End;
  {--------------------------------------------------------------------------}
  Function Tong4(a,b,c,d:integer):integer;
  Begin
    Tong4:=a+b+c+d;
  End;
  {--------------------------------------------------------------------------}
  Function Tong2(a,b:integer):integer;
  Begin
    Tong2:=a+b;
  End;
  {--------------------------------------------------------------------------}
  Function Hieu2(a,b:integer):integer;
  Begin
    Hieu2:=a-b;
  End;
  {--------------------------------------------------------------------------}
  Function Tich2(a,b:integer):integer;
  Begin
    Tich2:=a*b;
  End;
  {--------------------------------------------------------------------------}
  Function Thuong2(a,b:integer):real;
  Begin
    Thuong2:=a+b;
  End;
  {--------------------------------------------------------------------------}
  Procedure GiaiPTBac1(a,b:integer);
  Begin
    If a=0 then write('Phuong Trinh Vo Nghiem !')
    Else
      Write('Phuong trinh co 1 ngiem duy nhat:',-b/a);
  End;
  {--------------------------------------------------------------------------}
  Procedure GiaiPTBac2(a,b,c:integer);
  Var
    d:integer;
  Begin
    If a=0 then write('Phuong trinh vo nghiem !')
    Else
      Begin
        D:=b*b-4*a*c;
        If d=0 then write('Phuong trinh co nghiem kep x1=x2=',-b/(2*a));
        If d<0 then write('Phuong trinh vo nghiem');
        If d>0 then
          Begin
            Writeln('Phuong trinh co 2 nghiem phan biet:');
            Write('x1=',(-b+sqrt(d))/(2*a));
            Writeln;
            Write('x2=',(-b-sqrt(d))/(2*a));
          End;
      End;
  End;
  {--------------------------------------------------------------------------}
  Function USCLN(a,b:integer):integer;{Ham tim USCLN cua 2 so}
  Begin
    If a<0 then a:=-a;
    If b<0 then b:=-b;
    While (a<>0) and (b<>0) do
      If a>b then a:=a mod b
      Else b:=b mod a;
    USCLN:=a+b;
  End;
  {--------------------------------------------------------------------------}
  Function NT(a:integer):boolean;{ham kiem tra so nguyen to}
  Var
    i:integer;
  Begin
    If a<0 then a:=-a;
    For i:=2 to round(sqrt(a)) do
      If a mod i=0 then
        Begin
          NT:=false;
          Exit;
        End;
    NT:=true;
  End;
  {--------------------------------------------------------------------------}
  Function TinhTongCS(a:integer):integer; {ham tinh tong cac chu so cua 1 so}
  Var
    d:integer;
  Begin
    D:=0;
    While a<>0 do
      Begin
        d:=d+a mod 10;
        a:=a div 10;
      End;
    TinhTongCS:=d;
  End;
  {--------------------------------------------------------------------------}
  Procedure XauDX(s:string);{Kiem tra xau co doi xung khong}
  Var
    I,n: integer;
    Kt: boolean;
  Begin
    N:=length(s);
    For i:=1 to (n div 2) do
      If s[i]<>s[n-i+1] then
        Begin
          Kt:=False;
          Break;
        End;
    If kt=False then
      Writeln('Xau khong doi xung.')
    Else
      Writeln('Xau doi xung.');
    Writeln;
  End;
  {--------------------------------------------------------------------------}
  Procedure KTKNcuaxau(s:string);
  Var
    i,n:integer;
    A:array[0..255] of boolean;
  Begin
    N:=0;
    Fillchar(a,sizeof(a),false);
    For i:=1 to length(s) do
    If a[ord(s[i])]=false then
      Begin
        Inc(n);
        A[ord(s[i])]:=true;
      End;
    If n=1 then n:=0;
    Write('Xau co so ky tu khac nhau:',n);
  End;
  {--------------------------------------------------------------------------}
  Function GT(a:integer):longint;
  Var
    i:integer;
    s:longint;
  Begin
    s:=1;
    For i:=1 to a do
      s:=s*a;
    GT:=s;
  End;
  {--------------------------------------------------------------------------}
  Function Luythua(a,n:integer):longint;
  Var
    i:integer;
    s:longint;
  Begin
    s:=1;
    For i:=1 to n do
      s:=s*a;
    Luythua:=s;
  End;
  {--------------------------------------------------------------------------}
END.