Go Back   Diễn đàn trường THPT Trần Phú - Đà Nẵng > Góc học tập - Học tập online - học trực tuyến > Các môn học THPT > Môn Tin học > Tin học lớp 11


Hướng dẫn chung về kỳ thi Đại học, Cao đẳng 2012

Hãy tìm kiếm trước khi bạn đặt câu hỏi trên diễn đàn nhé !
Hữu ích:         Phần mềm dạy và học | Kinh nghiệm học tập | Bài giảng trực tuyến
  Văn mẫu:               Văn mẫu lớp 10 | Văn mẫu lớp 11 | Văn mẫu lớp 12

Hãy sử dụng trình duyệt FireFox hoặc Google Chrome để lướt web nhanh và an toàn hơn .
> Download FireFox < - > Download Google Chrome <



Similar Threads
Ðề tài Người Gởi Chuyên mục Trả lời Bài mới gởi
V-Pascal 2.10 lập trình Pascal cho người Việt Mc.Neo Software & Crack 0 06-11-2010 05:50 PM
phần mềm Turbo Pascal Delta Phần mềm dạy và học 0 30-10-2010 02:30 PM
Sơ lược về Pascal Delta Tin học lớp 11 0 14-09-2010 11:07 PM
Pascal Study 1.0 - học pascal từ cơ bản đến nâng cao Assassin_C7 Phần mềm dạy và học 5 28-01-2010 04:48 PM
Mối liên hệ giữa tam giác pascal và 7 hằng đẳng thức ♥•»…ßi…ƒ€nT…«•██ Toán Học 2 17-01-2010 01:27 PM


Tags - Từ khóa tìm thêm:
bai tap pascal lop 11, cac dang bai tap turbo pascal, các dạng bài tập pascal, các dạng bài tập tin học 11 viét chương trình, các dạng bài tập turbo pascal, của, dạng, học, nhung dang bai tap ve chuong trinh pascal kiem tra hoc ki2 mon tin hoc11, pascal, phần, tập, thư viện các dạng bài tập pascal của tin học 11 - phần 4, tim kiem tai nang, tong hop cac dang bai tai sap xep-tinhoc11, trắc nghiệm tin học 11 pascal, viện, [pascal] các dạng bài tập sắp xếp
Gởi Ðề Tài Mới  Trả lời
 
Ðiều Chỉnh Xếp Bài
  #1  
Old 28-11-2010, 10:42 PM
KuteoDnC's Avatar
  User Profile
KuteoDnCAdmin KuteoDnC is offline
Administrator
   Họ & Tên: Ku tèo
  • Đang học lớp : * Đã ra trường .
  • Niên khóa : 2002 - 2005
 
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,318,535
Đã cảm ơn: 159 bài viết
Được cảm ơn 645 lần trong 184 bài
KuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to behold

Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng 
Total Awards: 8

Send a message via ICQ to KuteoDnC
Default Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1

Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1


1/Sắp Xếp Theo Tên:
Code:
Program Sap_Xep_Theo_Ten;
  TYPE
    ConTro = ^HoSo;
    HoSo = RECORD
                  HoLot : String[17];
  Ten   : String[7];
  Diem  : Real;
    End;
  VAR
                  a  : Array[1..50] Of HoSo;
                  Tam        : ConTro;
                  i,j,PhanTu : Integer;
  BEGIN
     PhanTu := 0;
     New(Tam);
     With Tam^ Do
     Repeat
        Write('-Nhap ho lot ( 0 de ket thu): ');
        Readln(HoLot);
        If HoLot <> '0' Then
                  Begin
                  Write('-Nhap ten  : ');
              Readln(Ten);
              Write('-Nhap diem : ');
              Readln(Diem);
              PhanTu := PhanTu + 1;
              a[PhanTu] := Tam^;
           End;
     Until HoLot = '0';
     For i := 1 To PhanTu - 1 Do
                  For j := PhanTu DownTo i+1 Do
                  If a[j].Ten[1] < a[j-1].Ten[1] Then
                  Begin
                  Tam^ := a[j];
                  a[j] := a[j-1];
                  a[j-1] := Tam^;
                  End;
     Writeln;
     Writeln('------------------------------------');
     Writeln('|       HO VA TEN          |  DIEM |');
     Writeln('|--------------------------|-------|');
                  For i := 1 To PhanTu Do
                     With a[i] Do
                     Writeln('|',HoLot:17,' ',Ten:7,' |',Diem:5:1,'  |');
     Writeln('------------------------------------');
     Readln
  END.
2/Sắp xếp điểm tăng:
Code:
Program Sap_Xep_Diem_Tang;
  TYPE
  ConTro = ^Lop;
  Lop = RECORD
        HoTen               : String[24];
        NamSinh            : Integer;
        DiemTb             : Real;
   End;
  VAR
     Hs         : Array[1..50] Of lop;
     i,j,n : Integer;
     Tam   : ConTro;
  Begin
     Writeln('SAP XEP DIEM TANG DAN);');
     Writeln('Giai thuat noi Buble');
     Writeln('--------------------');
     New(Tam);
     Writeln;
     Write('-So hoc sinh: ');
     Readln(n);
     For i := 1 To N Do
        With Hs[i] Do
           Begin
              Write('+Ho ten hoc sinh thu: ',i:2,' la: ');
              Readln(Hoten);
              Write('+Nam sinh: ');
              Readln(NamSinh);
              Write('+Diem trung binh: ');
              Readln(DiemTb);
           End;
     For i := 1 To N-1 Do
        For j := 1 To N-i Do
           If Hs[j].DiemTb > Hs[j+1].DiemTb Then
              Begin
                 Tam^ := Hs[j];
                 Hs[j] := Hs[j+1];
                 Hs[j+1] := Tam^;
              End;
     Writeln;
     Writeln('        DANH SACH SAP XEP');
     Writeln;
     For i := 1 To N Do
                  With Hs[i] Do
                  Writeln('-',HoTen:24,' :',Namsinh:4,' , ',DiemTb:5:2);
                  Readln
  End.
3/Hóa Đơn:
Code:
Program Hoa_Don;
  CONST
                  Max = 100;
  TYPE
    ConTro = ^HoaDon;
    HoaDon = RECORD
        NguoiMua : String[24];
        TenHang  : String[10];
        DonGia   : Real;
        SoLuong  : Integer;
     End;
  VAR
     a   : Array[1..Max] Of HoaDon;
     DsTenHang : Array[1..Max] Of String[10];
     Tam       : ConTro;
     Spt, SoTenHang, i, j : Integer;
     Tong                 : Real;
     KiemTra              : Boolean;
   
  BEGIN
     Writeln('HOA DON BAN HANG');
     Writeln('----------------');
     Writeln;
     Spt := 0;
     New(Tam);
     With Tam^ do
     Repeat
           Write('-Ten nguoi mua (go 0 de thoat): ');
           Readln(NguoiMua);
           If NguoiMua <> '0' Then
                  Begin
  Write('-Ten hang: ');
                  Readln(TenHang);
                  Write('-Don gia : ');
                  Readln(DonGia);
                  Write('-So luong: ');
                  Readln(SoLuong);
                  Spt := Spt + 1;
                  a[Spt] := Tam^;
                  End;
     Until NguoiMua = '0';
     SoTenHang := 0;
     For i := 1 To Spt Do
                  Begin
                  KiemTra :=False;
                  For j := 1 To SoTenHang Do
                  If DsTenHang[j] = a[i].TenHang Then
                  KiemTra := True;
                  If NOT KiemTra Then
                  Begin
                  SoTenHang :=SoTenHang + 1;
                  DsTenHang[SoTenHang]:=a[i].TenHang;
                  End;
                  End;
     Writeln;
     For i := 1 To SoTenHang Do
                  Begin
                  Tong := 0;
                  For j := 1 To Spt Do
                  With a[j] Do
                  If TenHang = DsTenHang[i] Then
                  Tong := Tong + (DonGia * Soluong);
              Writeln('  +Tong so tien mua: ',DsTenHang[i]:10,' = ',tong:10:2);
                  End;
     Readln
  END.
4/Thư viện sách:
Code:
Program Thu_Vien;
  Uses Crt;
  TYPE
      ConTro = ^ThuVien;
      ThuVien = RECORD
                  TenSach  : String[30];
                  TacGia   : String[24];
  Namxb    : Byte;
  NguoiMuon: String[24];
  Next     : ConTro;
     End;
  VAR
     First,Last,Newp       : ConTro;
     ds,dm : Integer;
     Ch : Char;
     HeapTop : ^Integer;
  BEGIN
     ClrScr;
     GotoXY(5,25);
     Write('Bam <Enter> de tiep tuc, bam <Esc> de thoat');
     Window(1,1,80,24);
     Writeln('QUAN LY THU VIEN');
     Writeln('----------------');
     Writeln;
     ds := 0;
     dm := 0;
     First := Nil;
     Mark(Heaptop);
                  Repeat
                  New(Newp);
                  With Newp^ Do
                  Begin
                     Write('-Ten sach : ');
                     Readln(TenSach);
                     If TenSach <> '' Then
                        Begin
                                  ds := ds + 1;
                                  Write('-Tac Gia: ');
                                  Readln(TacGia);
                                  Write('-Nam xuat ban : ');
                                  Readln(Namxb);
                                  Write('-Nguoi muon (Khong co ai muon thi bam <Enter>: ');
                                  Readln(NguoiMuon);
                                  If NguoiMuon <> '' Then
                                                  dm := dm + 1;
                        End;
                  End;
        If First = Nil Then
                  First := Newp
        Else
           Last^.Next := Newp;
           Last :=Newp;
           Last^.Next := Nil;
        Ch := ReadKey;
     Until Ch = #27;
     ClrScr;
     Writeln('QUAN LY THU VIEN');
     Writeln('----------------');
     While First <> Nil Do
        With First^ Do
           Begin
              Writeln('-Ten sach: ',TenSach);
              Writeln('-Tac gia : ',TacGia);
              Writeln('-Nam Xuat ban: ',Namxb);
              Writeln('-Nguoi muon : ',NguoiMuon);
              First := Next;
           End;
     Writeln;
     Writeln('+Tong so sach: ',Ds);
     Writeln('+So sach cho muon: ',Dm);
     Release(HeapTop);
     Writeln;
     Write('  Bam <Esc> de thoat');
     Readln
  END.
5/Hồ Sơ Nhân Viên:
Code:
Program Ho_So_Nhan_Vien;
  Uses Crt;
  TYPE
     ConTro = ^HoSo;
     HoSo = RECORD
     HoTen : String[24];
     Tuoi  : Integer;
     Luong : LongInt;
     Next  : ConTro;
     End;
  VAR
      First, Last, Newp : ConTro;
      Hoten1, Hoten2                         : String[24];
       i,TuoiMax,TuoiMin                  : Integer;
      LuongMax, LuongMin,LuongTb : LongInt;
      Ch                         : Char;
      HeapTop  :^Integer;
  Begin
     ClrScr;
     Writeln('HO SO NHAN VIEN');
     Writeln('---------------');
     Writeln;
     GoToXY(5,25);
     Write('Bam <Enter> de tiep tuc, bam <Esc> de thoat ');
     Window(1,2,80,25);
     First :=Nil;
     Mark(HeapTop);
     i := 0;
     Repeat
        i := i + 1;
        New(Newp);
        With Newp^ Do
            Begin
                  Write('-Ho ten nhan vien thu: ',i:2,' la= ');
                  Readln(HoTen);
                  Write('-Tuoi      = ');
                  Readln(Tuoi);
                  Write('-Bac luong = ');
                  Readln(Luong);
                  TuoiMax  := Tuoi;
                  TuoiMin  := Tuoi;
                  LuongMax := Luong;
                  LuongMin := Luong;
                  HoTen1   := HoTen;
                  HoTen2   := HoTen;
            End;
           If First = Nil Then
              First := Newp
           Else
              Last^.Next := Newp;
              Last := Newp;
              Last^.Next := Nil;
              Ch := ReadKey;
     Until Ch = #27;
     Writeln;
     While First <> Nil Do
          With First^ Do
                  Begin
                     If Tuoi > TuoiMax Then
                        TuoiMax := Tuoi
                     Else
                     If Tuoi < TuoiMin Then
                        TuoiMin := Tuoi;
                     If Luong > LuongMax Then
                        Begin
                           LuongMax := Luong;
                           HoTen1 := HoTen;
                        End
                     Else
                        If Luong < LuongMin Then
                           Begin
                                  LuongMin := Luong;
                                  HoTen2 := HoTen;
                           End;
                     First := Next;
                  End;
     Writeln;
     Writeln('Nhan vien co tuoi lon nhat la: ',TuoiMax);
     Writeln('Nhan vien co tuoi nho nhat la:',TuoiMin);
     Writeln('Nhan vien: ',HoTen1,' ,co bac luong lon nhat: ',LuongMax:10);
     Writeln('+Nhan vien: ',HoTen2,' ,co bac luong nho nhat: ',LuongMin:10);
     Release(HeapTop);
     Writeln;
     Write(' Bam <Enter> de ket thuc ');
     Readln
  End.
6/Tính điểm xếp hạng:
Code:
Program Tinh_Diem_Xep_Hang;
  TYPE
     ConTro = ^Lop;
     Lop = RECORD
        HoTen : String[24];
        NamSinh                            : Integer;
        Tb1,Tb2,Tb       : Real;
     End;
  VAR
     Hs : Array[1..50] Of lop;
     i,j,n,Hang: Integer;
     Tam      : ConTro;
  Begin
     Writeln('TINH DIEM VA XEP HANG);');
     Writeln('Giai thuat noi Buble');
     Writeln('--------------------');
     Writeln;
     New(Tam);
     Write('-So hoc sinh: ');
     Readln(n);
     For i := 1 To N Do
         With Hs[i] Do
                  Begin
              Write(' +Ho ten hoc sinh thu: ',i:2,' la: ');
              Readln(Hoten);
              Write(' +Nam sinh: ');
              Readln(NamSinh);
              Write(' +Diem trung binh hoc ky 1: ');
              Readln(Tb1);
              Write(' +Diem trung binh hoc ky 2: ');
              Readln(Tb2);
              Tb :=(Tb1 + Tb2)/2;
              Writeln;
              End;
     For i := 1 To N-1 Do
        For j := 1 To N-i Do
           If Hs[j].Tb < Hs[j+1].Tb Then
                  Begin
                 Tam^ := Hs[j];
                 Hs[j] := Hs[j+1];
                 Hs[j+1] := Tam^;
              End;
     Writeln;
     Writeln('        DANH SACH XEP HANG');
     Writeln;
     Hang := 1;
     For i := 1 To N Do
                  Begin
                  If (i > 1) And (Hs[i].Tb <> Hs[i-1].Tb) Then
                  Hang := i;
              Writeln('      .Hoc sinh : ',Hs[i].HoTen);
              Writeln('      .Nam sinh : ',Hs[i].NamSinh);
              Writeln('      .Diem trung binh ca nam : ',Hs[i].Tb:5:2);
              Writeln('      .Xep hang ca nam        : ',Hang);
  End;
                  Readln
  End.
7/Hoán vị chuỗi:
Code:
 Program Hoan_Vi_Chuoi;
  Uses Crt;
  VAR
     Chuoi1,Chuoi2,Tam :^String;
  Begin
     ClrScr;
     Writeln('HOAN VI 2 CON TRO THAY CHO HOAN VI NOI DUNG');
     Writeln('-------------------------------------------');
     Writeln;
     New(Chuoi1);
     New(Chuoi2);
     Chuoi1^ := 'Giao trinh Turbo Pascal 7.0';
     Chuoi2^ := 'Giao trinh FoxPro 2.6';
     Writeln;
     Writeln('NOI DUNG BAN DAU CUA 2 CHUOI');
     Writeln('----------------------------');
     Writeln;
     Writeln('-Chuoi thu nhat: ',Chuoi1^);
     Writeln('-Chuoi thu hai : ',Chuoi2^);
     Writeln;
     Writeln('NOI DUNG SAU KHI HOAN VI 2 CON TRO');
     Writeln('----------------------------------');
     Writeln;
     Tam := Chuoi1;
     Chuoi1 := Chuoi2;
     Chuoi2 := Tam;
     Writeln('-Chuoi thu nhat: ',Chuoi1^);
     Writeln('-Chuoi thu hai : ',Chuoi2^);
     Dispose(Chuoi1);
     Dispose(Chuoi2);
     Writeln;
     Write('     Bam <Enter> . . . ');
     Readln;
  End.
8/Tách danh sách chẳn lẻ:
Code:
 Program Tach_Danh_Sach_Chan_Le;
  Uses Crt;
  TYPE
                  Mang = Array[1..100] Of Integer;
  VAR
                  i,j,k,n : Integer;
  a,b,c : Mang;
  Begin
     ClrScr;
     Writeln('                     NHAP DANH SACH');
     Writeln('                     --------------');
     Write('-So phan tu: ');
     Readln(n);
     For i := 1 To n Do
        Begin
           Write('-Phan tu thu: ',i:2,' = ');
           Readln(a[i]);
        End;
     Writeln;
     Writeln('TACH THANH 2 DANH SACH');
     Writeln('----------------------');
     Writeln;
     j := 1;
     k := 1;
     For i := 1 To n Do
        If  Odd(a[i]) Then
           Begin
              b[j] := a[i];
              j := j + 1;
           End
        Else
           Begin
              c[k] :=a[i];
              k := k + 1;
           End;
     Writeln;
     Writeln('       -Danh sach thu nhat ( so le ) ');
     Writeln;
     For i := 1 To j-1 Do Write(b[i],' ');
     Writeln;
     Writeln;
     Writeln('       -Danh sach thu hai ( so chan ) ');
     Writeln;
     For i := 1 To k-1 Do Write(c[i],' ');
     Writeln;
     Write('          Bam <Enter> . . . ');
     Readln
  End.
9/Đảo ngược danh sách:
Code:
 Program Dao_Nguoc_Danh_Sach;
  Uses Crt;
  TYPE
     ConTro = ^Nut;
     Nut = RECORD
         So : Integer;
         Next : ConTro;
      End;
  VAR
     Nut1,Tam1,Tam2 : ConTro;
     Ch       : Char;
  BEGIN
     ClrScr;
     Writeln('                DAO NGUOC DANH SACH');
     Writeln('                -------------------');
     Nut1 := Nil;
     Repeat
        New(Tam1);
        Write('-Nhap so: ');
        Readln(Tam1^.So);
        Tam1^.Next := Nut1;
        Nut1 := Tam1;
        Write('               Nhap nua khong ? (c/k) ');
        Readln(Ch);
     Until UpCase(Ch)= 'K';
     Tam1 := Nut1;
     Nut1 := Nil;
     Repeat
        Tam2 := Tam1^.Next;
        Tam1^.Next := Nut1;
        Nut1 := Tam1;
        Tam1 := Tam2;
     Until Tam1 = Nil;
     Writeln('Sau khi dao: ');
     Tam1 := Nut1;
     While Tam1 <> Nil Do
         Begin
           Write(Tam1^.So:6);
           Tam1 := Tam1^.Next;
        End;
     Writeln;
     Write('     Bam <Enter> . . . ');
     Readln
  END.
10/Ghép Chuỗi:
Code:
 Program Ghep_Chuoi;
  Uses Crt;
  TYPE
    ConTro = ^Nut;
    Nut = RECORD
        Kt   : Char;
        Next : ConTro;
    End;
  VAR
     Dau1,Cuoi1 : ConTro;
     Dau2,Cuoi2 : ConTro;
     Tam        : ConTro;
     Ch         : Char;
     i          : Integer;
  BEGIN
     ClrScr;
     Writeln('CHUOI THU NHAT');
     Writeln('--------------');
     Writeln;
     i := 0;
     Repeat
        i := i + 1;
        New(Tam);
        Write('-Ky tu thu: ',i:2,' : ');
        Readln(Tam^.Kt);
        If i = 1 Then
        Begin
              Dau1 := Tam;
              Cuoi1 := Tam;
        End
        Else
        Begin
              Cuoi1^.Next := Tam;
              Cuoi1 := Tam;
        End;
        Write('Nhap nua khong ? (c/k) ');
        Readln(Ch);
     Until UpCase(Ch) = 'K';
     ClrScr;
     Writeln('CHUOI THU HAI');
     Writeln('--------------');
     Writeln;
     i := 0;
     Repeat
        i := i + 1;
        New(Tam);
        Write('-Ky tu thu: ',i:2,' : ');
        Readln(Tam^.Kt);
        If i = 1 Then
           Begin
              Dau2  := Tam;
              Cuoi2 := Tam;
           End
        Else
           Begin
              Cuoi2^.Next := Tam;
              Cuoi2 := Tam;
           End;
        Write('Nhap nua khong ? (c/k) ');
        Readln(Ch);
     Until UpCase(Ch) = 'K';
     Cuoi1^.Next := Dau2;
     Cuoi2^.Next :=Nil;
     Writeln;
     Writeln(' KET QUA');
     Writeln('---------');
     Tam := Dau1;
     While Tam <> Nil Do
         Begin
           Write(Tam^.Kt);
           Tam := Tam^.Next;
         End;
     Writeln;
     Write('     Bam <Enter> . . . ');
     Readln
  END.
11/Cây nhị phân (hay):
Code:
 Program Cay_Nhi_Phan;
  Uses Crt;
  TYPE
     Str = String[24];
     ConTro = ^BanGhi;
     BanGhi = RECORD
        HoTen : Str;
        Luong : Real;
        Trai,Phai : ConTro;
        End;
  VAR
     Goc       : ConTro;
     Nv        : BanGhi;
     Ketthuc  : Boolean;
     Ch         : Char;
  {--------------------------------}
  Procedure Chen(Var Goc : ConTro; Nv : BanGhi);
     Var
                  P,P1 : ConTro;
     Begin
          If goc = Nil Then
              Begin
                  New(Goc);
                  With Goc^ Do
                     Begin
                                  HoTen := NV.HoTen;
                    Luong := NV.Luong;
                                  Trai  := Nil;
                    Phai  := Nil;
                       End;
              End
          Else
              Begin
                  P := Goc;
                  P1 := Nil;
                  While P <> Nil Do
                    Begin
                      P1 := P;
                        If Nv.HoTen <= P^.HoTen Then
                                  P := P^.Trai
                        Else
                                  P := P^.Phai;
                      End;
              New(P);
              With P^ Do
                  Begin
                  HoTen := NV.HoTen;
                    Luong := NV.Luong;
                    Trai := Nil;
                    Phai := Nil;
                 End;
              If NV.HoTen <=P1^.HoTen Then
                  P1^.Trai := P
              Else
                  P1^.Phai := P;
           End;
     End;
  {--------------------------------}
  Procedure Xoa(Var Goc : ConTro; Nv : BanGhi);
  Var
     P,P1,Q,Q1 : ConTro;
     Nhanh :(NhanhTrai,NhanhPhai);
     Begin
        If Goc = Nil Then Writeln('Cay rong')
        Else
           Begin
              P := Goc;
              P1 := Nil;
              While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
                  Begin
                  P1 := P;
                    If Nv.HoTen < P^.HoTen Then
                                  Begin
                                  P := P^.Trai;
                          Nhanh := NhanhTrai;
                       End
                    Else
                                  Begin
                                  P := P^.Phai;
                          Nhanh := NhanhPhai;
                       End;
                 End;
              If P = Nil Then
                  Writeln('Khong tim thay')
              Else
                  Begin
                  If (P^.Trai = Nil) Then
                                  Q := P^.Phai
                    Else
                                  Begin
                                  Q := P^.Trai;
                          Q1 := Nil;
                          While Q^.Phai <> Nil Do
                                  Begin
                                  Q1 := Q;
                                Q := Q^.Phai;
                             End;
                          If Q1  <> Nil Then
                                  Begin
                                  Q1^.Phai := Q^.Trai;
                                Q^.Trai := P^.Trai;
                             End;
                          If P1 = Nil Then
                                  Goc := Q
                          Else
                                  Begin
                                  If Nhanh = NhanhTrai Then
                                  P1^.Trai := Q
                                Else
                                  P1^.Phai := Q;
                             End;
                          Dispose(P);
                       End;
                 End;
           End;
     End;
  {--------------------------------}
  Procedure Tim(Goc : ConTro; Nv : BanGhi);
  Var
                  P : ConTro;
  Begin
  P := Goc;
  While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
  If NV.HoTen < P^.HoTen Then
     P := P^.Trai
  Else
     P := P^.Phai;
  If P = Nil Then        Writeln('Khong tim thay')
        Else
                  Begin
                  Writeln('Tim thay');
              Writeln(P^.HoTen,' ', P^.Luong:8:1);
           End;
     End;
  {--------------------------------}
  Procedure LNRLietKe(Goc : ConTro);
     Begin
                  If Goc =  Nil Then
                  Begin
                  Writeln('Cay rong, chua co du lieu');
           End
        Else
                  Begin
                  If Goc^.Trai <> Nil Then
                  LNRLietKe(Goc^.Trai);
              Writeln(Goc^.HoTen,', ',Goc^.Luong:8:1);
              If Goc^.Phai <> Nil Then
                 LNRLietKe(Goc^.Phai);
           End;
     End;
  {--------------------------------}
  BEGIN
  Repeat
                  ClrScr;
                  Writeln;
                  Writeln('CAC CHUC NANG CAY NHI PHAN');
                  Writeln('--------------------------');
                  Writeln;
                  Writeln('1-Khoi tao cay');
                  Writeln('2-Noi them vao cay');
                  Writeln('3-Xoa khoi cay');
                  Writeln('4-Tim kiem tren cay');
                  Writeln('5-Liet ke danh sach');
                  Writeln('6-Ket thuc chuong trinh');
        Writeln;
                  Write('Chon cac chuc nang tu 1 den 6: ');
                  Readln(Ch);
                  Case Ch Of
                  '1'             : Begin
                                  ClrScr;
                                                                                     Writeln('1-KHOI TAO CAY');
                       Writeln('Cay co thu tu LNR');
                       Writeln('-----------------');
                       Writeln;
                     Goc := Nil;
                     KetThuc := False;
                    Repeat
                       With Nv Do
                          Begin
                            Write('-Ho ten hoac <Enter> de ngung: ');
                             Readln(HoTen);
                             If HoTen <> '' Then
                                  Begin
                                  Write('-Bac luong : ');
                                                  Readln(Luong);
                                                  Chen(Goc,Nv);
                                  End
                                  Else
                                  KetThuc := True;
                                  End;
                    Until ketThuc;
                                  End;
                  '2'             : Begin
                                  ClrScr;
                                  Writeln;
                                  Writeln('2-NOI VAO CAY THEO THU TU');
                       Writeln('-------------------------');
                       Writeln;
                     KetThuc := False;
                       Repeat
                       With Nv Do
                          Begin
                          Write('-Ho ten hoac <Enter> de ngung: ');
                          Readln(HoTen);
                          If HoTen <> '' Then
                          Begin
                                  Write('-Bac luong : ');
                                                  Readln(Luong);
                                                  Chen(Goc,Nv);
                                  End
                                  Else
                                                  KetThuc := True;
                                  End;
                                  Until ketThuc;
                                                                  End;
           '3'    :  Begin
                  ClrScr;
                    Writeln;
                  Writeln('3.XOA KHOI CAY');
                    Writeln('--------------');
                    Writeln;
                    KetThuc := False;
                    Repeat
                    With Nv Do
                    Begin
                    Write('Ho ten can xoa, hoac <Enter> de ngung: ');
                    Readln(HoTen);
                    If HoTen <> '' Then
                    Xoa(Goc,NV)
                             Else
                                  KetThuc := True;
                    End;
                    Until KetThuc;
                  End;
           '4'    :               Begin
                                                                  ClrScr;
                                                                  Writeln('4-TIM KIEM TREN CAY');
                       Writeln('-------------------');
                       Writeln;
                       ketThuc := False;
                       Repeat
                                  With Nv Do
                                  Begin
                                  Write('Ho ten can tim, hoac <Enter> de ngung: ');
                                Readln(HoTen);
                                If HoTen <> '' Then
                                  Tim(Goc,NV)
                                Else
                                  KetThuc := True;
                             End;
                       Until KetThuc;
                                                  End;
           '5'    :               Begin
                                                                  ClrScr;
                                                                  Writeln('5-LIET KE NOI DUNG CAY');
                       Writeln('Hien thi theo thu tu ABC...');
                       Writeln('---------------------------');
                       Writeln;
                       LNRLietKe(Goc);
                       Writeln;
                       Write('Xem xong bam <Enter> . . . ');
                       Readln
                                                                                                  End;
           '6'    :                               Begin
                                                                  Writeln('7- KET THUC CHUONG TRINH');
                       Writeln;
                                                                                                  End;
        End;
     Until Ch = '6'
  END.
12/Đổi thập phân ra nhị phân:
Code:
Program Doi_thap_phan_ra_nhi_phan;
Var
    He10,N,Y:Word;
   He2,Tam:String;
Begin
    Writeln('DOI SO TU HE THAP PHAN SANG HE NHI PHAN');
   Writeln('         -----------------');
   Writeln;
   Write('-Nhap so nguyen he thap phan: ');
   Readln(He10);
   N:=He10;
   He2:=' ';
   Repeat
       Y:=He10 Mod 2;
      Str(Y, Tam);
      He2:=Tam + He2;
      He10:= He10 Div 2;
   Until He10 = 0;
   Writeln;
   Writeln('+So he 10 la     : ',N);
   Writeln('+Doi sang he 2 la: ',He2);
   Writeln;
   Writeln('      Bam phim <Enter> de ket thuc');
   Readln
End.
13/Mảng kí tự:
Code:
Program Mang_Ky_Tu;
    Var
       a:Array[Char] Of Integer;
      Ch:Char;
Begin
    Writeln('IN MA ASCII CUA CAC KY TU');
   Writeln('------------------------');
   For Ch:='A' To 'Z' Do
       Begin
          a[Ch]:=Ord(Ch);
         Writeln('-Ky tu: ',Ch,' ma ASCII = ',a[ch]);
      End;
   Writeln;
   Writeln('Bam phim <Enter> de ket thuc');
   Readln
End.
14/Trung bình cộng:
Code:
Program Tb_cong;
    Var
       i,so,dem,tong:Integer;
      Tb:Real;
      A:Array[1..100] Of Integer;
Begin
    Writeln('TINH TRUNG BINH CONG CAC SO NGUYEN');
   Writeln('----------------------------------');
   Writeln;
   dem:=0;
   Tong:=0;
   Write('-Nhap so nguyn: ');
   Readln(so);
   While so > 0 Do
       Begin
          dem:=dem+1;
         a[dem]:=so;
         Write('-Nhap so nguyen (-1 de ngung): ');
         Readln(so);
      End;
   For i:=1 to dem Do
       Tong:=Tong+A[i];
   Tb:=Tong/dem;
   Writeln;
   Writeln('+Trung binh cong cua: ',dem:2,' so vua nhap = ',Tb:8:2);
   Writeln;
   Writeln('      Bam phim <Enter> de ket thuc ');
   Readln
End.
15/Chèn một số vào hàng:
Code:
Program Chen;
    Var
       i,spt:Integer;
      so,vitri:Integer;
      a:Array[1..100] Of Integer;
Begin
    Writeln('CHEN MOT SO VAO MANG');
    Writeln('--------------------');
   Write('-Co bao nhieu phan tu: ');
    Readln(spt);
   For i:=1 To spt Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   Writeln;
   Writeln('MANG TRUOC KHI CHEN');
   For i:=1 To spt Do
   Write(a[i]:6);
   Writeln;
   Write('-Can che so: ');
   Readln(so);
   Write('-Vao vi tri: ');
   Readln(vitri);
   For i:=spt+1 Downto Vitri+1 Do
       a[i]:=a[i-1];
   a[vitri]:=so;
   spt:=spt+ 1;
   Writeln;
   Writeln('MANG SAU KHI CHEN');
   For i:=1 To spt Do
       Write(a[i]:6);
   Readln
End.
16/Xóa phần tử trong mảng:
Code:
Program Xoa_Pt;
    Var
       i,spt,vitri:Integer;
      a:Array[1..100] Of Integer;
Begin
    Writeln('XOA PHAN TU TRONG MANG');
   Writeln('----------------------');
   Writeln;
   Write('-Mang co bo nhieu phan tu: ');
   Readln(spt);
   For i:=1 To spt Do
       Begin
          Write('-Phan tu A[',i:2,']= ');
         Readln(a[i]);
      End;
   Writeln;
   Writeln('             MANG TRUOC KHI XOA');
   Writeln('             -----------------');
   Writeln;
   For i:=1 To spt Do
       Write(a[i]:6);
   Writeln;
   Writeln;
   Write('-Vi tri muon xoa: ');
   Readln(vitri);
   For i:=vitri to spt - 1 Do
        a[i]:=a[i+1];
    spt:=spt - 1;
    Writeln;
    Writeln('             MANG SAU KHI XOA');
    Writeln('             ----------------');
    Writeln;
    For i:= 1 to spt Do
        Write(a[i]:6);
    Writeln;
   Writeln;
    Writeln('   Bam phim <Enter> de ket thuc ');
    Readln
End.
17/Thống kê các số lẻ:
Code:
Program So_le;
    Var
       a:Array[1..255] Of Integer;
      i,spt,sole:Byte;
Begin
    Writeln('THONG KE CAC SO LE');
   Writeln('------------------');
   Write('-Can nhap bao nhieu so: ');
   Readln(spt);
   For i:=1 To spt Do
       Begin
          Write('-Phan tu A[',i:2,']= ');
         Readln(a[i]);
      End;
   sole:=0;
   For i:=1 To spt Do
   If Odd(A[i]) Then
       Inc(sole);
   Writeln;
   Writeln('-Tong so cac so da nhap: ',spt);
   For i:= 1 To spt Do
       Write(a[i]:6);
   Writeln;
   Writeln('-Tong so cac so le la: ',sole);
   Writeln;
   Writeln('     Bam phim <Enter> de ket thuc ');
    Readln
End.
18/Tính giá trị của đa thức bậc N:
Code:
Program Da_thuc;
   Var
        a:Array[1..255] Of Real;
      i,n:Byte;
      x,p:Real;
Begin
    Writeln('TINH GIA TRI CUA DA THUC BAC N');
   Writeln('------------------------------');
   Writeln;
   Write('-Cho biet bac cua da thuc: ');
   Readln(n);
   For i:= N Downto 0 Do
       Begin
          Write('-Cho biet he so A[',i:2,']= ');
         Readln(a[i]);
      End;
   Writeln;
   Write('-Cho biet X= ');
   Readln(x);
   P:=a[n];
   For i:= N Downto 1 Do
       P:=x * p + a[i-1];
   Writeln;
   Writeln('+Tri cua da thuc P(x)= ',P:0:6);
   Writeln;
   Writeln('    Bam phim <Enter> de ket thuc ');
   Readln
End.
19/Đổi số nguyên kiểu Word ra hệ thập lục:
Code:
Program Doi_he_16;
    Const
       KyTuHe16:array[0..$F] Of Char ='0123456789ABCDEF';
   Var
       SoWord:Word;
      SoHex:String[4];
Begin
    Writeln('DOI SO NGUYEN KIEU WORD RA HE THAP LUC');
   Writeln('--------------------------------------');
   Writeln;
   Write('-Nhap so kieu Word: ');
   Readln(SoWord);
   SoHex[0]:=#4;
   SoHex[1]:= KyTuHe16[Hi(SoWord) SHR 4];
   SoHex[2]:= KyTuHe16[Hi(SoWord) AND $F];
   SoHex[3]:= KyTuHe16[Lo(SoWord) SHR 4];
   SoHex[4]:= KyTuHe16[Lo(SoWord) AND $F];
   Writeln('+So nguyen kieu Word  = ',soWord);
   Writeln('+Doi ra so he thap luc = $',SoHex);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
End.
20/Đổi số nguyên kiểu Word ra hệ nhị phân:
Code:
Program Doi_he_2;
    Const
       KyTuHe2:array[0..1] Of Char ='01';
   Var
       SoWord:Word;
      SoBinary:String[16];
      i:byte;
Begin
    Writeln('DOI SO NGUYEN KIEU WORD RA HE NHI PHAN');
   Writeln('--------------------------------------');
   Writeln;
   Write('-Nhap so kieu Word: ');
   Readln(SoWord);
   SoBinary[0]:=#16;
   For i:=15 DownTo 0 Do
       If (SoWord AND (1 SHL i)) = (1 SHL i) Then
          SoBinary[16-i]:= KyTuHe2[1]
      Else
         SoBinary[16-i]:= KyTuHe2[0];
   Writeln('+So nguyen kieu Word  = ',soWord);
   Writeln('+Doi ra so he nhi phan= B ',SoBinary);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
End.


21/Cộng 2 số nguyên:
Code:
Program Cong_so;
    Uses Crt;
   Const
       spt=301;
   Type
       mang=Array[1..spt] Of Integer;
   Var
       a,b,kq:Mang;
      k,na,nb,nmax,tam:Integer;
Begin
    ClrScr;
   Writeln('CONG 2 SO NGUYEN');
   Writeln('----------------');
   Writeln;
   Writeln('+SO THU NHAT (-1 de ket thuc) ');
   na:=0;
   Repeat
       na:=na+1;
      Write('-Chu so thu: ',na,' = ');
      Readln(a[na]);
   Until a[na]=-1;
   na:=na-1;
   For k:=0 To na-1 Do
       a[spt-k]:=a[na-k];
   For k:=1 to spt-na Do
       a[k]:=0;
   ClrScr;
   Writeln('+SO THU HAI (-1 de ket thuc) ');
   nb:=0;
   Repeat
       nb:=nb+1;
      Write('-Chu so thu: ',nb,' = ');
      Readln(b[nb]);
   Until b[nb]=-1;
   nb:=nb-1;
   For k:=0 To nb-1 Do
       b[spt-k]:=b[nb-k];
   For k:=1 to spt-nb Do
       b[k]:=0;
   If na>nb Then
       nmax:=na
   Else
       nmax:=nb;
   tam:=0;
   For k:=spt Downto spt-nmax Do
   Begin
       kq[k]:=(a[k]+b[k]+tam) Mod 10;
      tam:=(a[k]+b[k]+tam) Div 10;
   End;
   ClrScr;
   Writeln('KET QUA CONG 2 SO NGUYEN');
   Writeln('------------------------');
   Write('*So thu nhat: ');
   For k:=spt-na+1 To spt Do
       Write(a[k],' ');
   Writeln;
   Write('*So thu hai : ');
   For k:=spt-nb+1 To spt Do
       Write(b[k],' ');
   Writeln;
   Write('*Tong = ');
   For k:=Spt-nmax To spt Do
      Write(kq[k],' ');
    Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
End.
22/Nhân 2 số nguyên:
Code:
Program Nhan_so;
    Uses Crt;
   Const
       spt=900;
   Type
       mang=Array[1..spt] Of Integer;
   Var
       a,b,c,kq:Mang;
      i,j,k,na,nb,tam:Integer;
   {---------------------------}
   Procedure Nhap(Var a:mang; Var na:Integer);
       Var
          k:Integer;
   Begin
       na:=0;
      Repeat
          na:=na+1;
          Write('-Chu so thu: ',na,' = ');
         Readln(a[na]);
      Until a[na]=-1;
      na:=na-1;
       For k:=0 To na-1 Do
           a[spt-k]:=a[na-k];
       For k:=1 to spt-na Do
           a[k]:=0;
   End;
   {---------------------------}
   Procedure Cong(a:mang; Var b:mang);
       Var
          tam1,tam2,k:Integer;
   Begin
       tam1:=0;
      For k:= spt Downto 1 Do
          Begin
               tam2:=(a[k]+b[k]+tam1) Div 10;
              b[k]:=(a[k]+b[k]+tam1) Mod 10;
            tam1:=tam2;
           End;
   End;
   {---------------------------}
BEGIN
    ClrScr;
   Writeln('NHAN 2 SO NGUYEN');
   Writeln('----------------');
   Writeln;
   Writeln('+SO THU NHAT (-1 de ket thuc) ');
   Nhap(a,na);
   ClrScr;
   Writeln('+SO THU HAI (-1 de ket thuc) ');
   Nhap(b,nb);
   For k:=1 To spt Do
       kq[k]:=0;
   For j:=spt Downto spt-nb Do
   Begin
       For k:=1 to spt Do
          c[k]:=0;
         tam:=0;
         For i:=spt Downto spt-na Do
         Begin
             c[j+i-spt]:=(b[j]*a[i]+tam) Mod 10;
            tam:=(b[j]*a[i]+tam) Div 10;
         End;
      Cong(c,kq)
   End;
   ClrScr;
   Writeln('KET QUA NHAN 2 SO NGUYEN');
   Writeln('-----------------------');
   Writeln;
   Write('*So thu nhat: ');
   For k:=spt-na+1 To spt Do
       Write(a[k],' ');
   Writeln;
   Write('*So thu hai : ');
   For k:=spt-nb+1 To spt Do
       Write(b[k],' ');
   Writeln;
   Write('*Tich = ');
   For k:=Spt-(na+nb)+1 To spt Do
      Write(kq[k],' ');
    Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
END.
23/Ma trận vuông 10x10 phần tử:
Code:
Program Ma_tran_vuong;
    Uses Crt;
    Var
       a:Array[1..10, 1..10] Of Integer;
      i,j:Integer;
Begin
    Writeln('MA TRAN VUONG 10 x 10 PHAN TU');
   Writeln('-----------------------------');
    ClrScr;
   Window(10,5,60,25);
   For i:= 1 To 10 Do
       Begin
          For j:=1 To 10 Do
             Begin
                If i=j Then
                   a[i,j]:=i
               Else
                   a[i,j]:=0;
               Write(a[i,j]:5);
            End;
         Writeln(#10)
      End;
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
End.
24/Tìm một số trong mảng:
Code:
Program Tim_so;
    Var
       a:Array[1..4,1..6] Of Integer;
      i,j,so,solan:Integer;
Begin
    Writeln('TIM MOT SO TRONG MANG');
   Writeln('---------------------');
   Writeln;
   For i:=1 To 4 Do
       For j:=1 to 6 Do
          Begin
             Write('-Phan tu A[',i,',',j,']= ');
            Readln(a[i,j]);
         End;
   Writeln;
   Write('-So muon tim: ');
   Readln(so);
   solan:=0;
   For i:=1 To 4 Do
       For j:=1 To 6 Do
          If so=a[i,j] Then
              Begin
                 solan:=solan+1;
               Writeln('+Lan: ',solan,' tai hang: ',i,' cot: ',j);
             End;
   Writeln;
   Writeln('+Tong so lan xuat hien la: ',solan);
   For i:=1 To 4 Do
       Begin
           For j:=1 To 6 Do
             Write(a[i,j]:8);
            Writeln;
      End;
   Readln
End.
25/Giải hệ phuơng trình tuyến tính 2 ẩn:
Code:
Program Giai_he_PT_tuyen_tinh;
    Var
       A:Array[1..2, 1..2] Of Real;
      C:Array[1..2] Of Real;
      x,y,dt,dtx,dty:Real;
      i,j:Integer;
Begin
    Writeln('GIAI HE PT TUYEN TINH 2 AN');
   Writeln('--------------------------');
   Writeln;
   Writeln('-Nhap cac he so A cua he phuong trinh: ');
   For i:=1 to 2 Do
       For j:=1 To 2 Do
          Begin
             Write('+Phan tu A[',i,',',j,']= ');
            Readln(a[i,j]);
         End;
   Writeln;
   Writeln('-Nhap cac he so C cua he phuong trinh: ');
   For i:=1 to 2 Do
         Begin
            Write('+Phan tu C[',i,']= ');
         Readln(c[i]);
       End;
   Writeln;
   {Giai he phuong trinh}
   Dt:= a[1,1]*a[2,2]-a[1,2]*a[2,1]; {Dt: Dinh thuc}
   Dtx:=c[1]*a[2,2]-c[2]*a[2,1];
   Dty:=a[1,1]*c[2]-a[1,2]*c[1];
   If Dt <> 0 Then
       Begin
           x:=Dtx / Dt;
          y:=Dty / Dt;
         Writeln('X= ',x);
         Writeln('Y= ',y);
      End
   Else
       Begin
          If (Dtx=0) And (Dty=0) Then
             Writeln(#7,#7,#7,' Co vo so nghiem')
         Else
             Writeln(#7,#7,#7,'Vo nghiem');
      End;
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
26/Nhân ma trận:
Code:
Program Nhan_ma_tran;
    Const
       Max=10;
   Type
       Matran=Array[1..Max,1..Max] Of Integer;
   Var
       A,B,C:Matran;
      hang1,cot1,i,j,m,n,q:Integer;
Begin
    Writeln('NHAN MA TRAN');
   Writeln('------------');
   Writeln;
   Writeln('MA TRAN A:');
   Write('-So hang = ');
   Readln(m);
   Write('-So cot  = ');
   Readln(n);
   For i:=1 To m Do
       For j:=1 To n Do
          Begin
             Write('+Phan tu A[',i,',',j,' = ');
            Readln(a[i,j]);
         End;
   Cot1:=m;
   Hang1:=m;
   Writeln;
   Writeln('MA TRAN B:');
   Write('-So hang = ');
   Readln(m);
   Write('-So cot  = ');
   Readln(n);
   For i:=1 To m Do
       For j:=1 To n Do
          Begin
             Write('+Phan tu B[',i,',',j,' = ');
            Readln(b[i,j]);
         End;
   For i:=1 To Hang1 Do
       For j:=1 To n Do
          Begin
             c[i,j]:=0;
            For q:=1 To Cot1 Do
                c[i,j]:= c[i,j] + a[i,q] * b[q,j];
         End;
   For i:=1 to hang1 Do
       Begin
          For j:= 1 To n Do
             Write((c[i,j]):8);
         Writeln;
      End;
   Readln
End.
27/Tìm và xóa các kí tự trùng nhau trong chuổi:
Code:
Program Tim_Xoa;
    Var
       St,St1:String;
      Ch:Char;
      i,l,l1:Byte;

Begin
    Writeln('TIM VA XOA CAC KY TU TRUNG NHAU TRONG CHUOI');
   Writeln('         -----------------');
   Writeln;
   Write('-Nhap mot chuoi: ');
   Readln(St);
   St1:=St;
   i:=1;
   l:=Length(St);
   While i <= l Do
       Begin
          i:=i+1;
         If St[i]=St[i - 1] Then
             Begin
                Writeln('+Ky tu thu: ',i:2,' la: ',St[i],' bi trung lap');
               Write('Ban co muon xoa ky tu nay khong (c/k)');
               Readln(Ch);
               If UpCase(Ch)='C' Then
                   Begin
                       Delete(St,i,1);
                      i:= i - 1;
                  End;
            End;
      End;
   l1:=Length(St);
   Writeln;
   Writeln('+Chuoi ban dau : ',St1,' co: ',l:2,' ky tu');
   Writeln('       Sau khi xoa ky tu trung nhau');
    Writeln(' Chuoi con lai: ',St,' gom: ',l1:2,' ky tu');
   Writeln;
   Writeln('      Bam phim <Enter> de ket thuc');
   Readln
End.
28/Tìm chuổi 2 xuất hiện trong chuổi 1:
Code:
Program Tim_chuoi;
    Var
       St1,St2:String;
      i,sl:Integer;
Begin
    Writeln('TIM CHUOI HAI XUAT HIEN TRONG CHUOI MOT');
   Writeln('           --------------');
   Writeln;
   Write('-Chuoi thu nhat: ');
   Readln(St1);
   Write('-Chuoi thu hai : ');
    Readln(St2);
    sl:=0;
    For i:=1 To Length(St1) Do
        If St2 = Copy(St1,i,Length(St2)) Then
            sl:=sl+1;
    Writeln;
    Writeln('+Chuoi thu 2 xuat hien: ',sl:2,' lan trong chuoi 1');
    Writeln;
    Writeln('   Bam phim <Enter> de ket thuc');
    Readln
End.
29/Đổi số La mã ra số thập phân:
Code:
Program So_La_Ma;
    Label l1;
    Var
       St:String;
      tiep:Char;
      i,So:Integer;
Begin
    Writeln('DOI SO LA MA RA SO THAP PHAN');
   Writeln('       ------------');
   Writeln;
   L1:Write('-Nhap so La ma: ');
   Readln(St);
   So:=0;
   i:=Length(St);
   While i > 0 Do
       Case St[i] Of
          'I':Begin
                 So:=So+1;
               i:=i-1;
              End;
         'V':If (i > 1) And (St[i-1] = 'I') Then
                     Begin
                        So:=So+4;
                   i:=i-2;
                  End
              Else
               Begin
                        So:=So+5;
                   i:=i-1;
                  End;
            'X':If (i > 1) And (St[i-1] = 'I') Then
                     Begin
                        So:=So+9;
                   i:=i-2;
                  End
              Else
               Begin
                        So:=So+10;
                   i:=i-1;
                  End;
            'L':If (i > 1) And (St[i-1] = 'X') Then
                     Begin
                        So:=So+40;
                   i:=i-2;
                  End
              Else
               Begin
                        So:=So+50;
                   i:=i-1;
                  End;
            'C':If (i > 1) And (St[i-1] = 'X') Then
                     Begin
                        So:=So+90;
                   i:=i-2;
                  End
              Else
               Begin
                        So:=So+100;
                   i:=i-1;
                  End;
            'D':If (i > 1) And (St[i-1] = 'C') Then
                     Begin
                        So:=So+400;
                   i:=i-2;
                  End
              Else
               Begin
                        So:=So+500;
                   i:=i-1;
                  End;
            'M':If (i > 1) And (St[i-1] = 'C') Then
                     Begin
                        So:=So+900;
                   i:=i-2;
                  End
              Else
               Begin
                        So:=So+1000;
                   i:=i-1;
                  End;
      End;
      Writeln('+So La ma        : ',St);
      Writeln('+Doi ra thap phan: ',So);
      Writeln;
      Write('-Tiep tuc nua khong (c/k) ');
      Readln(tiep);
      If UpCase(tiep)='C' Then
          Goto l1;
End.
30/Kiểm tra số nhập vào:
Code:
Program Kiem_tra_so;
    Label tt;
    Var
       St:String;
      So:Real;
      Dung:Integer;
      tiep:Char;
Begin
    Repeat
       Writeln('KIEM TRA SO NHAP VAO');
      Writeln('    -----------');
      tt:Write('-Nhap mot so: ');
      Readln(St);
      Val(St,So,Dung);
      If Dung = 0 Then
          Writeln('  +Ban da nhap mot so: ',So:8:2)
      Else
         Writeln('  +Khong phai so, xin nhap lai:');
   Until Dung = 0;
   Writeln;
   Write('-Co tiep tuc khong (C/K) ');
   Readln(Tiep);
   If UpCase(Tiep)='C' Then
       Goto tt;
End.
31/Chuơng trình mã hóa:
Code:
Program Ma_hoa;
    Var
       St:String;
      k:Integer;
      i,n:Integer;
Begin
    Writeln('CHUONG TRINH MA HOA');
   Writeln('   -----------');
   Write('-Nhap chuoi: ');
   Readln(St);
   Write('-Nhap ma so k: ');
   Readln(k);
   k:=k Mod 26;
   For i:= 1 To Length(St) Do
       Begin
          n:=Ord(St[i]);
         If (n >=97) And (n<=122) then
             Begin
                n:=n+k;
               If n > 122 Then
                   n:=(n Mod 122) + 96;
            End;
         St[i]:=Chr(n);
      End;
   Writeln;
   Writeln('+Sau khi ma hoa: ',St);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.
32/Ngắt từng từ trong câu:
Code:
Program Ngat_tu;
    Var
       St:String;
Begin
    Writeln('NGAT TUNG TU TRONG CAU');
   Writeln('    --------------');
   Writeln;
   Write('-Nhap mot cau: ');
   Readln(St);
   Repeat
       While (St[1] =' ') And (Length(St) <> 0) Do
          Delete(St,1,1);
      While (St[1] <> ' ') And (Length(St) <>0) Do
            Begin
             Write(St[1]);
            Delete(St,1,1);
            End;
      Writeln;
   Until Length(St)=0;
   Readln
End.
33/Kiểm tra kí tự trùng của 2 chuổi:
Code:
Program Cung_Ky_Tu;
    Var
       St1,St2:String;
      Dung:Boolean;
      i:Integer;
Begin
    Writeln('KIEM TRA KY TU TRUNG CUA 2 CHUOI');
   Writeln('        --------------');
   Writeln;
   Write('-Nhap chuoi 1: ');
   Readln(St1);
   Write('-Nhap chuoi 2: ');
   Readln(St2);
   Dung:=False;
   If Length(St1)=Length(St2) Then
       Begin
          Dung:=True;
         For i:= 1 To Length(St1) Do
             If Pos(St1[i],St2) = 0 Then
                Dung:=False
            Else
                Delete(St2,Pos(St1[i],St2),1);
      End;
   If Dung Then
       Writeln('+Hai chuoi co cung cac ky tu')
   Else
       Writeln('+Hai chuoi co cac ky tu khac nhau');
   Readln
End.
34/Kiểm tra chuổi đối xứng:
Code:
Program Chuoi_Doi_Xung;
    Var
       St:String;
      l,i:Integer;
      Dung:Boolean;
Begin
    Writeln('KIEM TRA CHUOI DOI XUNG');
   Writeln('    -------------');
   Writeln;
   Write('-Nhap chuoi: ');
   Readln(St);
   l:=Length(St);
   Dung:=True;
   For i:=1 To (l Div 2) Do
       If St[i] <> St[l-i+1] Then
          Dung:=False;
   If Dung Then
       Writeln('+Chuoi nay doi xung')
   Else
       Writeln('+Chuoi nay khong doi xung');
   Readln
End.
35/Đổi số thập phân ra số la mã:
Code:
Program So_La_Ma;
    Var
       So,So1,i:Integer;
      St:String;
Begin
    Writeln('DOI SO THAP PHAN SANG SO LA MA');
   Writeln('        ------------');
   Writeln;
   Write('-Nhap so nguyen: ');
   Readln(So);
   So1:=So;
   St:=' ';
   For i:=1 To (so Div 1000) Do
       St:=St+'M';
   So:=So Mod 1000;
   If So >= 900 Then
       Begin
         St:=St+'CM';
         So:=So-900;
      End
   Else
        If So >=500 Then
             Begin
                St:=St+'I';
           So:=So-500;
            End
      Else
          If So >=400 Then
             Begin
                St:=St+'CD';
               So:=So-400;
            End;
   For i:=1 To (so Div 100) Do
       St:=St+'C';
   So:=So Mod 100;
   If So >= 90 Then
       Begin
         St:=St+'XC';
         So:=So-90;
      End
   Else
        If So >=50 Then
             Begin
                St:=St+'L';
           So:=So-50;
            End
      Else
          If So >=40 Then
             Begin
                St:=St+'XL';
               So:=So-40;
            End;
   For i:=1 To (so Div 10) Do
       St:=St+'X';
   So:=So Mod 10;
   If So >= 9 Then
       Begin
         St:=St+'IX';
         So:=So-9;
      End
   Else
        If So >=5 Then
             Begin
                St:=St+'V';
           So:=So-5;
            End
      Else
          If So >=4 Then
             Begin
                St:=St+'IV';
               So:=So-4;
            End;
   For i:=1 To So Do
       St:=St+'I';
   Writeln;
   Writeln('+So thap phan: ',So1);
   Writeln('+So La ma    : ',St);
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc');
   Readln
End.
36/Mãng số thực:
Code:
Program Mang_so_thuc;
    Const
       Max = 100;
   Type
       Mang=Array[1..Max] Of Real;
   Var
       i,n:Integer;
      A:mang;
Begin
    Writeln('MANG SO THUC');
   Writeln('------------');
   Repeat
       Write('-Cho biet so phan tu: ');
      Readln(N);
   Until N <= Max;
   For i:=1 To N Do
       Begin
          Write('+Phan tu thu: ',i,' = ');
         Readln(a[i]);
      End;
   Writeln;
   Writeln('IN THEO THU TU NGUOC');
   Writeln('--------------------');
   Writeln;
   For i:=N Downto 1 Do
       Write(a[i]:4:1,' ');
   Writeln;
   Writeln;
   Writeln('IN CAC DOI SO CUA CAC PHAN TU MANG');
   Writeln('----------------------------------');
   Writeln;
   For i:=1 To N Do
       Write(a[i]:4:1,' ');
   Writeln;
   Readln
End.
37/Tổng tích ma trận:
Code:
Program Tong_Tich_Ma_tran;
    Uses Crt;
   Type
       Matran=array[1..3,1..3] Of Integer;
   Var
       a,b,c,d:Matran;
      i,j,k:Byte;
      Ch:Char;
   {*****************************}
   Procedure Nhap(Var m:Matran; Ten:Char);
   Begin
       ClrScr;
      GotoXY(26,6);
      Write('-Nhap ma tran: ',Ten);
      For i:=1 To 3 Do
          For j:=1 to 3 Do
             Begin
                GotoXY(20*i-8,10+2*j);
               Write(Ten,'[',i,',',j,']= ');
               Readln(m[i,j]);
            End;
   End;
   {*****************************}
   Procedure Xuat(m:Matran; Ten:Char);
   Begin
       ClrScr;
      GotoXY(26,6);
      Write('CAC PHAN TU CUA MA TRAN: ',Ten);
      For i:=1 To 3 Do
          For j:=1 To 3 Do
             Begin
                GotoXY(20*i-8,10+2*j);
               Write(Ten,'[',i,',',']= ',m[i,j]);
            End;
   End;
   {*****************************}
BEGIN
    Nhap(a,'A');
   Nhap(b,'B');
   For i:=1 To 3 Do
       For j:=1 To 3 Do
          c[i,j]:=a[i,j]+b[i,j];
   Writeln;
   Writeln('MA TRAN TONG');
   Writeln;
   Xuat(c,'C');
   GotoXY(10,25);
   Write('Bam phim <Esc> de xem ma tran tich');
   For i:=1 to 3 Do
       For j:=1 To 3 Do
          Begin
             d[i,j]:=0;
            For k:=1 To 3 Do
                d[i,j]:=a[i,k]*b[k,j]+d[i,j];
         End;
   Repeat
       Ch:=Readkey;
      If Ch=#0 then
          Ch:=Readkey;
   Until Ch=#27;
   Writeln('MA TRAN TICH= ');
   Xuat(d,'D');
   Repeat
   Until KeyPressed;
END.
38/Sắp xếp mảng tăng dần:
Code:
Program Mang_tang;
    Const
       Max=10;
    Var
       a:Array[1..Max] Of Integer;
      i,j,tam:Integer;
Begin
    Writeln('SAP XEP MANG TANG DAN');
   Writeln('---------------------');
   Writeln;
   For i:= 1 To Max Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   For i:=1 to Max-1 Do
         For j:= i+1 To Max Do
          Begin
             If a[i] > a[j] Then
                Begin
                   tam:=a[i];
                  a[i]:=a[j];
                  a[j]:=tam;
               End;
      End;
   Writeln;
   Writeln('+Mang sau khi sap xep:');
   Writeln;
   For i:=1 To Max Do
       Write(a[i],' ');
   Writeln;
   Readln
End.
39/Sắp xếp mảng bảng giải thuật chèn:
Code:
Program Gt_Chen;
    Const
       spt=10;
   Var
       a:array[1..spt] Of Integer;
      i,j,k,tam:Integer;
Begin
    Writeln('SAP XEP MANG BANG GIAI THUAT CHEN');
   Writeln('---------------------------------');
   Writeln;
   For i:=1 To spt Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   For i:=2 To spt Do
       If a[i] < a[i-1] Then
          Begin
             j:=1;
            While a[j] < a[i] Do
                j:=j+1;
            tam:=a[i];
            For k:=i Downto j+1 Do
                a[k]:=a[k-1];
            a[j]:=tam;
         End;
   Writeln;
   Writeln('Mang sau khi sap xep:');
   For i:=1 To spt Do
       Write(a[i]:6);
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
40/Sắp xếp mảng bảng giải thuật chọn:
Code:
Program Gt_Chon;
    Const
       spt=10;
   Var
       a:array[1..spt] Of Integer;
      min,vitri,i,j:Integer;
Begin
    Writeln('SAP XEP MANG BANG GIAI THUAT CHON');
   Writeln('---------------------------------');
   Writeln;
   For i:=1 To spt Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   For i:=1 To spt Do
       Begin
          min:=a[spt];
         vitri:=spt;
         For j:=i To spt Do
             If a[j] < min Then
                Begin
                   min:=a[j];
                  vitri:=j;
               End;
         a[vitri]:=a[i];
         a[i]:=min;
      End;
   Writeln;
   Writeln('Mang sau khi sap xep:');
   For i:=1 To spt Do
       Write(a[i]:6);
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.


41/Sắp xếp mảng bằng giải thuật nổi bọt:
Code:
Program Gt_Noi_bot;
    Const
       spt=10;
   Var
       a:array[1..spt] Of Integer;
      i,j,tam:Integer;
Begin
    Writeln('SAP XEP MANG BANG GIAI THUAT NOI BOT');
   Writeln('-----------------------------------');
   Writeln;
   For i:=1 To spt Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   For i:=1 To spt-1 Do
       For j:= spt Downto i+1 Do
          If a[j] < a[j-1] Then
             Begin
                tam:=a[j];
               a[j]:=a[j-1];
               a[j-1]:=tam;
            End;
   Writeln;
   Writeln('Mang sau khi sap xep:');
   For i:=1 To spt Do
       Write(a[i]:6);
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
42/Giải thuật tìm kiếm tuyến tính:
Code:
Program Tim_Tuyen_Tinh;
    Const
       N=10;
   Var
       a:array[1..N] Of Integer;
      so,i:Integer;
Begin
    Writeln('GIAI THUAT TIM KIEM TUYEN TINH');
   Writeln('------------------------------');
   Writeln;
   For i:=1 To N Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   Writeln;
   Write('-So can tim: ');
   Readln(so);
   i:=1;
   While (i <=N) And (a[i] <> so) Do
       i:=i+1;
   If i <= N Then
       Writeln('+Tim thay o vi tri thu: ',i)
   Else
       Writeln('+Khong tim thay');
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
    Readln
End.
43/Giải thuật tìm kiếm nhị phân:
Code:
Program Tim_Nhi_Phan;
    Const
       N=10;
   Var
       a:array[1..N] Of Integer;
      so,vt1,vt2,i:Integer;
Begin
    Writeln('GIAI THUAT TIM KIEM NHI PHAN');
   Writeln('----------------------------');
   Writeln;
   For i:=1 To N Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   Writeln;
   Write('-So can tim: ');
   Readln(so);
   vt1:=1;
   vt2:=n;
   While vt2 >= vt1 Do
       Begin
          i:=Trunc((vt1+vt2) Div 2);
         If so > a[i] Then
             vt1:=i+1
         Else
             If so < a[i] Then
                vt2:=i-1
            Else
                vt2:=-1;
      End;
   If vt2 = -1 Then
       Writeln('+Tim thay o vi tri thu: ',i)
   Else
       Writeln('+Khong tim thay');
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
    Readln
End.
44/Xóa bỏ các số trùng nhau:
Code:
Program Bo_so_trung;
    Const
       Max=100;
    Var
   a:Array[1..Max] Of Integer;
   i,j,k,n:Integer;
Begin
    Writeln('XOA BO CAC SO TRUNG NHAU');
   Writeln('------------------------');
   Writeln;
   Write('-Nhap so phan tu mang: ');
   Readln(n);
   For i:=1 To N Do
       Begin
          Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
    i:=2;
   While i <= N Do
       Begin
          j:=1;
         While a[j] <> a[i] Do
             j:=j+1;
         If j < i Then
             Begin
                For k:=i to n-1 Do
                   a[k]:= a[k+1];
               n:=n-1;
            End
         Else
             i:=i+1;
      End;
   Writeln;
   Write('-Mang con lai: ');
   For i:=1 to n Do
       Write(a[i]:8);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
End.
45/Dãy con:
Code:
Program Day_con;
    Const
       k=10;
       a:Array[1..k] Of Integer=(1,3,2,8,10,12,7,29,6,3);
   Var
       i:Integer;
      vt,max:Integer;
      n,tong:Integer;
Begin
    Vt:=1;
   max:=a[1];
   n:=1;
   tong:=a[1];
   For i:=2 To k Do
       Begin
          If (a[i] > a[i-1]) Then
             tong:=tong+a[i];
         If (a[i] < a[i-1]) Or (i=k) Then
             Begin
                If tong > max Then
                   Begin
                      max:=tong;
                     vt:=n;
                  End;
               n:=i;
               tong:=a[i];
            End;
      End;
   Writeln('-Day con la: ');
   i:=vt;
   Repeat
       Write(a[i]:6);
      max:=max-a[i];
      i:=i+1;
   Until max=0;
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
46/Chữ hoa:
Code:
Program Chu_hoa;
    Uses Crt;
   Const
       a:Array[1..10] Of String[24]=('nguyen trung truc','dinh tien hoang',
          'nguyen cong tru','le thanh ton','le loi','le lai','tran hung dao',
         'nguyen hue','chu van an','mac dinh chi');
   Var
       k,j:Byte;
   {-------------------------}
   Procedure ChuHoa(x,y:Byte; a:String);
       Var
          k:Byte;
   Begin
       For k:=1 To length(a) Do
          If (k=1) Or ((a[k-1]=' ') And (a[k]<>' ')) Then
             Begin
                GotoXY(x+k-1,y);
               Write(UpCase(a[k]));
            End;
   End;
Begin
    ClrScr;
   For k:=1 To 10 Do
       Begin
          GotoXY(5,k);
         Write(a[k]:-24);
         ChuHoa(5,k,a[k])
      End;
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
47/Tam giác Pascal:
Code:
Program Tg_Pascal;
    Const
       n=10;
   Var
       a:Array[1..n, 1..n] Of Integer;
      i,j:Integer;
Begin
    Writeln('TAM GIAC PASCAL');
   Writeln('---------------');
   Writeln;
   For i:=1 To n Do
       a[i,1]:=1;
    For j:=1 To n Do
       a[1,j]:=0;
   For i:=2 To n Do
       For j:=2 To n Do
          a[i,j]:=a[i-1,j-1]+a[i-1,j];
   For i:=1 To n Do
       Begin
          For j:=1 To i Do
             Write(a[i,j]:4);
         Writeln;
      End;
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
48/Phân tích số nguyên duơng nhỏ nhất:
Code:
Program Phan_tich;
    Const
       n=15;
   Var
       a:Array[1..n, 1..n] Of Longint;
      i,j,i1,j1:Integer;
Begin
    Writeln('PHAN TICH SO NGUYEN DUONG NHO NHAT');
   Writeln('----------------------------------');
   Writeln;
   For i:=1 To n Do
       For j:=1 To n Do
          a[i,j]:=i*i*i + j*j*j;
   Writeln;
   Writeln('IN KET QUA');
   Writeln('----------');
   For i:=1 To n Do
       For j:=1 To i Do
          Begin
             For i1:= i+1 To n Do
                For j1:=1 To j-1 Do
                   If a[i,j]=a[i1,j1] Then
                      Writeln(a[i,j],' = ',i,' ^3 ',' + ',j,' ^3 ',' = ',
                     i1,' ^3 ',' + ',j1,' ^3');
         End;
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln
End.
49/Bảng cửu chuơng:
Code:
Program Cuu_Chuong;
    Uses Crt;
    Type
       cc1=Array[1..5, 1..10] Of Byte;
      cc2=Array[6..10, 1..10] Of Byte;
    Var
      i,j:Byte;
   Procedure In1;
       Var
          a:cc1;
          cot,hang:Byte;
      Begin
          cot:=1;
         hang:=3;
         For i:=1 To 5 Do
               For j:=1 To 10 Do
                  Begin
                   GotoXY(cot,hang);
                  a[i,j]:=i * j;
                  TextColor(Yellow);
                  Writeln(i:2,' lan ',j:2,' =',a[i,j]:3,'|');
                  hang:=hang+1;
                    If hang > 12 Then
                       Begin
                           hang:=3;
                          cot:=cot+15;
                        End;
              End;
      End;
   Procedure In2;
       Var
          a:cc2;
          cot,hang:Byte;
      Begin
          cot:=1;
         hang:=14;
         For i:=6 To 10 Do
               For j:=1 To 10 Do
                  Begin
                   GotoXY(cot,hang);
                  a[i,j]:=i * j;
                  Textcolor(LightMagenta);
                  Writeln(i:2,' lan ',j:2,' =',a[i,j]:3,'|');
                  hang:=hang+1;
                    If hang > 23 Then
                       Begin
                           hang:=14;
                          cot:=cot+15;
                        End;
              End;
      End;

BEGIN
    ClrScr;
   Textcolor(Cyan);
   Writeln('                          BANG CUU CHUONG');
   Writeln('                          ---------------');
    In1;
   Textcolor(LightBlue);
   Writeln('               -------------------------------------------');
   In2;
   Textcolor(LightGreen);
   Writeln('                     Bam phim <Enter> de ket thuc');
   Readln
END.
50/Tìm 2 phần tử liên tiếp trong bảng X:
Code:
Program Tim_PT_Mang;
    Uses Crt;
   Var
       a:Array[1..1000] Of Integer;
   {----------------------------}
   Procedure Tao;
       Var
          k:Integer;
   Begin
       Randomize;
      For k:=1 To 100 Do
          a[k]:=Random(100);
   End;
   {----------------------------}
   Procedure Tim;
       Var
          k,x:Integer;
   Begin
       Write('-Nhap gia tri X= ');
      Readln(x);
      For k:=1 To 999 Do
          Begin
              If a[k] +a[k+1] = X Then
                 Writeln('a[',K,'] + a[',K+1,']= ',X)
             Else
                 Writeln('Khong co 2 phan tu nao bang: ',X);
            End;
   End;
BEGIN
    Writeln('TIM 2 PHAN TU LIEN TIEP BANG GIA TRI X');
   Writeln('-------------------------------------');
   Writeln;
   Tao;
   Tim;
   Writeln;
   Writeln('  Bam phim <Enter> de ket thuc ');
   Readln;
END.


***Hãy cùng chia sẻ với bạn bè bằng cách ***
Copy nội dung dưới đây gửi đến nick yahoo bạn bè!
Tài sản của KuteoDnC
Trả Lời Với Trích Dẫn
  #2  
Old 28-11-2010, 10:47 PM
KuteoDnC's Avatar
  User Profile
KuteoDnCAdmin KuteoDnC is offline
Administrator
   Họ & Tên: Ku tèo
  • Đang học lớp : * Đã ra trường .
  • Niên khóa : 2002 - 2005
 
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,318,535
Đã cảm ơn: 159 bài viết
Được cảm ơn 645 lần trong 184 bài
KuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to behold

Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng 
Total Awards: 8

Send a message via ICQ to KuteoDnC
Default

51/SX Nhị Phân:
Code:
Program SX_Nhi_Phan;
     Uses Crt;
    Const
        Pt=240;
    Type
        Mang=Array[1..Pt] Of Integer;
    Var
       a:Mang;
       n:Integer;
    {---------------------------------}
    Procedure Sort(Var a: Mang; n:Integer);
        Var
           k,j,dau,cuoi,giua,tam:Integer;
    Begin
        For k:=2 To n Do
           Begin
              tam:=a[k];
             cuoi:=1;
             dau:=k-1;
             While cuoi <= dau Do
                 Begin
                    giua:=(dau+cuoi) Div 2;
                   If tam < a[giua] Then
                       dau:=giua-1
                   Else
                       cuoi:=giua+1;
                End;
             For j:=k-1 Downto cuoi Do
                 a[j+1]:=a[j];
             a[cuoi]:=tam
          End
    End;
   {---------------------------------}
 BEGIN
     ClrScr;
    Randomize;
    For n:=1 To Pt Do
        a[n]:=Random(1000);
    Sort(a,Pt);
    For n:=1 To Pt Do
        Write(' ',a[n]:6,' ');
    Readln
 END.
52/Kiểm tra ngày tháng:
Code:
Program KT_ngay;
 CONST
     Ngay  = [1..31];
     Thang = [1..12];
    Th31ngay: Set of byte = [1,3,5,7,8,10,12];
 
    BaoLoi : Array[1..3] Of String[30] =('-Ban nhap sai ngay, thang',
              '-Thang nay khong co ngay 31','-thang 2 khong co ngay nay');
 
 TYPE
       NgayThang = RECORD
          Ng, Th : Byte;
       Nam    : Word;
    End;
 
 VAR
        Nhatky : NgayThang;
         Loi    : Array[1..3] Of Boolean;
         i      : Byte;
         Nhuan  : Boolean;
 BEGIN
     With Nhatky Do
        Begin
           Write('-Nhap ngay = ');
          Readln(Ng);
             Write('-Nhap thang= ');
          Readln(Th);
          Write('-Nhap nam  = ');
          Readln(Nam);
          Loi[1] := (NOT(Ng In Ngay)) OR (NOT (Th In Thang));
          Loi[2] := (Ng = 31) AND (NOT (Th In Th31Ngay));
          Nhuan  := ((Nam Mod 4) = 0) AND ((Nam Mod 100) <> 0)
                      OR ((Nam Mod 400) = 0);
          Loi[3] := ((Ng > 29) AND (Th = 2)) OR ((Ng = 29)
                      AND (th = 2) AND (NOT Nhuan));
       End;
    For i := 1 To 3 Do
        If Loi[i] Then
           Writeln(BaoLoi[i]);
     Readln
 END.
53/Điểm Văn Toán Lí:
Code:
Program Van_Toan_Ly;
 CONST
     Max = 50;
    Td1='|------------------------|-----|-----|------|';
    Td2=#124 +'     HO VA TEN          ' + #124 + ' VAN ' + #124+
       'TOAN ' + #124 + '  LY  |';
 
 TYPE
       HocSinh = RECORD
          HoTen       : String[24];
       Van,Toan,Ly : Real;
    End;
 
 VAR
    Hs  : Array[1..Max] Of HocSinh;
    i,n : 1..Max;
 BEGIN
     Writeln('NHAP XUAT DU LIEU KIEU BAN GHI');
    Writeln('------------------------------');
    Writeln;
    Write('-Lop co bao nhieu hoc sinh: ');
    Readln(n);
    For i := 1 To N Do {Nhap du lieu}
        With Hs[i] Do
           Begin
              Write('-Ho ten hoc sinh thu: ',i:2,' = ');
             Readln(HoTen);
             Write('-Diem Van : ');
             Readln(Van);
             Write('-Diem Toan: ');
                 Readln(Toan);
                 Write('-Diem Ly  : ');
                 Readln(Ly);
          End;
    Writeln;
    Writeln('                  BANG DIEM');
    Writeln;
    Writeln(Td1);
    Writeln(Td2);
    Writeln(Td1);
     For i := 1 To N Do    {Xuat du lieu }
         With Hs[i] Do
             Writeln(#124,HoTen,#32:24 - Length(HoTen),
                     #124,Van  :5:1,
                       #124,Toan :5:1,
                  #124,Ly   :5:1,' |');
    Writeln(Td1);
    Readln
 END.
54/Sắp xếp tuổi giảm:
Code:
Program Sap_Xep_Tuoi_Giam;
 CONST
     Max = 50;
    Td1 = '|========================|============|';
    Td2 = #124+'      HO VA TEN         '+#124 + '  NAM SINH  |';
    Td3 = '|------------------------|------------|';
 
 TYPE
     HoSo = RECORD
        HoTen : String[24];
       Ngay  : 1..31;
       Thang : 1..12;
       Nam   : 1900..2000;
    End;
 VAR
    Nhanvien :Array[1..Max] Of HoSo;
    i,n  : 1..Max;
    Tam  : HoSo;
    Kthuc: Boolean;
 
 BEGIN
     Writeln('SAP XEP BAN GHI THEO GIAI THUAT NOI BOT');
    Writeln('---------------------------------------');
    Writeln;
    Write('-Co bao nhieu nguoi: ');
    Readln(n);
    For i := 1 to N Do   { Nhap du lieu }
        With Nhanvien[i] Do
           Begin
              Write('-Ho va ten nguoi thu: ',i:2,' = ');
             Readln(HoTen);
             Write('-Ngay sinh: ');
             Readln(Ngay);
             Write('-Thang    : ');
             Readln(Thang);
             Write('-Nam      : ');
             Readln(Nam);
          End;
    Repeat          { Sap xep ban ghi}
        KThuc := True;
       For i := 1 To N - 1 Do
           If (Nhanvien[i].Nam > Nhanvien[i+1].Nam)
                 OR ((Nhanvien[i].Nam = Nhanvien[i+1].Nam) AND
                      (Nhanvien[i].Thang > Nhanvien[i+1].Thang))
                 OR ((Nhanvien[i].Nam = Nhanvien[i+1].Nam) AND
                      (Nhanvien[i].Thang = Nhanvien[i+1].Thang) AND
                 (Nhanvien[i].Ngay > Nhanvien[i+1].Ngay)) Then
             Begin
                 Tam:=Nhanvien[i];
                Nhanvien[i] := Nhanvien[i+1];
                Nhanvien[i+1] := Tam;
                KThuc :=False;
             End;
    Until KThuc;
    Writeln;
    Writeln('          SAP XEP THEO TUOI');
    Writeln;
    Writeln(Td1);
    Writeln(Td2);
    Writeln(Td3);
    For i := 1 to N Do
        With Nhanvien[i] Do
           Writeln(#124, HoTen, #32 :24 - Length(HoTen),
                  #124,Ngay,' / ',Thang,' / ',nam, #124);
    Writeln(Td1);
    Readln
 END.
55/Câu hỏi trắc nghiệm:
Code:
Program Trac_Nghiem;
 TYPE
     Tracnghiem = RECORD
        CauHoi     : String;
       A,B,C,D : String;
       DapAn   : Char;
    End;
 
 VAR
     a:Array[1..5] Of Tracnghiem;
    i,dung : Integer;
    Traloi : Char;
 
 BEGIN
     Writeln('CAU HOI TRAC NGHIEM');
    Writeln('-------------------');
    Writeln;
    Writeln('-Nhap 5 cau hoi,y nghia va dap an');
    For i := 1 To 5 Do
        With a[i] Do
           Begin
              Write('-Cau hoi thu: ',i:2,' : ');
             Readln(CauHoi);
             Write('    +Nghia    A: ');
             Readln(A);
             Write('    +Nghia    B: ');
             Readln(B);
             Write('    +Nghia    C: ');
             Readln(C);
             Write('    +Nghia    D: ');
             Readln(D);
             Write('-Dap an: ');
             Readln(DapAn);
             DapAn := UpCase(DapAn);
          End;
 
    Dung := 0;
    Writeln('-Ban chon nghia cho tung cau hoi');
    For i := 1 To 5 Do
        Begin
           Writeln(i,'. ',a[i].CauHoi);
          Writeln(' A)',a[i].A);
          Writeln(' B)',a[i].B);
          Writeln(' C)',a[i].C);
          Writeln(' D)',a[i].D);
          Write('-Lua cau nao go vao nghia cua cau do: ');
          Readln(TraLoi);
          If UpCase(TraLoi) = a[i].DapAn Then
              Dung := Dung + 1;
       End;
    Writeln;
    Writeln('-So cau tra loi dung: ',Dung);
    Readln
 END.
56/Từ điển:
Code:
Program Tu_dien;
 TYPE
     Tudien = RECORD
        Anh,Viet : String;
    End;
 
 VAR
     a: Array[1..5] Of TuDien;
    St : String;
    i : Integer;
    TimDuoc : Boolean;
 
 BEGIN
     For i := 1 To 5 Do
        Begin
           Writeln('-Tu thu: ',i);
          Write('    +Nghia tieng Anh  : ');
          Readln(a[i].Anh);
          Write('    +Nghia tieng Viet : ');
          Readln(a[i].Viet);
       End;
    Writeln;
    Write('*Tu tieng Anh can tim: ');
    Readln(St);
    TimDuoc :=False;
    i := 1;
    While (NOT TimDuoc) AND (i <= 5) Do
        Begin
           If St = a[i].Anh Then
              Begin
                 Write('*Nghia tieng Viet    : ',a[i].Viet);
                TimDuoc := True;
             End;
          i := i + 1;
       End;
    If NOT TimDuoc then
        Writeln('Tu nay khong co trong tu dien');
    Readln
 END.
57/Thành tích của đội bóng đá:
Code:
Program TT_Doi_Bong;
     CONST
         Max = 23;
    TYPE
        ThanhTich=RECORD
           HoTen:String[24];
             Tuoi,BanThang:Integer;
         END;
    DoiBong = Array[1..Max] Of ThanhTich;
    VAR
        i,n,TuoiCao,TuoiThap,nam:Integer;
       Ten1,Ten2,TenDoi:String[20];
       CauThu:DoiBong;
       ThangNhieu,ThangIt:Integer;
       Tb:Real;
 BEGIN
     Writeln('THANH TICH CUA DOI BONG DA');
    Writeln('--------------------------');
    Write('-Thanh tich nam nao: ');
    Readln(Nam);
    Write('-Ten doi bong: ');
    Readln(TenDoi);
    Write('-So cau thu: ');
    Readln(n);
    For i:=1 To n Do
        With Cauthu[i] Do
           Begin
              Write('-Ho va ten cau thu thu: ',i:2,' la: ');
             Readln(HoTen);
             Write('-Tuoi cua cau thu thu: ',i:2,' la: ');
             Readln(Tuoi);
             Write('-So ban thang cua cau thu thu: ',i:2,' la: ');
             Readln(BanThang);
          End;
    TuoiCao:=CauThu[1].Tuoi;
    Tuoithap:=CauThu[1].Tuoi;
    ThangNhieu:=Cauthu[1].Banthang;
    ThangIt:=CauThu[1].BanThang;
    Ten1:=CauThu[1].HoTen;
    Ten2:=CauThu[1].HoTen;
    Tb:=CauThu[1].BanThang;
    For i:=2 To n Do
        Begin
           If CauThu[i].Tuoi > TuoiCao Then
              TuoiCao:=CauThu[i].Tuoi
          Else
              If CauThu[i].Tuoi < TuoiThap Then
                 Tuoithap :=CauThu[i].Tuoi;
          If CauThu[i].BanThang > ThangNhieu Then
                 Begin
                       ThangNhieu:=Cauthu[i].BanThang;
                   Ten1:=CauThu[i].HoTen;
             End
          Else
                If CauThu[i].BanThang < ThangIt Then
                   Begin
                      ThangIt:= CauThu[i].BanThang;
                   Ten2:=CauThu[i].HoTen;
                End;
             Tb:=Tb+CauThu[i].BanThang;
       End;
    Writeln;
    Writeln('THANH TICH NAM: ',nam);
    Writeln('Cua doi bong: ',TenDoi);
    Writeln('-----------------------');
    Writeln;
    Writeln('-Cau thu: ',Ten1,' co tuoi lon nhat: ',TuoiCao);
    Writeln('-Cau thu: ',Ten2,' co tuoi nho nhat: ',TuoiThap);
    Writeln;
    Writeln('-Cau thu: ',Ten1,' Co ban thang nhieu nhat: ',ThangNhieu);
    Writeln('-Cau thu: ',Ten2,' Co ban thang it    nhat: ',ThangIt);
    Writeln;
    Writeln('-So ban thang trung binh cua toan doi: ',Round(Tb/n));
    Readln
 END.
58/Nhập xuất số hữu tỷ:
Code:
Program So_Huu_Ty;
 TYPE
     HuuTy = RECORD
        TuSo, MauSo : Integer;
    End;
 
 VAR
     So1, So2, Kq : HuuTy;
    St1, St2     : String;
    i,Result, n, m   : Integer;
    Ch                 : Char;
 
 BEGIN
     Writeln('NHAP, XUAT SO HUU TY');
    Writeln('--------------------');
    Writeln;
    Write('-So thu nhat: ');
    Readln(St1);
    Write('-So thu hai : ');
    Readln(St2);
    i := Pos('/', St1);
    With so1 Do
        If i = 0 Then
           Begin
              Val(St1, TuSo, Result);
             MauSo := 1;
          End
       Else
           Begin
              Val(Copy(St1, 1, i-1), TuSo, Result);
             Val(Copy(St1, i+1, Length(St1)-i), MauSo, Result);
          End;
     i := Pos('/', St2);
    With So2 Do
        If i = 0 Then
           Begin
              Val(St2, TuSo, Result);
             MauSo := 1;
          End
       Else
           Begin
              Val(Copy(St2, 1, i-1), TuSo, Result);
             Val(Copy(St2, i+1, Length(St2)-i), MauSo, Result);
          End;
    Write('Chon phep tinh (+, -, *, /): ');
    Readln(Ch);
    Case Ch Of
        '+' : Begin
                   Kq.TuSo := So1.TuSo*So2.MauSo + So1.MauSo * So2.TuSo;
                Kq.MauSo := So1.MauSo * So2.MauSo;
               End;
          '-' : Begin
                   Kq.TuSo := So1.TuSo*So2.MauSo - So1.MauSo * So2.TuSo;
                Kq.MauSo := So1.MauSo * So2.MauSo;
               End;
       '*' : Begin
                   Kq.TuSo := So1.TuSo*So2.TuSo;
                Kq.MauSo := So1.MauSo * So2.MauSo;
               End;
       '/' : Begin
                   Kq.TuSo := So1.TuSo*So2.MauSo;
                Kq.MauSo := So1.MauSo * So2.TuSo;
               End;
    End;
    If Kq.TuSo = 0 Then
        Write('Ket qua : 0')
    Else
        With Kq Do
           Begin
              n := ABS(TuSo);
             m := ABS(MauSo);
             While n <> m Do
                 If n > m Then
                    n := n-m
                Else
                    m := m-n;
              TuSo :=TuSo Div n;
              MauSo := MauSo Div n;
              If MauSo = 1 Then
                  Write('Ket qua : ',TuSo)
              Else
                  Write('Ket qua : ',TuSo,'/',MauSo);
          End;
    Readln
 END.
59/Sắp xếp theo tên:
Code:
Program Sap_Xep_Theo_Ten;
 TYPE
     HoSo = RECORD
        HoLot : String[17];
       Ten   : String[7];
       Diem  : Real;
    End;
 
 VAR
     a               : Array[1..50] Of HoSo;
    Tam        : HoSo;
    i,j,PhanTu : Integer;
 
 BEGIN
     PhanTu := 0;
    With Tam Do
    Repeat
        Write('-Nhap ho lot ( 0 de ket thu): ');
       Readln(HoLot);
       If HoLot <> '0' Then
           Begin
              Write('-Nhap ten  : ');
             Readln(Ten);
             Write('-Nhap diem : ');
             Readln(Diem);
             PhanTu := PhanTu + 1;
             a[PhanTu] := Tam;
          End;
    Until HoLot = '0';
 
    For i := 1 To PhanTu - 1 Do
        For j := PhanTu DownTo i+1 Do
           If a[j].Ten[1] < a[j-1].Ten[1] Then
              Begin
                 Tam := a[j];
                a[j] := a[j-1];
                a[j-1] := Tam;
             End;
    Writeln;
    Writeln('------------------------------------');
    Writeln('|       HO VA TEN          |  DIEM |');
     Writeln('|--------------------------|-------|');
     For i := 1 To PhanTu Do
         With a[i] Do
             Writeln('|',HoLot:17,' ',Ten:7,' |',Diem:5:1,'  |');
    Writeln('------------------------------------');
    Readln
 END.
60/Hóa đơn bán hàng:
Code:
Program Hoa_Don;
 CONST
     Max = 100;
 TYPE
     HoaDon = RECORD
        NguoiMua : String[24];
       TenHang  : String[10];
       DonGia   : Real;
       SoLuong  : Integer;
    End;
 
 VAR
     a   : Array[1..Max] Of HoaDon;
    DsTenHang : Array[1..Max] Of String[10];
    Tam       : HoaDon;
    Spt, SoTenHang, i, j : Integer;
    Tong                 : Real;
    KiemTra              : Boolean;
 
 BEGIN
     Writeln('HOA DON BAN HANG');
    Writeln('----------------');
    Writeln;
    Spt := 0;
    With Tam do
        Repeat
           Write('-Ten nguoi mua (go 0 de thoat): ');
          Readln(NguoiMua);
          If NguoiMua <> '0' Then
              Begin
                 Write('-Ten hang: ');
                Readln(TenHang);
                Write('-Don gia : ');
                Readln(DonGia);
                Write('-So luong: ');
                Readln(SoLuong);
                Spt := Spt + 1;
                a[Spt] := Tam;
             End;
       Until NguoiMua = '0';
    SoTenHang := 0;
    For i := 1 To Spt Do
        Begin
           KiemTra :=False;
          For j := 1 To SoTenHang Do
              If DsTenHang[j] = a[i].TenHang Then
                 KiemTra := True;
             If NOT KiemTra Then
                 Begin
                    SoTenHang :=SoTenHang + 1;
                   DsTenHang[SoTenHang] := a[i].TenHang;
                End;
       End;
    Writeln;
    For i := 1 To SoTenHang Do
        Begin
           Tong := 0;
          For j := 1 To Spt Do
              With a[j] Do
                 If TenHang = DsTenHang[i] Then
                    Tong := Tong + (DonGia * Soluong);
                Writeln('  +Tong so tien mua: ',DsTenHang[i]:10,' = ',tong:10:2);
       End;
    Readln
 END.


61/Tính thể tích lòng gỗ:
Code:
Program The_Tich_Long_Go;
 TYPE
     CachDo = (DuongKinh, ChuVi);
    LongGo = RECORD
        Cdai   : Real;
       Dscdai : Real;
       Case Cdo : CachDo Of
           DuongKinh : (Dk,Dsdk    : Real);
             ChuVi         : (Cvi, Dscvi : Real);
    End;
 
 VAR
     MaDo    :Char;
    Go      : LongGo;
    Ttich : Real;
    {------------------------}
    Function TheTich(A: LongGo): Real;
    Begin
        With A Do
           Case Cdo Of
              DuongKinh : TheTich := Pi*Sqr(Dk-Dsdk)*(Cdai-Dscdai)/40000;
             ChuVi     : TheTich := Sqr(Cvi-Dscvi)*(Cdai-Dscdai)/(Pi*40000);
          End;
    End;
 
 BEGIN
     Writeln('TINH THE TICH LONG GO');
    Writeln('---------------------');
    Writeln;
    Repeat
        Writeln('*Chon phuong phap do ?');
       Write('+Duong kinh (go K), +Chu vi (go V): ');
       Readln(Mado);
    Until Pos(Mado,'kKvV') <> 0;
    With Go Do
        Begin
           Write('-Chieu dai (m) = ');
          Readln(Cdai);
          Write('-Dung sai (m)  = ');
          Readln(Dscdai);
          Case Mado Of
              'k','K' : Begin
                             Cdo := DuongKinh;
                         Write('+Duong kinh (Cm): ');
                         Readln(Dk);
                         Write('+Dung sai (Cm)  : ');
                         Readln(Dsdk);
                          End;
              'v','V' : Begin
                             Cdo := Chuvi;
                         Write('+Chu vi (Cm)    : ');
                         Readln(Cvi);
                         Write('+Dung sai (Cm)  : ');
                         Readln(Dscvi);
                          End;
          End;
       End;
    Ttich :=TheTich(Go);
    Writeln;
    Writeln('*The tich long go la: ',Ttich:10:4,' m3');
    Writeln;
    Writeln('Bam phim <Enter> de ket thuc');
    Readln
 END.
62/Hồ sơ gia cảnh:
Code:
Program Gia_Canh;
 CONST
     Max = 100;
    Td1 ='|========================|========================|======|';
    Td2 =#124 +'         HO VA TEN      '+
          #124 +'      HO TEN VO CHONG   '+
           #124 +'SO CON'+#124;
    Td3 ='|------------------------|------------------------|------|';
 TYPE
     GiaCanh = RECORD
        HoTen :String[24];
       Case GiaDinh  : Boolean Of
               True  : (VoChong : String[24];
               SoCon : Byte);
       End;
 
 VAR
     Hsgc :Array[1..Max] Of GiaCanh;
    n, i : 1..Max;
    Ch   : Char;
 BEGIN
     Writeln('HO SO GIA CANH');
    Writeln('--------------');
    Writeln;
    Write('-So luong nhan vien: ');
    Readln(n);
    For i := 1 To N Do  {Nhap du lieu}
        With Hsgc[i] Do
           Begin
              Write('+Ho va ten nhan vien thu: ',i:2,' la= ');
             Readln(HoTen);
             Write('+Co gia dinh chua (C/K) ');
             Readln(Ch);
             Ch := UpCase(Ch);
             If Ch = 'C' Then
                 Begin
                    GiaDinh := True;
                   Write('    +Ho ten vo/chong: ');
                   Readln(VoChong);
                   Write('    +So con         : ');
                   Readln(SoCon);
                End
             Else
                 GiaDinh := False;
          End;
    Writeln;
    Writeln(#32:25,'HOAN CANH GIA DINH NHAN VIEN');
    Writeln(#32:12,Td1);
    Writeln(#32:12,Td2);
    Writeln(#32:12,Td3);
    For i := 1 To N Do     {Xuat du lieu }
        With Hsgc[i] Do
           Begin
              Write(#32:12);
             Write(#124,HoTen,#32:24-Length(HoTen));
             If GiaDinh Then
                 Begin
                    Write(#124,VoChong,#32:24-Length(VoChong));
                   Writeln(#124,SoCon:6,#124);
                End
             Else
                 Begin
                    Write(#124,#32:24);
                   Writeln(#124,#32:6,#124);
                End;
          End;
    Writeln(#32:12,Td1);
    Readln
 END.
63/Hồ sơ nhân viên:
Code:
Program Ho_So;
 CONST
     Max = 100;
 TYPE
     Str = String[24];
    HoSo = RECORD
        HoTen : Str;
       Tuoi  : Integer;
       Luong : Real;
    End;
    CongTy = Array[1..Max] Of HoSo;
 VAR
     Hoten1, Hoten2                : Str;
    i,n,TuoiMax,TuoiMin           : Integer;
    LuongMax, LuongMin,LuongTb : Real;
    Nv                                  : CongTy;
 Begin
     Writeln('HO SO NHAN VIEN');
    Writeln('---------------');
    Writeln;
    Write('-Co bao nhieu nguoi: ');
    Readln(n);
    For i := 1 To N Do
        With Nv[i] Do
           Begin
              Write('-Ho ten nhan vien thu: ',i:2,' la= ');
             Readln(HoTen);
             Write('-Tuoi      = ');
             Readln(Tuoi);
             Write('-Bac luong = ');
             Readln(Luong);
          End;
    TuoiMax  := Nv[1].Tuoi;
    TuoiMin  := Nv[1].Tuoi;
    LuongMax := Nv[1].Luong;
    LuongMin := Nv[1].Luong;
    HoTen1   := Nv[1].HoTen;
    HoTen2   := Nv[1].HoTen;
    LuongTb  := Nv[1].Luong;
    For i := 2 To N Do
        Begin
           If Nv[i].Tuoi > TuoiMax Then
              TuoiMax := Nv[i].Tuoi
          Else
              If Nv[i].Tuoi < TuoiMin Then
                 TuoiMin := Nv[i].Tuoi;
          If Nv[i].Luong > LuongMax Then
              Begin
                 LuongMax := Nv[i].Luong;
                HoTen1 := Nv[i].HoTen;
             End
          Else
              If Nv[i].Luong < LuongMin Then
                 Begin
                    LuongMin := Nv[i].Luong;
                   HoTen2 := Nv[i].HoTen;
                End;
          LuongTb := LuongTb + Nv[i].Luong;
       End;
    Writeln;
    Writeln('+Nhan vien co tuoi lon nhat la: ',TuoiMax);
     Writeln('+Nhan vien co tuoi nho nhat la: ',TuoiMin);
    Writeln('+Nhan vien: ',HoTen1,' co bac luong lon nhat: ',LuongMax:10:2);
     Writeln('+Nhan vien: ',HoTen2,' co bac luong nho nhat: ',LuongMin:10:2);
    Writeln('+Bac luong trung binh cua toan Cong Ty      : ',LuongTb/n:10:2);
    Readln
 End.
64/Quản lí sách của thư viện:
Code:
Program Thu_vien;
 CONST
      Max = 100;
 TYPE
     ThuVien = RECORD
        TenSach : String[30];
       TacGia  : String[24];
       NamXb   : 1900..1999;
       NguoiMuon : String[24];
    End;
 VAR
     Sach    : Array[1..Max] Of ThuVien;
    i, n, x : Integer;
 Begin
     Writeln('QUAN LY SACH CUA THU VIEN');
    Writeln('-------------------------');
    Write('-So luong sach: ');
    Readln(n);
    For i := 1 To N Do
        With Sach[i] Do
           Begin
              Write('+Ten sach : ');
             Readln(TenSach);
             Write('+Tac gia : ');
             Readln(TacGia);
             Write('+Nam Xuat ban : ');
             Readln(NamXb);
             Write('+Nguoi muon (Neu khong co ai muon thi bam <Enter>: ');
             Readln(NguoiMuon);
          End;
     Writeln;
    x := 0;
    For i := 1 To N Do
         With Sach[i] Do
           Begin
              Writeln('-Ten sach: ',TenSach);
             Writeln(' +Tac gia        : ',TacGia);
             Writeln(' +Nam xuat ban    : ',NamXb);
             If NguoiMuon <> ' ' Then
                 Begin
                    Writeln(' +Nguoi muon    : ',NguoiMuon);
                   x := x + 1;
                End;
          End;
    Writeln;
    Writeln('+So sach da cho muon: ',x,' quyen');
    Readln
 End.
65/Sắp xếp điểm tăng dần:
Code:
Program Sap_Xep_Diem_Tang;
 TYPE
     Lop = RECORD
        HoTen     : String[24];
       NamSinh     : Integer;
       DiemTb      : Real;
    End;
 VAR
     Hs     : Array[1..50] Of lop;
    i,j,n : Integer;
    Tam   : Lop;
 Begin
     Writeln('SAP XEP DIEM TANG DAN);');
    Writeln('Giai thuat noi Buble');
    Writeln('--------------------');
    Writeln;
    Write('-So hoc sinh: ');
    Readln(n);
    For i := 1 To N Do
        With Hs[i] Do
           Begin
              Write('+Ho ten hoc sinh thu: ',i:2,' la: ');
             Readln(Hoten);
             Write('+Nam sinh: ');
             Readln(NamSinh);
             Write('+Diem trung binh: ');
             Readln(DiemTb);
          End;
    For i := 1 To N-1 Do
        For j := 1 To N-i Do
           If Hs[j].DiemTb > Hs[j+1].DiemTb Then
              Begin
                Tam := Hs[j];
                Hs[j] := Hs[j+1];
                Hs[j+1] := Tam;
             End;
    Writeln;
    Writeln('        DANH SACH SAP XEP');
    Writeln;
    For i := 1 To N Do
        With Hs[i] Do
           Writeln('-',HoTen:24,' :',Namsinh:4,' , ',DiemTb:5:2);
     Readln
 End.
66/Tính điểm và xếp hạng:
Code:
Program Tinh_Diem_Xep_Hang;
 TYPE
     Lop = RECORD
        HoTen         : String[24];
       NamSinh         : Integer;
       Tb1,Tb2,Tb     : Real;
    End;
 VAR
     Hs             : Array[1..50] Of lop;
    i,j,n,Hang: Integer;
    Tam           : Lop;
 Begin
     Writeln('TINH DIEM VA XEP HANG);');
    Writeln('Giai thuat noi Buble');
    Writeln('--------------------');
    Writeln;
    Write('-So hoc sinh: ');
    Readln(n);
    For i := 1 To N Do
        With Hs[i] Do
           Begin
              Write(' +Ho ten hoc sinh thu: ',i:2,' la: ');
             Readln(Hoten);
             Write(' +Nam sinh: ');
             Readln(NamSinh);
             Write(' +Diem trung binh hoc ky 1: ');
             Readln(Tb1);
             Write(' +Diem trung binh hoc ky 2: ');
             Readln(Tb2);
             Tb :=(Tb1 + Tb2)/2;
             Writeln;
          End;
    For i := 1 To N-1 Do
        For j := 1 To N-i Do
           If Hs[j].Tb < Hs[j+1].Tb Then
              Begin
                Tam := Hs[j];
                Hs[j] := Hs[j+1];
                Hs[j+1] := Tam;
             End;
    Writeln;
    Writeln('        DANH SACH XEP HANG');
    Writeln;
    Hang := 1;
    For i := 1 To N Do
        Begin
           If (i > 1) And (Hs[i].Tb <> Hs[i-1].Tb) Then
              Hang := i;
          Writeln('    .Hoc sinh : ',Hs[i].HoTen);
          Writeln('    .Nam sinh : ',Hs[i].NamSinh);
          Writeln('    .Diem trung binh ca nam : ',Hs[i].Tb:5:2);
          Writeln('    .Xep hang ca nam        : ',Hang);
       End;
     Readln
 End.
67/Khảo sát 2 đường tròn:
Code:
Program Khao_Sat_Hai_Duong_Tron;
 TYPE
     DuongTron = RECORD
        R       : Real;
       x, y : Real;
    End;
 VAR
     Dt1, Dt2 : DuongTron;
    Kc, Tong, Hieu : Real;
 
 BEGIN
     Writeln('KHAO SAT 2 DUONG TRON');
    Writeln('---------------------');
    Writeln;
    Writeln('*Duong tron thu nhat');
    Write('    +Ban kinh: ');
    Readln(Dt1.R);
    Write('    +Toa do x: ');
    Readln(Dt1.x);
    Write('    +Toa do y: ');
    Readln(Dt1.y);
    writeln;
    Writeln('*Duong tron thu hai');
    Write('    +Ban kinh: ');
    Readln(Dt2.R);
    Write('    +Toa do x: ');
    Readln(Dt2.x);
    Write('    +Toa do y: ');
    Readln(Dt2.y);
 
    Kc := Sqrt(Sqr(Dt1.x - Dt2.x) + Sqr(Dt1.y - Dt2.y));
    Tong := Dt1.R + Dt2.R;
    Hieu := ABS(Dt1.R - Dt2.R);
    If (Kc = 0) AND (Hieu = 0) Then
        Writeln('-Hai duong tron trung nhau')
    Else
        If (Hieu > Kc) Then
           Writeln('-Hai duong tron long nhau')
         Else
           If (Tong = Kc) OR (Hieu = Kc) Then
              Writeln('-Hai duong tron tiep xuc nhau')
          Else
              If (Tong > Kc) AND (Hieu < Kc) Then
                 Writeln('-Hai duong tron cat nhau')
             Else
                 If (Tong < Kc) Then
                    Writeln('-Hai duong tron o ngoai nhau');
    Readln
 END.
68/Điểm thi:
Code:
Program Diem_Thi;
 CONST
     Max = 50;
    Td1 = '|========================|======|======|======|';
    Td2 = '|       HO VA TEN        | DIEM |  TL1 |  TL2 |';
    Td3 = '|------------------------|------|------|------|';
    Td4 = '|---------------------------------------------|';
 
 TYPE
     DiemThi = RECORD
        HoTen  : String[24];
       Diem1  : Real;
       Case ThiLai1 : Boolean Of
             True : (Diem2 : Real;
                      Case ThiLai2 : Boolean Of
                          True : (Diem3 : Real));
         End;
 VAR
     Diem : Array[1..Max] Of DiemThi;
     n, i : 1..Max;
 BEGIN
     Writeln('-So luong sinh vien: ');
    Readln(n);
    For i := 1 To N Do
        With Diem[i] do
           Begin
              Write('+Ho va ten sinh vien thu: ',i,' = ');
             Readln(HoTen);
             Write('+Diem thi : ');
             Readln(Diem1);
             If Diem1 < 5 Then
                 Begin
                    ThiLai1 := True;
                   Write('    -Diem thi lai lan 1= ');
                   Readln(Diem2);
                   If Diem2 < 5 Then
                       Begin
                          ThiLai2 := True;
                         Write('    -Diem thi lai lan 2= ');
                         Readln(Diem3);
                      End;
                End;
          End;
    Writeln(#32:34,'KET QUA HOC TAP');
    Writeln(#32:20,Td1);
    Writeln(#32:20,Td2);
    Writeln(#32:20,Td3);
    For i := 1 To N Do
        With Diem[i] Do
           Begin
              Write(#32:20);
             Write(#124,HoTen,#32:24-length(HoTen));
             Write(#124,Diem1:6:1);
             If Diem1 < 5 Then
                 Begin
                    Write(#124,Diem2:6:1);
                   If Diem2 < 5 Then
                       Writeln(#124,Diem3:6:1,#124)
                   Else
                       Writeln(#124,#32:6,#124);
                End
             Else
                 Writeln(#124,#32 :6, #124, #32 :6, #124);
          End;
    Writeln(#32:20,Td4);
    Readln
 END.
69/Tính đa thức:
Code:
Program Da_Thuc;
 CONST
     MaxOrder = 10;
 TYPE
     PolyNom = RECORD
        Bac : Integer;
       HeSo : Array[0..MaxOrder] Of Real;
    End;
 VAR
     A,B,C : Polynom;
    i     : Integer;
 {-------------------------}
 Procedure Nhap;
 Var
     i : Integer;
 Begin
     Repeat
        Writeln;
       Writeln('Hay nhap 2 da thu A(x), B(x) voi');
       Write('-Bac A (phai <= ',MaxOrder,' ) = ');
       Readln(A.Bac);
       If A.Bac > MaxOrder Then
           Writeln(#7,'Bac A phai <= ',MaxOrder,' ! nhap lai ');
       Write('-Bac B (phai <= ',MaxOrder,' ) = ');
       Readln(B.Bac);
       If B.Bac > MaxOrder Then
           Writeln(#7,'Bac B phai <= ',MaxOrder,' ! nhap lai ');
    Until (A.Bac <= MaxOrder) And (B.Bac <= MaxOrder);
    For i := 0 To MaxOrder Do
        Begin
           A.Heso[i] :=0;
          B.Heso[i] :=0;
       End;
    Writeln;
    Writeln('Nhap ca he so cua da thuc A: ');
    For i := A.Bac DownTo 0 Do
        Begin
           Write('    A[',i,'] = ');
          Readln(A.heso[i]);
       End;
    Writeln;
    Writeln('Nhap ca he so cua da thuc B: ');
    For i := B.Bac DownTo 0 Do
        Begin
           Write('    B[',i,'] = ');
          Readln(B.heso[i]);
       End;
 End;
 
 {-------------------------}
 Procedure Cong(A,B : Polynom; Var C : Polynom);
 Var
     BacMax :Integer;
 Begin
     If A.Bac < B.Bac Then
        Begin
           C.Bac :=B.Bac;
          For i := A.Bac + 1 To B.Bac Do
              A.Heso[i] := 0
       End
    Else
        Begin
           C.Bac := A.Bac;
          For i := B.Bac + 1 To A.Bac Do
              B.Heso[i] := 0
       End;
    C.Bac :=A.Bac;
    For i := C.Bac To MaxOrder Do
        C.Heso[i] := 0;
    For i := 0 To C.Bac Do
        C.Heso[i] := A.Heso[i] + B.Heso[i];
 End;
 
 {-------------------------}
 Procedure Nhan(A,B : Polynom; Var C:Polynom);
 Var
     i,j : Integer;
 Begin
     For i := 0 To MaxOrder Do
        C.Heso[i] := 0;
    For i := 0 To A.Bac Do
        For j := 0 To B.Bac Do
           C.Heso[i+j] := C.Heso[i+j] + A.Heso[i] * B.Heso[j];
    C.Bac :=A.Bac + B.Bac;
 End;
 
 {-------------------------}
 procedure Chia(P, Q :Polynom);
 Var
     i,k,kk : Integer;
    G : Polynom;
 Begin
     If P.Bac < Q.Bac Then
        For i := P.Bac + 1 To Q.Bac Do
           P.Heso[i] := 0;
    If P.Bac > Q.Bac Then
        For i := Q.Bac + 1 To P.Bac Do
           Q.Heso[i] := 0;
    Write('-Hay cho he so trong ket qua phep chia: ');
    Readln(kk);
    Writeln('Da thuc ket qua xep theo so mu giam dan. ');
    Writeln;
    Write('Bac: ');
    For k := 0 To kk Do
        Write(P.Bac-Q.Bac-k:6);
    Writeln;
    Write('He so ');
    For k := 0 To kk Do
        Begin
           G.Heso[k] := P.Heso[P.bac] / Q.Heso[Q.Bac];
          If Frac(G.Heso[k]) =0 Then
                 Write(G.Heso[k]:6:0)
             Else
                 Write(G.Heso[k]:6:0);
             For i:= Q.Bac DownTo 1 Do
                 P.Heso[P.Bac-Q.Bac+i] := P.Heso[P.Bac+i-1] - G.Heso[k]*Q.Heso[i-1];
          For i := P.Bac-Q.bac Downto 0 Do
              P.Heso[i] :=0;
       End;
 End;
 
 {--------------------------}
 BEGIN
     Nhap;
    Nhan(A,B,C);
    Writeln;
    Writeln('Cac he so cua da thuc tich: ');
    Write('Bac: ');
    For i := 0 To C.Bac Do
    Write(i:7);
    Writeln;
    Write('He so: ');
    For i := 0 To C.Bac Do
        If Frac(C.Heso[i]) = 0 Then
           Write(C.Heso[i]:7:0)
       Else
           Write(C.Heso[i]:7:0);
    Writeln;
    Writeln;
    Chia(A,B);
    Readln
 END.
70/Tạo biến động và theo dỏi kích thước bộ nhớ:
Code:
Program Tao_Bien_Dong;
 TYPE
     Str10 = String[10];
    PStr  = ^Str10;
 VAR
     Newp  : PStr;
    i     : Integer;
 Begin
     Writeln('TAO BIEN DONG VA THEO DOI KICH THUOC BO NHO');
    Writeln('-------------------------------------------');
    Writeln;
    Writeln('-Bo nho ban dau la: ',MemAvail,' bytes');
    Writeln;
    For i := 1 To 10 Do
        Begin
           New(Newp);
          Writeln('    +Sau khi tao bien thu: ',i:2,' bo nho con lai la: ',MemAvail,' bytes');
       End;
    Writeln;
    Writeln('-Bo nho bay gio la : ',MemAvail,' bytes');
    Writeln;
    Writeln(' Bam <Enter> de ket thuc');
    Readln
 End.
71/Tạo và xóa các biến động:
Code:
Program Tao_Bien_Dong;
 TYPE
     ConTro = ^BanGhi;
    BanGhi = RECORD
        HoTen  : String[24];
       Tuoi   : Byte;
       DiaChi : String[30];
       Next   : ConTro;
    End;
 VAR
     Newp    : ConTro;
    HeapTop : Pointer;
    i       : Integer;
 Begin
     Writeln('TAO VA XOA CAC BIEN DONG');
    Writeln('------------------------');
    Writeln;
    Writeln('-Bo nho ban dau la: ',MemAvail,' bytes');
    Mark(HeapTop);
    Writeln('-Kich thuoc cua ban ghi la: ',Sizeof(BanGhi),' bytes');
    For i := 1 To 10 Do
        Begin
           New(Newp);
          Writeln('    +Sau khi tao bien thu: ',i:2,' bo nho con lai: ',MemAvail,' Bytes');
       End;
    Writeln;
    Writeln('-Bo nho bay gio la: ',MemAvail,' bytes');
    Writeln;
    Writeln('    Bam <Enter> de xoa cac bien dong');
    Readln;
    Release(HeapTop);
    Writeln;
    Writeln('-Bo nho bay gio lai la: ',MemAvail,' bytes');
    Writeln;
    Writeln('    Bam <Enter> de ket thuc');
    Readln
 End.
72/Tạo biến động tại địa chỉ cho trước:
Code:
Program Tao_Con_Tro;
 VAR
     ConTro : ^String;
 Begin
     Writeln('TAO BIEN DONG TAI DIA CHI CHO TRUOC');
    Writeln('-----------------------------------');
    Writeln;
    ConTro :=Ptr($B800,$0004);
    ConTro^ := 'Turbo Pascal';
    Writeln('-Du lieu cua bien ma con tro dang tro toi la: ',ConTro^);
    Writeln;
    Write('    Bam <Enter> de ket thuc');
    Readln
 End.
73/Tính điểm trung bình của lớp:
Code:
Program Tinh_Diem;
 TYPE
     ConTro = ^BanGhi;
     BanGhi = RECORD
         HoTen   : String[24];
         Tuoi    : Byte;
         Diem    : Real;
     End;
 VAR
     Newp       : ConTro;
     i,n            : Integer;
    d,tong,tb  :Real;
 Begin
     Writeln('TINH DIEM TRUNG BINH CUA LOP');
    Writeln('----------------------------');
    Writeln;
    Tong := 0.0;
    Write('-Lop co bao nhieu nguoi: ');
    Readln(n);
    Writeln;
    For i := 1 To N Do
        Begin
           New(Newp);
          With Newp^ Do
              Begin
                   Write('    +Ho ten nguoi thu: ',i:2,' la: ');
                  Readln(HoTen);
                  Write('    +Tuoi : ');
                  Readln(Tuoi);
                  Write('    +Diem : ');
                  Readln(Diem);
                d := Diem;
                  Tong :=Tong + d;
             End;
           Tb := tong / n;
       End;
    Writeln('-Diem trung binh cua lop la: ',Tb:5:2);
    Readln
 End.
74/Thay câu:
Code:
Program Dong;
 Uses Crt;
 CONST
     Max = 100;
 TYPE
     Str = String[255];
    Mang  = Array[1..Max] Of Str;
 VAR
     Cau,Cau1,Cu,Moi : Str;
    T : Mang;
    i,SoT,Chon : Integer;
 {---------------------------------------}
     Procedure Tach(Var S : Str; Var T : Mang; Var SoT : Integer);
    Var
        i,j,k,l : Integer;
     Begin
        k := 1;
       i := 1;
       l := Length(S);
       While ( i <= l) Do
           Begin
              While (S[i] = ' ') And (i <= L) Do
                 i := I +1;
             j := 1;
             While (S[i] <> ' ') And (i <= l) Do
                 Begin
                    T[k][j] := S[i];
                   j := j +1;
                   i := i +1;
                End;
                T[k][0] := Chr(j-1);
                k := k + 1;
          End;
          SoT := k - 1;
     End;
 {---------------------------------------}
     Procedure Nen(Var S : Str);
    Var
        i,j,l,z,xoa : Integer;
    Begin
        i := 1;
       j := 1;
       l := Length(S);
       Xoa := 0;
       While i <= l Do
           Begin
              z := i;
             While (S[i] = ' ') And ( i <= l) Do
                 i := i + 1;
             Xoa := Xoa +i - z;
             While (S[i] <>' ') And ( i <= l ) Do
                 Begin
                    S[j] := S[i];
                   i := i + 1;
                   j := j + 1;
                End;
          End;
          S[0] := Chr(l - Xoa);
    End;
 {---------------------------------------}
     Procedure Nen2(Var S : Str);
    Var
        i,j,l,z : Integer;
    Begin
        i := 1;
       l := Length(S);
       While i <= l Do
           Begin
             While (S[i] = ' ') And ( i <= l) Do
                 i := i + 1;
             z := i;
             While (S[i] =' ') And ( i <= l ) Do
                 i := i + 1;
             Delete(S,z,i-z);
             i := z;
           End;
    End;
 
 {---------------------------------------}
    Procedure Thay(Var S : Str; Sold, Snew : Str);
    Var
        Lo,Ln,LDu,p : Integer;
       St,Sdu : Str;
    Begin
        Lo := Length(Sold);
       Ln := Length(Snew);
       St :=' ';
       Sdu := S;
       P := Pos(Sold,Sdu);
       While P <> 0 Do
           Begin
              Ldu :=Length(Sdu);
                St := St + Copy(Sdu,1,P-1) + Snew;
               Delete(Sdu,1,P-1+Lo);
               P := Pos(Sold, Sdu);
            End;
        S := St + Sdu;
    End;
 {---------------------------------------}
 BEGIN
     ClrScr;
     Write('Nhap Cau : ');
    Readln(Cau);
    While Cau <> ' ' do
        Begin
           Writeln('    1.Tach cau');
          Writeln('    2.Nen cau');
          Writeln('    3.Thay the');
          Writeln('    0.Ket thuc');
          Writeln;
          Write(' Chon : ');
          Readln(Chon);
          Case Chon Of
              1 : Begin
                     Tach(Cau,T, SoT);
                   For i := 1 To SoT Do
                       Writeln(T[i]);
                  End;
             2 : Begin
                     Cau1 := Cau;
                   Nen(Cau1);
                   Writeln(Cau1);
                      End;
             3 : Begin
                     Cau1 :=Cau;
                   Repeat
                       Write('+Muon thay: ');
                      Readln(Cu);
                   Until Cu <> ' ';
                   Write('+ Bang : ');
                   Readln(Moi);
                   Thay(Cau1,Cu,Moi);
                   Writeln(Cau1);
                  End;
             0 : Exit;
          End;
       End;
 END.
75/Hoán vị chuổi:
Code:
Program Hoan_Vi_Chuoi;
 Uses Crt;
 VAR
     Chuoi1,Chuoi2,Tam :^String;
 Begin
     ClrScr;
    Writeln('HOAN VI 2 CON TRO THAY CHO HOAN VI NOI DUNG');
    Writeln('-------------------------------------------');
    Writeln;
    New(Chuoi1);
    New(Chuoi2);
    Chuoi1^ := 'Giao trinh Turbo Pascal 7.0';
    Chuoi2^ := 'Giao trinh FoxPro 2.6';
    Writeln;
    Writeln('NOI DUNG BAN DAU CUA 2 CHUOI');
    Writeln('----------------------------');
    Writeln;
    Writeln('-Chuoi thu nhat: ',Chuoi1^);
    Writeln('-Chuoi thu hai : ',Chuoi2^);
    Writeln;
    Writeln('NOI DUNG SAU KHI HOAN VI 2 CON TRO');
    Writeln('----------------------------------');
    Writeln;
    Tam := Chuoi1;
    Chuoi1 := Chuoi2;
    Chuoi2 := Tam;
    Writeln('-Chuoi thu nhat: ',Chuoi1^);
    Writeln('-Chuoi thu hai : ',Chuoi2^);
    Dispose(Chuoi1);
    Dispose(Chuoi2);
    Writeln;
    Write('     Bam <Enter> . . . ');
    Readln;
 End.
76/Số ngẫu nhiên:
Code:
Program So_ngau_Nhien;
 Uses Crt;
 CONST
      N = 100;
 VAR
     Mang : Array[1..N] Of ^Word;
    HeapTop : Pointer;
 {-------------------------------}
     Procedure TaoSo;
    Var
        i : Byte;
    Begin
        Randomize;
       For i := 1 To N Do
           Begin
              New(Mang[i]);
             Mang[i]^ := Random(999);
          End;
    End;
 {-------------------------------}
     Procedure SapXep;
    Var
        i : Byte;
       Tam : Word;
       KetThuc : Boolean;
    Begin
        Repeat
           KetThuc := True;
          For i := 1 To n-1 Do
              If Mang[i]^ > Mang[i+1]^ Then
                 Begin
                    Tam := Mang[i]^;
                   Mang[i]^ := Mang[i+1]^;
                   Mang[i+1]^ := Tam;
                   KetThuc := False;
                End;
       Until ketThuc;
    End;
 {-------------------------------}
     Procedure InKq;
    Var
        i :Byte;
    Begin
        For i := 1 To N Do
           Write(Mang[i]^:4);
    End;
 {-------------------------------}
 BEGIN
     ClrScr;
    Writeln('           TAO VA SAP XEP THU TU 100 SO NGAU NHIEN');
    Writeln('            ---------------------------------------');
    Writeln;
     Mark(HeapTop);
    TaoSo;
    SapXep;
    Inkq;
    Writeln;
    Write('           Bam <Enter> . . . ');
    Readln;
    Release(HeapTop);
 END.
77/Mãng biến động:
Code:
Program Mang_Bien_Dong;
 Uses Crt;
 TYPE
     ConTro = ^BanGhi;
    BanGhi = RECORD
        HoTen : String[24];
       Next  : ConTro;
       End;
 VAR
     First, Last, P : ConTro;
    HeapTop : Pointer;
    i : Byte;
    Ch : Char;
 {-------------------------------}
     Procedure KhoiTao;
    Begin
        First := Nil;
       Mark(HeapTop);
       i := 0;
       Writeln('NHAP DU LIEU');
       Writeln('Khong nhap nua thi bam <Enter> ...');
       Repeat
           Inc(i);
          New(P);
          Write('-Ho ten nguoi thu: ',i:2,' : ');
          Readln(P^.HoTen);
          If First = Nil Then
              First := P
          Else
              Last^.Next := P;
          Last := P;
          Last^.Next := Nil;
       Until P^.HoTen = ''
    End;
 {-------------------------------}
     Procedure LietKe;
    Var
        Q : ConTro;
    Begin
        Q := First;
       i := 0;
       While Q <> Nil Do
           Begin
              Inc(i);
             Writeln(i:2,' >..: ',Q^.HoTen:-24);
             Q := Q^.Next;
          End;
    End;
 {-------------------------------}
     Procedure Xoa(N : Byte);
    Var
        k : Byte;
       Q : ConTro;
    Begin
        If N = 1 Then
           First := First^.Next
       Else
           Begin
              Q := First;
             For k := 1 To N-2 Do
                 Q := Q^.Next;
                Q^.Next := Q^.Next^.Next;
          End;
    End;
 {-------------------------------}
     Procedure Chen(N : Byte);
    Var
        k : Byte;
       Q : ConTro;
    Begin
        If N <= 0 Then
           Exit;
          New(P);
          Write('-Ho Ten muon chen: ');
          Readln(P^.HoTen);
          If N = 1 Then
              Begin
                 P^.Next := First;
                First := P;
             End
          Else
              Begin
                 Q := First;
                For k := 1 To N-2 Do
                Q := Q^.Next;
                P^.Next := Q^.Next;
                Q^.Next := P;
             End;
    End;
 {-------------------------------}
 BEGIN
     ClrScr;
     Writeln('Bo nho hien gio la: ',MemAvail);
    KhoiTao;
    Writeln;
    Write(' Bam <Enter> de xem danh sach ... ');
    Readln;
    LietKe;
    Writeln;
    Writeln('Bo nho hien gio la: ',MemAvail);
    Write(' Bam <Enter> de xoa danh sach ... ');
    Readln;
    Repeat
        Write('-Muon xoa ban ghi thu: ');
        Readln(i);
        Xoa(i);
        LietKe;
       Write('+Co xoa nua khong ?(c/k) ');
       Readln(Ch);
    Until UpCase(Ch) = 'K';
    Writeln;
    Repeat
        Write('-Muon chen ban ghi thu: ');
        Readln(i);
        Chen(i);
        LietKe;
       Write('+Co chen nua khong ?(c/k) ');
       Readln(Ch);
    Until UpCase(Ch) = 'K';
    Release(HeapTop);
    Writeln;
    Writeln('Bo nho hien gio la: ',MemAvail);
    Writeln;
    Write('    Bam <Enter> . . . ');
    Readln
 END.
78/Tạo danh sách:
Code:
Program Tao_Danh_Sach;
 Uses Crt;
 TYPE
     ConTro = ^DanhSach;
    DanhSach = RECORD
        So : Word;
       Next : ConTro;
       End;
 
 VAR
     First,P,Tam : ConTro;
 {----------------------------------}
     Procedure KhoiDong;
    Begin
        First := Nil;
    End;
 {----------------------------------}
     Procedure Nhap;
    Var
        i : Word;
    Begin
        Writeln('NHAP CAC SO');
       Writeln('Neu khong nhap, go so 0');
       i :=0;
       Repeat
           New(Tam);
          Inc(i);
          Write('-Nhap so thu: ',i:2,' = ');
          Readln(Tam^.So);
          Tam^.Next := Nil;
          If Tam^.So <> 0 Then
              If First = Nil Then
                 Begin
                    First := Tam;
                   P := Tam;
                End
             Else
                 Begin
                    P^.Next := Tam;
                   P := Tam;
                End;
       Until Tam^.So =0;
    End;
 {----------------------------------}
     Procedure LietKe;
    Begin
        Writeln('CAC SO DA NHAP');
       Writeln('--------------');
       Writeln;
       P := First;
       While P <> Nil Do
           Begin
              Write(P^.So:8);
             P := P^.Next;
          End;
    End;
 {----------------------------------}
     Procedure KetThuc;
    Begin
        If First <> Nil Then
           Release(First);
    End;
 {----------------------------------}
 BEGIN
     ClrScr;
    Writeln('TAO DANH SACH CAC SO NGUYEN');
    Writeln('---------------------------');
    Writeln;
     KhoiDong;
    Nhap;
    LietKe;
    KetThuc;
    Writeln;
    Write('    Bam <Enter> . . . ');
    Readln;
 END.
79/Chèn số:
Code:
Program Chen_So;
 Uses Crt;
 CONST
     N = 10;
 TYPE
    ConTro = ^BanGhi;
    BanGhi = RECORD
        So : Word;
       Next : ConTro;
       End;
    ViTri = 1..n;
 VAR
     First,P,Tam : ConTro;
    V : ViTri;
 {----------------------------------}
     Procedure KhoiDong;
    Begin
        First := Nil;
    End;
 {----------------------------------}
     Procedure TaoSo;
    Var
        i : Byte;
    Begin
        Randomize;
       For i := 1 To n Do
           Begin
              New(Tam);
             Tam^.So := Random($FFFF);
             Tam^.Next := Nil;
             If i = 1 Then
                 Begin
                    First := Tam;
                   P := Tam;
                End
             Else
                 Begin
                    P^.Next := Tam;
                   P := Tam;
                End;
          End;
    End;
 {----------------------------------}
     Procedure Nhap;
    Begin
        Repeat
           Writeln;
           Write('                -Cho biet vi tri muon chen: ');
          Readln(v);
       Until (v >= 1) And (v <=n);
       New(Tam);
       Writeln;
       Write('                    -Cho biet gia tri muon chen: ');
       Readln(Tam^.So);
    End;
 {----------------------------------}
     Procedure Chen(v : ViTri);
    Var
        i : Byte;
    Begin
        If v = 1 Then
           Begin
              Tam^.Next := First;
             First := Tam;
          End
       Else
           Begin
              P := First;
             For i := 1 To v-2 Do
                 P := P^.Next;
             Tam^.Next := P^.Next;
                 P^.Next := Tam;
          End;
    End;
 {----------------------------------}
     Procedure LietKe;
    Begin
        P := First;
       While P <> Nil Do
           Begin
              Write(P^.So : 7);
             P := P^.Next;
          End;
    End;
 {----------------------------------}
     Procedure KetThuc;
    Begin
        If First <> Nil Then
           Release(First);
    End;
 {----------------------------------}
 BEGIN
     ClrScr;
    Writeln('              NHAP VA CHEN SO VAO VI TRI CHI DINH');
    Writeln('               -----------------------------------');
    Writeln;
     KhoiDong;
    TaoSo;
    Writeln('                    10 SO TRONG DANH SACH LA: ');
    Writeln;
     LietKe;
    Writeln;
    Nhap;
    Writeln;
    Chen(v);
    Writeln;
    Writeln('                  DANH SACH SAU KHI CHEN');
    Writeln;
    LietKe;
    KetThuc;
    Writeln;
    Writeln;
    Write('                      Bam <Enter>... ');
    Readln
 END.
80/Chèn xóa số:
Code:
Program Chen_Xoa_So;
 Uses Crt;
 CONST
     N = 20;
 TYPE
    ConTro = ^BanGhi;
    BanGhi = RECORD
        So : Word;
       Next : ConTro;
       End;
    ViTri = 1..n;
 VAR
     First,P,Tam : ConTro;
    V : ViTri;
 {----------------------------------}
     Procedure KhoiDong;
    Begin
        First := Nil;
    End;
 {----------------------------------}
     Procedure TaoSo;
    Var
        i : Byte;
    Begin
        Randomize;
       For i := 1 To n Do
           Begin
              New(Tam);
             Tam^.So := Random(10);
             Tam^.Next := Nil;
             If i = 1 Then
                 Begin
                    First := Tam;
                   P := Tam;
                End
             Else
                 Begin
                    P^.Next := Tam;
                   P := Tam;
                End;
          End;
    End;
 {----------------------------------}
     Procedure XoaSo;
        Procedure Xoa5;
 
       Begin
           Tam := P;
          If P = First Then
              Begin
                 First := P^.Next;
                P := P^.Next;
             End
          Else
              Begin
                 P := First;
                While P^.Next <> Tam Do
                    P := P^.Next;
                P^.Next := Tam^.Next;
                P := P^.Next;
             End;
          Dispose(Tam);
       End;
     Begin
         P := First;
       While P <> Nil Do
           Begin
              If P^.So < 5 Then
                 Xoa5
             Else
             P := P^.Next
          End;
     End;
 {----------------------------------}
     Procedure LietKe;
    Begin
        P := First;
       While P <> Nil Do
           Begin
              Write(P^.So : 5);
             P := P^.Next;
          End;
    End;
 {----------------------------------}
     Procedure KetThuc;
    Begin
        If First <> Nil Then
           Release(First);
    End;
 {----------------------------------}
 BEGIN
     ClrScr;
    Writeln('                         XOA CA SO NHO HON 5');
    Writeln('                          -------------------');
     KhoiDong;
    TaoSo;
    Writeln;
    Writeln('                       20 SO TRONG DANH SACH LA: ');
    Writeln;
     LietKe;
    Writeln;
    XoaSo;
    Writeln;
    Writeln('                         DANH SACH CAC SO >= 5');
    Writeln;
    LietKe;
    KetThuc;
    Writeln;
    Writeln;
    Write('                               Bam <Enter>... ');
    Readln
 END.
81/Tạo danh sách chẳn lẻ:
Code:
Program Tach_Danh_Sach_Chan_Le;
Uses Crt;
TYPE
    Mang = Array[1..100] Of Integer;
VAR
    i,j,k,n : Integer;
   a,b,c : Mang;
Begin
    ClrScr;
    Writeln('                     NHAP DANH SACH');
   Writeln('                     --------------');
   Write('-So phan tu: ');
   Readln(n);
   For i := 1 To n Do
       Begin
          Write('-Phan tu thu: ',i:2,' = ');
         Readln(a[i]);
      End;
   Writeln;
   Writeln('                 TACH THANH 2 DANH SACH');
   Writeln('                  ----------------------');
   Writeln;
   j := 1;
   k := 1;
   For i := 1 To n Do
       If  Odd(a[i]) Then
          Begin
             b[j] := a[i];
            j := j + 1;
         End
      Else
          Begin
             c[k] :=a[i];
            k := k + 1;
         End;
   Writeln;
   Writeln('       -Danh sach thu nhat ( so le ) ');
   Writeln;
   For i := 1 To j-1 Do
       Write(b[i],' ');
   Writeln;
   Writeln;
   Writeln('       -Danh sach thu hai ( so chan ) ');
   Writeln;
   For i := 1 To k-1 Do
       Write(c[i],' ');
   Writeln;
   Write('          Bam <Enter> . . . ');
   Readln
End.
82/Xóa giá trị X trong danh sách:
Code:
Program Loai_bo;
Uses Crt;
TYPE
    Mang = array[1..100] Of Integer;
VAR
    i,Na,Nb,x : Integer;
   a: mang;
{--------------------------------------}
    Procedure LoaiBo(x : Integer; Var a:mang; Var Na : Integer);
   Var
       i,j : Integer;
   Begin
       i := 1;
      While i <= Na Do
          If (a[i] <> x) Then
             i := i + 1
         Else
             Begin
                For j := i To Na - 1 Do
                   a[j] := a[j+1];
               Na := Na - 1;
            End;
   End;
{--------------------------------------}
Begin
    ClrScr;
    Writeln('             XOA TRI X TRONG  DANH SACH');
   Writeln('             --------------------------');
   Writeln;
   Write('-So phan tu: ');
   Readln(Na);
   Nb := Na;
   For i := 1 To Na Do
       Begin
          Write('-Phan tu thu: ',i:2,' = ');
         Readln(a[i]);
      End;
   Writeln;
   Write('+Phan tu can loai bo: ');
   Readln(x);
   Loaibo(x,a,Na);
   If Na = Nb Then
       Writeln('Khong tim thay')
   Else
       Writeln('Da loai bo');
   Writeln;
   Writeln('DANH SACH CON LAI');
   Writeln('-----------------');
   Writeln;
   For i := 1 To Na Do
       Write(a[i],' ');
   Writeln;
   Write('     Bam <Enter> . . . ');
   Readln;
End.
83/Đếm số phần tử của danh sách:
Code:
Program Dem_nut;
Uses Crt;
TYPE
    ConTro = ^Nut;
   Nut = RECORD
       So : Integer;
      Next : ConTro;
      End;
VAR
    Nut1,Tam : ConTro;
   Ch       : Char;
{-------------------------------------}
    Function SoNut(Nut1 : ConTro): Integer;
   Var
       sn : Integer;
   Begin
       sn := 0;
      Tam := Nut1;
      While Tam <> Nil Do
          Begin
             sn := sn + 1;
            Tam := Tam^.Next;
         End;
      SoNut :=sn;
   End;
{-------------------------------------}
BEGIN
    ClrScr;
   Writeln(' DEM SO PHAN TU (NUT) CUA DANH SACH');
   Writeln('-----------------------------------');
   Writeln;
   Nut1 := Nil;
   Repeat
       New(Tam);
      Write('-Nhap so: ');
      Readln(Tam^.So);
      Tam^.Next := Nut1;
      Nut1 := Tam;
      Write('    Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch)= 'K';
   Writeln('+So nut cua danh sach: ',Sonut(Nut1));
   Writeln;
   Write('      Bam <Enter> . . . ');
   Readln;
END.
84/Tìm địa chỉ nút cuối:
Code:
Program Dem_Nut_Cuoi;
Uses Crt;
TYPE
    ConTro = ^Nut;
   Nut = RECORD
       So : Integer;
      Next : ConTro;
      End;
VAR
    Nut1,Tam : ConTro;
   Ch       : Char;
{-------------------------------------}
    Function DemNutCuoi(Nut1 : ConTro): ConTro;
   Begin
      Tam := Nut1;
      While Tam^.Next <> Nil Do
          Tam:= Tam^.Next;
      DemNutCuoi := Tam;
   End;
{-------------------------------------}
BEGIN
    ClrScr;
   Writeln('TIM DIA CHI NUT CUOI');
   Writeln('--------------------');
   Writeln;
   Nut1 := Nil;
   Repeat
       New(Tam);
      Write('-Nhap so: ');
      Readln(Tam^.So);
      Tam^.Next := Nut1;
      Nut1 := Tam;
      Write('    Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch)= 'K';
   Writeln('+So o nut cuoi cua danh sach: ',DemNutCuoi(Nut1)^.So);
   Writeln;
   Write('       Bam <Enter> . . . ');
   Readln;
END.
85/Tính trị trung bình cộng:
Code:
Program Trung_Binh;
Uses Crt;
TYPE
    ConTro = ^Nut;
   Nut = RECORD
       So : Integer;
      Next : ConTro;
      End;
VAR
    Nut1,Tam : ConTro;
   Ch       : Char;
{-------------------------------------}
    Function Tbc(Nut1 : ConTro): Real;
   Var
       Tong,SoNut : Integer;
   Begin
       Tong := 0;
      SoNut := 0;
      Tam := Nut1;
      While Tam <> Nil Do
          Begin
              SoNut := SoNut + 1;
              Tong := Tong + Tam^.So;
            Tam := Tam^.Next;
         End;
      Tbc := Tong / SoNut;
   End;
{-------------------------------------}
BEGIN
    ClrScr;
   Writeln('                TINH TRI TRUNG BINH CONG');
   Writeln('                ------------------------');
   Nut1 := Nil;
   Repeat
       New(Tam);
      Write('-Nhap so: ');
      Readln(Tam^.So);
      Tam^.Next := Nut1;
      Nut1 := Tam;
      Write('    Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch)= 'K';
   Writeln('+Trung binh cong cua danh sach: ',Tbc(Nut1):6:1);
   Writeln;
   Write('         Bam <Enter> . . . ');
   Readln;
END.
86/Chèn và Xóa:
Code:
Program Chen_Xoa;
Uses Crt;
TYPE
    ConTro = ^Nut;
   Nut = RECORD
       So : Integer;
      Next : ConTro;
      End;
VAR
    Nut1,Tam : ConTro;
   So1 : Integer;
   Ch       : Char;
{-------------------------------------}
    Procedure Chen(Var Nut1 : ConTro; So1 : Integer);
   Begin
       New(Tam);
      Tam^.So :=So1;
      Tam^.Next := Nut1;
      Nut1 := Tam;
      Writeln('Da chen xong, bam <Enter> ... ');
      Readln
   End;
{-------------------------------------}
    Procedure Xoa(Var Nut1 : ConTro; So1 : Integer);
   Var
       NutTruoc : ConTro;
      TimThay : Boolean;
   Begin
      Tam := Nut1;
      NutTruoc := Nil;
      TimThay := False;
      While (Tam <> Nil) And (Not TimThay) Do
          If Tam^.So = So1 Then
             TimThay := True
         Else
             Begin
                NutTruoc := Tam;
               Tam := Tam^.Next;
            End;
         If TimThay Then
             Begin
                If NutTruoc = Nil Then
                   Nut1 := Tam^.Next
               Else
                   NutTruoc^.Next := Tam^.Next;
               Dispose(Tam);
               Write(' Da xoa xong, bam <Enter> ... ');
               Readln
            End
         Else
             Begin
                Write(' Khong tim thay, bam <Enter> ... ');
               Readln
            End;
   End;
{-------------------------------------}
   Procedure Xem(Var Nut1 : ConTro);
   Begin
       Tam := Nut1;
      While Tam <> Nil Do
      Begin
           Write(Tam^.So : 6);
          Tam := Tam^.Next;
       End;
      Writeln;
      Write('    Xem xong, bam <Enter> . . .');
      Readln
   End;
{-------------------------------------}
BEGIN
    ClrScr;
   Writeln('         NHAP, CHEN, XEM, XOA SO NGUYEN');
   Writeln('         ------------------------------');
   Writeln;
   Nut1 := Nil;
   Repeat
       New(Tam);
      Write('-Nhap so: ');
      Readln(Tam^.So);
      Tam^.Next := Nut1;
      Nut1 := Tam;
      Write('    Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch)= 'K';
   Repeat
       ClrScr;
      Repeat
          Writeln;
         Writeln('CHON CHUC NANG');
         Writeln('--------------');
          Writeln('1-Chen ');
         Writeln('2-Xoa ');
         Writeln('3-Xem ');
         Writeln('4-Ket thuc ');
         Ch := Readkey;
      Until Ch in ['1'..'4'];
          Case Ch Of
              '1'    : Begin
                             Write('-So muon chen: ');
                         Readln(So1);
                         Chen(Nut1,So1);
                     End;
             '2'    : Begin
                             Write('-So muon xoa: ');
                         Readln(So1);
                         Xoa(Nut1,So1);
                    End;
             '3'    : Begin
                         Xem(Nut1);
                     End;
         End;
    Until Ch = '4';
END.
87/Đảo ngược danh sách:
Code:
Program Dao_Danh_Sach;
Uses Crt;
TYPE
    ConTro = ^Nut;
   Nut = RECORD
       So : Integer;
      Next : ConTro;
      End;
VAR
    Nut1,Tam1,Tam2 : ConTro;
   Ch       : Char;
BEGIN
    ClrScr;
    Writeln('                DAO NGUOC DANH SACH');
   Writeln('                -------------------');
   Nut1 := Nil;
   Repeat
       New(Tam1);
      Write('-Nhap so: ');
      Readln(Tam1^.So);
      Tam1^.Next := Nut1;
      Nut1 := Tam1;
      Write('    Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch)= 'K';
    Tam1 := Nut1;
   Nut1 := Nil;
   Repeat
       Tam2 := Tam1^.Next;
      Tam1^.Next := Nut1;
      Nut1 := Tam1;
      Tam1 := Tam2;
   Until Tam1 = Nil;
   Writeln('Sau khi dao: ');
   Tam1 := Nut1;
   While Tam1 <> Nil Do
       Begin
          Write(Tam1^.So:6);
         Tam1 := Tam1^.Next;
      End;
   Writeln;
   Write('     Bam <Enter> . . . ');
   Readln
END.
88/Ghép chuỗi:
Code:
Program Ghep_Chuoi;
Uses Crt;
TYPE
    ConTro = ^Nut;
   Nut = RECORD
       Kt   : Char;
      Next : ConTro;
      End;
VAR
    Dau1,Cuoi1 : ConTro;
   Dau2,Cuoi2 : ConTro;
   Tam        : ConTro;
   Ch         : Char;
   i          : Integer;
BEGIN
    ClrScr;
   Writeln('CHUOI THU NHAT');
   Writeln('--------------');
   Writeln;
   i := 0;
   Repeat
       i := i + 1;
      New(Tam);
      Write('-Ky tu thu: ',i:2,' : ');
      Readln(Tam^.Kt);
      If i = 1 Then
          Begin
             Dau1 := Tam;
            Cuoi1 := Tam;
         End
      Else
          Begin
             Cuoi1^.Next := Tam;
            Cuoi1 := Tam;
         End;
      Write('Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch) = 'K';
   ClrScr;
   Writeln('CHUOI THU HAI');
   Writeln('--------------');
   Writeln;
   i := 0;
   Repeat
       i := i + 1;
      New(Tam);
      Write('-Ky tu thu: ',i:2,' : ');
      Readln(Tam^.Kt);
      If i = 1 Then
          Begin
             Dau2  := Tam;
            Cuoi2 := Tam;
         End
      Else
          Begin
             Cuoi2^.Next := Tam;
            Cuoi2 := Tam;
         End;
      Write('Nhap nua khong ? (c/k) ');
      Readln(Ch);
   Until UpCase(Ch) = 'K';
   Cuoi1^.Next := Dau2;
   Cuoi2^.Next :=Nil;
   Writeln;
   Writeln(' KET QUA');
   Writeln('---------');
   Tam := Dau1;
   While Tam <> Nil Do
       Begin
          Write(Tam^.Kt);
         Tam := Tam^.Next;
      End;
   Writeln;
   Write('     Bam <Enter> . . . ');
   Readln
END.
89/Mảng con trỏ 2 chiều:
Code:
Program Mang_Con_Tro_Hai_Chieu;
Uses Crt;
TYPE
    ConTro = ^BanGhi;
   BanGhi = RECORD
       HoTen : String[24];
      Pre, Next : ConTro;
      End;

VAR
    First,Last,P : ConTro;
   i : Byte;
   Heaptop : Pointer;
{----------------------------------}
    Procedure KhoiTao;
   Begin
       First := Nil;
      Mark(HeapTop);
      i := 0;
      Repeat
          Inc(i);
         New(P);
         Write('-(Khong nhap,bam <Enter>). Ho ten nguoi thu: ',i:2,' : ');
         Readln(P^.HoTen);
         If First = Nil Then
             Begin
                First := P;
               First^.Pre := Nil
            End
         Else
             Begin
                Last^.Next := P;
               P^.Pre := Last;
            End;
         Last := P;
         Last^.Next := Nil
      Until P^.HoTen ='';
   End;
{----------------------------------}
    Procedure DuyetXuong;
   Var
       P : ConTro;
      i : Byte;
   Begin
       P := First;
      i := 0;
      While P <> Nil Do
          Begin
             Inc(i);
            Writeln(i:2,'>... : ',P^.HoTen: -28);
            P := P^.Next;
         End;
   End;
{----------------------------------}
    Procedure DuyetLen;
   Var
       P : ConTro;
      i : Byte;
   Begin
       P := Last;
      i := 0;
      While P <> Nil Do
          Begin
             Inc(i);
            Writeln(i:2,'>... : ',P^.HoTen: -28);
            P := P^.Pre;
         End;
   End;
{----------------------------------}
BEGIN
    ClrScr;
   Writeln('DUYET DANH SACH THEO 2 CHIEU');
   Writeln('Tu dau den cuoi danh sach');
   Writeln('Tu cuoi len dau danh sach');
   Writeln('-------------------------');
   Writeln;
    KhoiTao;
   Writeln;
   Writeln(' Bam <Enter> de xem tu tren xuong duoi danh sach');
   Readln;
   ClrScr;
   DuyetXuong;
   Writeln;
   Writeln(' Bam <Enter> de xem tu duoi len tren danh sach');
   Readln;
   DuyetLen;
   Writeln;
   Write(' Bam <Enter> de ket thuc ');
   Readln;
   Release(HeapTop);
END.
90/Danh sách liên kết:
Code:
Program Danh_Sach_Lien_ket;
Uses Crt;
TYPE
    ConTro = ^BanGhi;
   BanGhi = RECORD
       HoTen    : String[24];
      DiaChi   : String[20];
      ChucVu   : String[15];
      DonVi    : String[20];
      Next     : ConTro;
      End;
VAR
    First, Last,P,F: ConTro;
   Ch : Char;
{-------------------------------------}
    Procedure Noi;
{-------------------------------------}
    Procedure Nhap;
   Begin
       With P^ Do
          Begin
             Write('-Ho va ten: ');
            Readln(HoTen);
            Write('-Dia chi  : ');
            Readln(DiaChi);
            Write('-Chuc vu  : ');
            Readln(Chucvu);
            Write('-Don vi   : ');
            Readln(DonVi);
         End;
   End;
{-------------------------------------}
    Begin
       ClrScr;
      If First = Nil Then
          Begin
             New(P);
            Nhap;
            First   := P;
            P^.Next := Nil;
            First   := P;
            Last    := P;
         End
      Else
          Begin
             F := P;
            New(P);
            Nhap;
            F^.Next := P;
            P^.Next := Nil;
         End;
   End;
{-------------------------------------}

    Procedure Duyet;
   Var
       P : ConTro;
   Begin
       P := First;
      While P <> Nil Do
          Begin
             With P^ Do
            Writeln(HoTen,' , ',DiaChi,' , ',ChucVu,' , ',DonVi);
            P := P^.Next;
         End;
      Writeln;
      Writeln('Bam <Enter> ... ');
      Readln
   End;
{-------------------------------------}
BEGIN
    First := Nil;
   Repeat
       ClrScr;
      Repeat
          Write('Bam (N)oi, (D)uyet, hoac (K)et thuc ');
         Ch := ReadKey;
         If Ch = #0 Then
             Ch := Readkey;
         Writeln;
         Ch := UpCase(Ch);
      Until Ch In ['N','D','K'];
      If Ch = 'N' Then
          Noi
      Else
          If Ch = 'D' Then
             Duyet
   Until Ch = 'K'
END.
91/Danh sách móc nối:
Code:
Program Danh_Sach_Moc_Noi;
Uses Crt;
TYPE
    ConTro = ^SoNguyen;
   SoNguyen = RECORD
       So : Integer;
      Next : ConTro;
      End;
VAR
    First,Last,P :ConTro;
   So1 : Integer;
   Ch : Char;
{----------------------------------}
    Procedure Nhap(Var First, Last : ConTRo);
   Var
       i : Integer;
   Begin
       ClrScr;
      Writeln('NHAP DU LIEU');
      Writeln('------------');
      Writeln;
      i := 0;
      Repeat
          i := i + 1;
         New(P);
         Write('-So thu: ',i:2,' = ');
         Readln(P^.So);
         If i = 1 Then
             Begin
                First := P;
               Last := P;
            End
         Else
             Begin
                Last^.Next := P;
               Last := P;
            End;
         Write('    Nhap nua khong ? (c/k) ');
         Readln(Ch);
      Until UpCase(Ch) = 'K';
      Last^.Next := Nil
   End;
{----------------------------------}
    Procedure Noi(Var First,Lasr : ConTro; Var So1 : Integer);
   Begin
       Writeln;
       New(P);
      P^.So := So1;
      If First = Nil Then
            First := P;
      Last^.Next := P;
      Last := P;
      Last^.Next := Nil;
      Writeln;
      Write('Da noi vao cuoi danh sach, bam <Enter> . . . ');
      Readln
   End;
{----------------------------------}
    Procedure Xoa(Var First : ConTro; Var So1 : Integer);
   Begin
       Writeln;
       So1 :=First^.So;
      P := First;
      First := First^.Next;
      Dispose(P);
      Writeln;
      Write('    Da xoa so dau, bam <Enter> . . . ');
      Readln
   End;
{----------------------------------}
    Procedure LietKe(First : ConTro);
   Begin
       Writeln;
       P := First;
      If P = Nil Then
          Writeln('Danh sach rong');
      While P <> Nil Do
          Begin
             Write(P^.So : 5);
            P := P^.Next;
         End;
      Writeln;
      Write('    Xem xong, bam <Enter> . . . ');
      Readln
   End;
{----------------------------------}
BEGIN
    First := Nil;
   Last := Nil;
   Repeat
       ClrScr;
      Writeln('              DANH SACH MOC NOI');
      Writeln('        Them vao cuoi, xoa dau danh sach');
      Repeat
          Writeln('1-Nhap so');
         Writeln('2-Liet ke');
         Writeln('3-Noi them');
         Writeln('4-Xoa');
         Writeln('5-Ket thuc');
         Writeln;
         Write('Chon chuc nang nao: ');
         Ch := Readkey;
      Until Ch in ['1'..'5'];
      Case Ch Of
          '1'    : Nhap(First, Last);
         '2'    : LietKe(First);
         '3'    : Begin
                         Writeln;
                           Write('-Nhap so muon noi them: ');
                            Readln(So1);
                     Writeln;
                     Writeln('DANH SACH TRUOC KHI NOI LA');
                     LietKe(First);
                            Noi(First,Last,So1);
                            Writeln;
                            Writeln('DANH SACH SAU KHI NOI THEM SO LA');
                            LietKe(First);
                   End;
         '4'    : If First = Nil Then
                         Begin
                         Writeln(' Danh sach rong, khong xoa duoc');
                        Writeln('Bam <Enter> . . . ');
                        Readln
                     End
                     Else
                      Begin
                         Writeln;
                        Writeln('    DANH SACH TRUOC KHI XOA SO');
                        LietKe(First);
                         Xoa(First,So1);
                        Writeln('-So vua xoa la: ',So1);
                        Writeln;
                        Writeln('    DANH SACH CON LAI SAU KHI XOA SO DAU');
                        LietKe(First);
                     End;
      End;
   Until Ch ='5'
END.
92/Danh sách LK:
Code:
Program Danh_Sach_LK;
Uses Crt;
TYPE
    Str = String[24];
   ConTro = ^BanGhi;
   BanGhi = RECORD
       HoTen : Str;
      Luong : Real;
      Next  : ConTro;
      End;
VAR
    First     : ConTro;
   Nv        : BanGhi;
   Ketthuc  : Boolean;
   Ch         : Char;
{--------------------------------}
    Procedure Chen(Var First : ConTro; Nv : BanGhi);
   Var
       P : ConTro;
   Begin
       New(P);
      P^.HoTen := NV.HoTen;
      P^.Luong := NV.Luong;
      P^.Next  := First;
      First := P;
   End;
{--------------------------------}
    Procedure Xoa(Var First : ConTro; Nv : BanGhi);
   Var
       P,P1 : ConTro;
   Begin
       If First^.HoTen = NV.HoTen Then
          Begin
             P := First;
            First :=First^.Next;
            Dispose(P);
         End
      Else
          Begin
             P := First;
            While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
                Begin
                   P1 := P;
                  P := P^.Next;
               End;
            If P = Nil Then
                Writeln('Khong tim thay')
            Else
                Begin
                   P1^.Next := P^.Next;
                  Dispose(P);
               End;
         End;
   End;
{--------------------------------}
    Procedure Tim(First : ConTro; Nv : BanGhi);
   Var
       P : ConTro;
   Begin
       P := First;
      While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
          P := P^.Next;
      If P = Nil Then
          Writeln('Khong tim thay')
      Else
          Begin
             Writeln('Tim thay');
            Writeln(P^.HoTen,' ', P^.Luong:8:1);
         End;
   End;
{--------------------------------}
    Procedure LietKe(First : ConTro);
   Var
       P : ConTro;
   Begin
       Writeln;
       If First = Nil Then
          Writeln('Danh sach rong')
      Else
          Begin
             P := First;
            While ( P <> Nil) Do
                Begin
                   Writeln(P^.HoTen,' ',P^.Luong:8:1);
                  P := P^.Next;
               End;
         End;
         Writeln;
         Write('Xem xong, bam <Enter> . . . ');
         Readln
   End;
{--------------------------------}
    Procedure XoaHet(Var First : ConTro);
   Var
       P1,P : ConTro;
   Begin
       P := First;
      While P <> Nil Do
          Begin
             P1 := P^.Next;
            Dispose(P);
            P := P1;
         End;
      First := Nil
   End;
{--------------------------------}
    Procedure DaoNguoc(Var First : ConTro);
   Var
       P,P1,Tam: ConTro;
   Begin
       If (First <> Nil) And ( First^.Next <> Nil) Then
          Begin
             P1 := First;
            P := P1^.Next;
            First^.Next := Nil;
            While (P <> Nil) Do
                Begin
                   Tam := P^.Next;
                  P^.Next := P1;
                  P1 := P;
                  P := Tam;
               End;
            First := P1;
         End;
      Writeln;
      Write('Da dao nguoc danh sach, bam <Enter> . . . ');
      Readln
   End;
{--------------------------------}
BEGIN
    Repeat
       ClrScr;
       Writeln;
       Writeln('CAC CHUC NANG');
       Writeln('-------------');
       Writeln('Chu y: Danh sach LIFO hoac FILO');
      Writeln('Ban ghi nhap vao dau nhung xuat ra cuoi');
       Writeln('1-KHOI TAO DANH SACH');
        Writeln('2-NOI THEM VAO DANH SACH');
       Writeln('3-XOA KHOI DANH SACH');
       Writeln('4-TIM KIEM TRONG DANH SACH');
       Writeln('5-LIET KE DANH SACH');
       Writeln('6-DAO NGUOC DANH SACH');
       Writeln('7-KET THUC CHUONG TRINH');
      Writeln;
       Write('Chon cac chuc nang tu 1 den 7: ');
       Readln(Ch);
       Case Ch Of
           '1'    : Begin
                          Writeln('1-TAO DANH SACH');
                      First := Nil;
                      KetThuc := False;
                      Repeat
                          With Nv Do
                             Begin
                                Write('-Ho ten hoac <Ente> de ngung: ');
                               Readln(HoTen);
                               If HoTen <> '' Then
                                   Begin
                                      Write('-Bac luong : ');
                                     Readln(Luong);
                                     Chen(First,Nv);
                                  End
                               Else
                                   KetThuc := True;
                            End;
                      Until ketThuc;
                        End;
          '2'    : Begin
                          Writeln('2-NOI THEM VAO DAU DANH SACH');
                      KetThuc := False;
                      Repeat
                          With Nv Do
                             Begin
                                Write('-Ho ten hoac <Enter> de ngung: ');
                               Readln(HoTen);
                               If HoTen <> '' Then
                                   Begin
                                      Write('-Bac luong : ');
                                     Readln(Luong);
                                     Chen(First,Nv);
                                  End
                               Else
                                   KetThuc := True;
                            End;
                      Until ketThuc;
                        End;
         '3'    :  Begin
                         Writeln('3.XOA KHOI DANH SACH');
                     KetThuc := False;
                     Repeat
                         With Nv Do
                            Begin
                               Write('Ho ten can xoa, hoac <Enter> de ngung: ');
                              Readln(HoTen);
                              If HoTen <> '' Then
                                  Xoa(First,NV)
                              Else
                                  KetThuc := True;
                           End;
                     Until KetThuc;
                     End;
         '4'    :    Begin
                         Writeln('4-TIM KIEM TRONG DANH SACH');
                     KetThuc := False;
                     Repeat
                         With Nv Do
                            Begin
                               Write('Ho ten can tim, hoac <Enter> de ngung: ');
                              Readln(HoTen);
                              If HoTen <> '' Then
                                  Tim(First,NV)
                              Else
                                  KetThuc := True;
                           End;
                     Until KetThuc;
                     End;
         '5'    :    Begin
                         Writeln('5-LIET KE NOI DUNG DANH SACH');
                     LietKe(First)
                        End;
          '6'    :    Begin
                         Writeln('6-DAO NGUOC NOI DUNG DANH SACH');
                     DaoNguoc(First)
                        End;
         '7'    :        Begin
                         Writeln('7-XOA HET NOI DUNG DANH SACH ROI KET THUC');
                     XoaHet(First)
                        End;
      End;
   Until Ch = '7'
END.
93/Cây nhị phân (code 2):
Code:
Program Cay_Nhi_Phan;
Uses Crt;
TYPE
    Str = String[24];
   ConTro = ^BanGhi;
   BanGhi = RECORD
       HoTen : Str;
      Luong : Real;
      Trai,Phai : ConTro;
      End;
VAR
    Goc        : ConTro;
   Nv        : BanGhi;
   Ketthuc  : Boolean;
   Ch         : Char;
{--------------------------------}
    Procedure Chen(Var Goc : ConTro; Nv : BanGhi);
   Var
       P,P1 : ConTro;
   Begin
       If goc = Nil Then
          Begin
               New(Goc);
            With Goc^ Do
                Begin
                      HoTen := NV.HoTen;
                  Luong := NV.Luong;
                  Trai  := Nil;
                  Phai  := Nil;
               End;
         End
      Else
          Begin
             P := Goc;
            P1 := Nil;
            While P <> Nil Do
                Begin
                   P1 := P;
                  If Nv.HoTen <= P^.HoTen Then
                      P := P^.Trai
                  Else
                      P := P^.Phai;
               End;
            New(P);
            With P^ Do
                Begin
                   HoTen := NV.HoTen;
                  Luong := NV.Luong;
                  Trai := Nil;
                  Phai := Nil;
               End;
            If NV.HoTen <=P1^.HoTen Then
                P1^.Trai := P
            Else
                P1^.Phai := P;
         End;
   End;
{--------------------------------}
    Procedure Xoa(Var Goc : ConTro; Nv : BanGhi);
   Var
       P,P1,Q,Q1 : ConTro;
      Nhanh :(NhanhTrai,NhanhPhai);
   Begin
       If Goc = Nil Then
          Writeln('Cay rong')
      Else
          Begin
             P := Goc;
            P1 := Nil;
            While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
                Begin
                   P1 := P;
                  If Nv.HoTen < P^.HoTen Then
                      Begin
                         P := P^.Trai;
                        Nhanh := NhanhTrai;
                     End
                  Else
                      Begin
                         P := P^.Phai;
                        Nhanh := NhanhPhai;
                     End;
               End;
            If P = Nil Then
                Writeln('Khong tim thay')
            Else
                Begin
                   If (P^.Trai = Nil) Then
                      Q := P^.Phai
                  Else
                      Begin
                         Q := P^.Trai;
                        Q1 := Nil;
                        While Q^.Phai <> Nil Do
                            Begin
                               Q1 := Q;
                              Q := Q^.Phai;
                           End;
                        If Q1  <> Nil Then
                            Begin
                               Q1^.Phai := Q^.Trai;
                              Q^.Trai := P^.Trai;
                           End;
                        If P1 = Nil Then
                            Goc := Q
                        Else
                            Begin
                               If Nhanh = NhanhTrai Then
                                  P1^.Trai := Q
                              Else
                                  P1^.Phai := Q;
                           End;
                        Dispose(P);
                     End;
               End;
         End;
   End;
{--------------------------------}
    Procedure Tim(Goc : ConTro; Nv : BanGhi);
   Var
       P : ConTro;
   Begin
       P := Goc;
      While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
          If NV.HoTen < P^.HoTen Then
            P := P^.Trai
         Else
             P := P^.Phai;
      If P = Nil Then
          Writeln('Khong tim thay')
      Else
          Begin
             Writeln('Tim thay');
            Writeln(P^.HoTen,' ', P^.Luong:8:1);
         End;
   End;
{--------------------------------}
    Procedure LNRLietKe(Goc : ConTro);
   Begin
       If Goc =  Nil Then
          Begin
             Writeln('Cay rong, chua co du lieu');
         End
      Else
          Begin
             If Goc^.Trai <> Nil Then
                LNRLietKe(Goc^.Trai);
            Writeln(Goc^.HoTen,', ',Goc^.Luong:8:1);
            If Goc^.Phai <> Nil Then
               LNRLietKe(Goc^.Phai);
         End;
   End;
{--------------------------------}
BEGIN
    Repeat
       ClrScr;
       Writeln;
       Writeln('CAC CHUC NANG CAY NHI PHAN');
       Writeln('--------------------------');
       Writeln;
       Writeln('1-Khoi tao cay');
        Writeln('2-Noi them vao cay');
       Writeln('3-Xoa khoi cay');
       Writeln('4-Tim kiem tren cay');
       Writeln('5-Liet ke danh sach');
       Writeln('6-Ket thuc chuong trinh');
      Writeln;
       Write('Chon cac chuc nang tu 1 den 6: ');
       Readln(Ch);
       Case Ch Of
           '1'    : Begin
                         ClrScr;
                          Writeln('1-KHOI TAO CAY');
                     Writeln('Cay co thu tu LNR');
                     Writeln('-----------------');
                     Writeln;
                      Goc := Nil;
                      KetThuc := False;
                      Repeat
                          With Nv Do
                             Begin
                                Write('-Ho ten hoac <Enter> de ngung: ');
                               Readln(HoTen);
                               If HoTen <> '' Then
                                   Begin
                                      Write('-Bac luong : ');
                                     Readln(Luong);
                                     Chen(Goc,Nv);
                                  End
                               Else
                                   KetThuc := True;
                            End;
                      Until ketThuc;
                        End;
          '2'    : Begin
                         ClrScr;
                         Writeln;
                          Writeln('2-NOI VAO CAY THEO THU TU');
                     Writeln('-------------------------');
                     Writeln;
                      KetThuc := False;
                      Repeat
                          With Nv Do
                             Begin
                                Write('-Ho ten hoac <Enter> de ngung: ');
                               Readln(HoTen);
                               If HoTen <> '' Then
                                   Begin
                                      Write('-Bac luong : ');
                                     Readln(Luong);
                                     Chen(Goc,Nv);
                                  End
                               Else
                                   KetThuc := True;
                            End;
                      Until ketThuc;
                        End;
         '3'    :  Begin
                         ClrScr;
                     Writeln;
                         Writeln('3.XOA KHOI CAY');
                     Writeln('--------------');
                     Writeln;
                     KetThuc := False;
                     Repeat
                         With Nv Do
                            Begin
                               Write('Ho ten can xoa, hoac <Enter> de ngung: ');
                              Readln(HoTen);
                              If HoTen <> '' Then
                                  Xoa(Goc,NV)
                              Else
                                  KetThuc := True;
                           End;
                     Until KetThuc;
                     End;
         '4'    :    Begin
                         ClrScr;
                         Writeln('4-TIM KIEM TREN CAY');
                     Writeln('-------------------');
                     Writeln;
                     ketThuc := False;
                     Repeat
                         With Nv Do
                            Begin
                               Write('Ho ten can tim, hoac <Enter> de ngung: ');
                              Readln(HoTen);
                              If HoTen <> '' Then
                                  Tim(Goc,NV)
                              Else
                                  KetThuc := True;
                           End;
                     Until KetThuc;
                     End;
         '5'    :    Begin
                         ClrScr;
                         Writeln('5-LIET KE NOI DUNG CAY');
                     Writeln('Hien thi theo thu tu ABC...');
                     Writeln('---------------------------');
                     Writeln;
                     LNRLietKe(Goc);
                     Writeln;
                     Write('Xem xong bam <Enter> . . . ');
                     Readln
                        End;
         '6'    :        Begin
                         Writeln('7- KET THUC CHUONG TRINH');
                     Writeln;
                        End;
      End;
   Until Ch = '6'
END.
94/Đổi số thực ra phân số tối giản:
Code:
Program Phan_So_1;
Uses PhanSo1;
Var
    x : T_PhanSo1;
   r : Real;
BEGIN
    Writeln('DOI SO THUC RA OHAN SO TOI GIAN');
   Writeln('-------------------------------');
   Writeln;
   Write('-Nhap mot so thuc: ');
   Readln(r);
   Writeln;
   With x Do
       Begin
          KhoiDong;
         Write('+Doi ra dang phan so la= ');
         Doi(r);
         Xuat;
         Writeln;
         Write('+Phan so toi gian la   = ');
         Toigian;
         Xuat;
      End;
   Readln
END.
95/So sánh, cộng 2 số thức dưới dạng phân số:
Code:
Program Phan_So_2;
Uses PhanSo2;
Var
    X,Y : T_PhanSo2;
   so1,so2 : Real;
Begin
    Writeln('SO SANH, CONG 2 SO THUC DUOI DANG PHAN SO');
   Writeln('----------------------------------------');
   Writeln;
    Write('-Nhap so thu nhat: ');
   Readln(so1);
   Write('-Nhap so thu hai : ');
   Readln(so2);
   X.KhoiDong;
   Y.KhoiDong;
   X.Doi(So1);
   Y.Doi(So2);
   Writeln;
   Write('-Doi so thu nhat ra phan so la : ');
   X.Xuat;
   Writeln;
   Write('-Doi so thu hai ra phan so la  : ');
   Y.Xuat;
   Writeln;
   Writeln;
   If X.LonHon(Y) Then
       Writeln('-So thu nhat lon hon so thu hai');
   If Y.LonHon(X) Then
       Writeln('-So thu hai lon hon so thu nhat');
   Writeln;
   X.Cong(Y);
   Write('-Tong 2 phan so la : ');
    X.Xuat;
   Writeln;
   Write('     Bam <Enter> . . . ');
   Readln
End.
96/So sánh, cộng 2 số thực chênh lệnh lớn:
Code:
Program Phan_So_3;
Uses PhanSo3;
Var
    X,Y : T_PhanSo3;
   so1,so2 : Real;
Begin
    Writeln('SO SANH, CONG 2 SO THUC CHENH LECH LON');
   Writeln('--------------------------------------');
   Writeln;
    Write('-Nhap so thu nhat: ');
   Readln(so1);
   Write('-Nhap so thu hai : ');
   Readln(so2);
   X.KhoiDong;
   Y.KhoiDong;
   X.Doi(So1);
   Y.Doi(So2);
   Writeln;
   If X.LonHon(Y) Then
       Writeln('-So thu nhat lon hon so thu hai');
   If Y.LonHon(X) Then
       Writeln('-So thu hai lon hon so thu nhat');
   Writeln;
   X.Cong(Y);
   Write('-Tong 2 so la : ');
    X.Xuat;
   Writeln;
   Write('     Bam <Enter> . . . ');
   Readln
End.
97/Đọc 1 tập tin:
Code:
Program ListDemo;
Uses ListUtil;
TYPE
    StrObjPtr = ^StrObj;
   StrObj = OBJECT(Item)
       St : ^String;
      Constructor Init(InitStr : String);
      Destructor Done; Virtual;
      Procedure Print; Virtual;
      End;
VAR
    ItemList : List;
   F        : Text; {bien kieu tap tin van ban}
    Line     : String[80];
{-----------------------------}
    Constructor StrObj.Init;
    Begin
       Item.Init;
      GetMem(St,length(InitStr) + 1);
      St^ := InitStr;
    End;
{-----------------------------}
    Destructor Strobj.Done;
   Begin
       FreeMem(St, Length(St^) + 1);
      Item.Done;
   End;
{-----------------------------}
    Procedure StrObj.Print;
   Begin
       Item.Print;
      Write(St^);
   End;
{-----------------------------}
BEGIN
    ItemList.Init;
   Writeln('-Bo nho truoc khi doc tap tin: ',MemAvail,' bytes');
   Writeln;
   Write('-Bam <Enter> de doc tap tin BAITHO.TXT tu dia ');
   Readln;
   Assign(F,'BAITHO.TXT'); {Gan bien tap tin}
   Reset(F); {Mo tap tin da co tren dia }
   While Not EOF(F) Do
       Begin
          Readln(F,Line);
         ItemList.InsertItem(New(StrObjPtr,Init(Line)))
      End;
   Writeln;
   ItemList.PrintList;
   Writeln;
   Writeln;
   Writeln('-Bo nho sau khi doc tap tin: ',MemAvail,' bytes');
   ItemList.DisposeList;
   Writeln;
   Writeln;
   Writeln('-Bo nho sau khi xoa bang Dispose: ',MemAvail,' bytes');
   Writeln;
   Write('    Bam <Enter>. . . ');
   Readln
END.
98/Đọc bộ nhớ dữ liệu:
Code:
Program ListDemo;
Uses ListUtil;
TYPE
    IntObjPtr = ^IntObj;
   IntObj = OBJECT(Item)
       I : Integer;
      Constructor Init(InitI : Integer);
      Procedure Print; Virtual;
      End;

   RealObjPtr = ^RealObj;
   RealObj = OBJECT(Item)
       R : Real;
      Constructor init(InitReal : Real);
      Procedure Print; Virtual;
      End;

   StrObjPtr = ^StrObj;
   StrObj = OBJECT(Item)
       St : ^String;
      Constructor Init(InitStr : String);
      Destructor Done; Virtual;
      Procedure Print; Virtual;
      End;
VAR
    ItemList : List;
{--------------------------------}
    Constructor IntObj.Init;
   Begin
       Item.Init;
      I :=InitI;
   End;
{--------------------------------}
    Procedure IntObj.Print;
   Begin
       Item.print;
      Write('    +So nguyen = ',i);
   End;
{--------------------------------}
    Constructor RealObj.Init;
   Begin
       Item.Init;
      R := InitReal
   End;
{--------------------------------}
    Procedure RealObj.Print;
   Begin
       Item.Print;
      Write('    +So thuc = ',r);
   End;
{--------------------------------}
    Constructor StrObj.Init;
   Begin
       Item.Init;
      Getmem(St,Length(InitStr) +1);
      St^ := InitStr;
   End;
{--------------------------------}
    Destructor StrObj.Done;
   Begin
       FreeMem(St,Length(St^) + 1);
      Item.Done;
   End;
{--------------------------------}
    Procedure StrObj.print;
   Begin
       Item.Print;
      Write('    +Chuoi ky tu = ',St^);
   End;
{--------------------------------}
BEGIN
    ItemList.Init;
   Writeln('-Bo nho truoc khi chen du lieu: ',MemAvail,' bytes');
   ItemList.InsertItem(New(IntObjPtr,Init(123)));
   ItemList.InsertItem(New(RealObjPtr,Init(123.456)));
   ItemList.InsertItem(New(StrObjPtr,Init('Turbo Pascal 7.0')));
   Itemlist.PrintList;
   Writeln;
   Writeln;
   Writeln('-Bo nho sau khi chen du lieu: ',MemAvail,' bytes');
   ItemList.DisposeList;
   Writeln;
   Writeln;
   Writeln('-Bo nho sau khi xoa bang Dispose = ',MemAvail,' bytes');
   Writeln;
   Write('   Bam <Enter> ... ');
   Readln
END.
99/Vẽ hình:
Code:
Program Ve_hinh;
Uses Crt,Graph,Dos,Vehinh;
TYPE
    Arc = OBJECT(Circle)
       StartAngle, EndAngle : Integer;
      Constructor Init(InitX,InitY,InitRadius, InitS,InitE:Integer);
      Procedure Show; Virtual;
      Procedure Hide; Virtual;
      End;
VAR
    GrDriver, GrMode: Integer;
   Cung            : Arc;
   C               : Circle;
   P               : Point;
{-------------------------------------}
    Constructor Arc.Init;
   Begin
       Circle.Init(InitX,InitY,InitRadius);
      StartAngle := InitS;
      EndAngle := InitE;
   End;
{-------------------------------------}
   Procedure Arc.Show;
   Begin
       Visible := True;
      Graph.Arc(X,Y,StartAngle,EndAngle,Radius);
   End;
{-------------------------------------}
    Procedure Arc.Hide;
   Var
       TempColor : Word;
   Begin
       TempColor := Graph.GetColor;
      Graph.SetColor(GetBkColor);
      Visible := False;
      Graph.Arc(X,Y,StartAngle,EndAngle,Radius);
      SetColor(TempColor);
   End;
{-------------------------------------}
BEGIN
    GrDriver := CGA;
   GrMode := CGAC0;
   InitGraph(GrDriver,GrMode,'C:\BP\BGI');
   C.Init(151,82,50);
   Cung.Init(151,82,25,0,90);
   P.Init(151,82);
   P.Drag(5);
   Cung.Drag(5);
   C.Drag(5);
   CloseGraph
END.
100/Phân số (dạng 1):
Code:
UNIT PhanSo1;

INTERFACE

TYPE
    T_Dau = -1.. 1;
   T_PhanSo1 = OBJECT
       TuSo, MauSo : LongInt;
      Dau            : T_Dau;
      CONSTRUCTOR KhoiDong;
      Procedure Doi(r : Real);
      Procedure ToiGian;
      Procedure Xuat;
   End;

IMPLEMENTATION

CONST
    Max = 2147483647;
   R_min = 1E-10;
   CONSTRUCTOR T_PhanSo1.KhoiDong;
   Begin
   End;
{--------------------------}
   Procedure T_PhanSo1.Doi(r : Real);
   Var
       PS : T_PhanSo1;
      Du : Real;
   Begin
       If ABS(r) > Max Then
          RunError(7);
      If r > 0 Then
          Dau := 1
      Else
          Dau := -1;
      r := ABS(r);
      MauSo := 1;
      Du := r - Int(r);
      While Du > R_Min Do
          Begin
             r := 10 * r;
            MauSo := 10 * MauSo;
            Du := r - Round(r);
         End;
      TuSo := Round(r);
   End;

{--------------------------}
   Procedure T_PhanSo1.ToiGian;
   Var
       u : LongInt;
      Function USCLN(x, y : LongInt) : LongInt;
      Begin
          While NOT (x = y) Do
             If x > y Then
                x := x - y
            Else
                y := y -x;
         USCLN := x;
      End;
   Begin
       If TuSo = 0 Then
          Begin
             MauSo := 1;
            Dau := 0;
            Exit;
         End;
      u := USCLN(TuSo, MauSo);
      TuSo := TuSo Div u;
      MauSo := MauSo Div u;
   End;

   {--------------------------}
   Procedure T_PhanSo1.Xuat;
   Begin
       If MauSo = 1 Then
          Begin
             If Dau = -1 Then
                Write('-',TuSo)
            Else
                Write(TuSo);
            Exit
         End;
      If Dau = -1 Then
          Write('-',TuSo, '/', MauSo)
      Else
          Write(TuSo,'/',MauSo);
   End;
   END.

Tài sản của KuteoDnC
Trả Lời Với Trích Dẫn
  #3  
Old 28-11-2010, 10:48 PM
KuteoDnC's Avatar
  User Profile
KuteoDnCAdmin KuteoDnC is offline
Administrator
   Họ & Tên: Ku tèo
  • Đang học lớp : * Đã ra trường .
  • Niên khóa : 2002 - 2005
 
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,318,535
Đã cảm ơn: 159 bài viết
Được cảm ơn 645 lần trong 184 bài
KuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to behold

Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng 
Total Awards: 8

Send a message via ICQ to KuteoDnC
Default


-Các bạn có thể Tải Tất cả các bài trên với File Word Tại:http://www.mediafire.com/?1q89eyczo52lf67
-Các bạn có thể Tải Tất cả các bài trong thư viện với file .PASTại:http://www.mediafire.com/?bg3ecyvfet8664b
Tài sản của KuteoDnC
Trả Lời Với Trích Dẫn
Gởi Ðề Tài Mới  Trả lời

Ðiều Chỉnh
Xếp Bài

Quyền Sử Dụng
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Mở
Smilies đang Mở
[IMG] đang Mở
HTML đang Tắt


Xin thông báo, bây giờ là 12:49 AM

Tổng lượng truy cập diễn đàn Tranphudn.Com
Powered by vBulletin
Copyright ©2000-2013, Jelsoft Enterprises Ltd
Website hiển thị tốt nhất ở trình duyệt Chrome hoặc FireFox và chế độ toàn màn hình
Khi tham gia diễn đàn tức là bạn đã đồng ý với Nội quy diễn đàn
BQT Không chịu trách nhiệm về nội dung bài viết mà các thành viên đăng tải lên diễn đàn
Địa chỉ trường: 11 Lê Thánh Tôn - TP.Đà Nẵng
Điện thoại: 0511.3822851

tran phu | de thi dh 2011 | de thi dai hoc 2011 | de thi dai hoc 2011 | Thu vien giao an dien tu| giao an dien tu| Giao an lop 10| Giao an lop 11| Giao an lop 12| Kinh nghiem hoc tap| van mau lop 9| Van mau lop 10| Van mau lop 11| Van mau lop 12| THPT Trần Phú Đà Nẵng | Thế hệ trẻ Yêu Hóa Học | doc truyen conan | meo choi lmht| soan bai | do go doc | top keywords, bua | |