Tổng hợp Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1

loveIT

Thành viên Vip
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:
  [B]Program Hoan_Vi_Chuoi;[/B]
  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:
  [B]Program Tach_Danh_Sach_Chan_Le;[/B]
  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:
  [B]Program Dao_Nguoc_Danh_Sach;[/B]
  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:
  [B]Program Ghep_Chuoi;[/B]
  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:
  [B]Program Cay_Nhi_Phan;[/B]
  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.
 

loveIT

Thành viên Vip
101/Nhập số liệu cho 1 tập tin số nguyên:
Code:
Program Tap_Tin_So_Nguyen;
Uses Crt;
Var
    f : File Of Integer;
   So : Integer;
   a : Array[1..10] Of Integer;
   Spt,i,j : Integer;
   Filename : String[11];
Begin
   ClrScr;
    Writeln('NHAP SO LIEU CHO TAP TIN SONGUYEN.DAT');
   Writeln('-------------------------------------');
   Writeln;
   Assign(f,'songuyen.dat');
   ReWrite(f);
   For i := 1 To 10 Do
       Begin
          Write('-So thu: ',i:2,' = ');
         Readln(So);
         Write(f,so);
      End;
   Close(f);
   Spt := 0;
   Reset(f);
   While NOT EOF(f) Do
       Begin
          Spt := Spt + 1;
         Read(f,so);
         a[Spt] := so;
      End;
   Close(f);
   For i := 1 To Spt -1 Do
       For j := Spt Downto i + 1 Do
          If a[j] < a[j-1] Then
             Begin
                So := a[j];
               a[j] := a[j-1];
               a[j-1] := So;
            End;
   Writeln;
   Writeln('Sau khi sap xep: ');
   For i := 1 To 10 Do
       Write(a[i]:6);
   Writeln;
   Write(' Bam <Enter>... ');
   Readln
End.
102/Ghép tập tin:
Code:
Program Ghep_Tap_Tin;
Uses Crt;
Var
    f1,f2,f3 : File Of Real;
   i : Integer;
   So : Real;
   Ch : Char;
Begin
    ClrScr;
    Writeln('NHAP SO LIEU CHO TAP1.DAT');
   Writeln('-------------------------');
   Writeln;
   Assign(f1,'TAP1.DAT');
   Rewrite(f1);
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So);
      Write(f1,so);
      Write('    Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) ='K';
   Close(f1);
   ClrScr;
   Writeln('NHAP SO LIEU CHO TAP2.DAT');
   Writeln('-------------------------');
   Writeln;
   Assign(f2,'TAP2.DAT');
   Rewrite(f2);
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So);
      Write(f2,so);
      Write('    Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) ='K';
   Close(f2);
   ClrScr;
   Writeln('GHEP TAP1 va TAP2 thanh TAP3');
   Writeln('----------------------------');
   Writeln;
   Assign(f3,'TAP3.DAT');
   Rewrite(f3);
   Reset(f1);
   Reset(f2);
   While NOT EOF(f1) Do
       Begin
          Read(f1,So);
         Write(f3,So);
      End;
   While NOT EOF(f2) Do
       Begin
          Read(f2,so);
         Write(f3,so);
      End;
   Reset(f3);
   While NOT EOF(f3) Do
       Begin
          Read(f3,So);
         Write(So :8:1);
      End;
   Close(f1);
   Close(f2);
   Close(f3);
   Writeln;
   Writeln;
   Write('    Da ghep xong, Bam <Enter>...');
   Readln;
End.
103/Sổ tay điện thoại:
Code:
Program So_tay_Dien_Tu;
Uses Crt;
Type
    DienThoai = RECORD
       HoTen : String[24];
      Tel   : LongInt;
      Add   : String;
      End;
Var
    f       : File Of DienThoai;
   Tam     : DienThoai;
   St      : String;
   TimThay : Boolean;
Begin
    ClrScr;
    Writeln('NHAP SO DIEN THOAI VA DIA CHI');
   Writeln('-----------------------------');
   Writeln;
   Assign(f,'Telephon.dat');
   Rewrite(f);
   With tam Do
       Repeat
          Write('-Ho ten, bam (0> de ket thuc: ');
         Readln(HoTen);
         If HoTen <> '0' Then
             Begin
                 Write('-So phone : ');
                Readln(Tel);
                Write('-Dia chi : ');
                Readln(Add);
                Write(f,tam);
            End;
      Until Hoten = '0';
      Close(f);
      ClrScr;
      Writeln('TIM SO DIEN THOAI VA DIA CHI');
      Writeln('----------------------------');
      Writeln;
      Write('-Ho ten nguoi muon tim: ');
      Readln(St);
      Reset(f);
      TimThay := False;
      While NOT EOF(f) Do
          Begin
             Read(f,Tam);
            With Tam Do
                If St = HoTen then
                   Begin
                      TimThay := True;
                     Writeln(HoTen);
                     Writeln('-So Telephone: ',Tel);
                     Writeln('-Dia chi     : ',Add);
                  End;
         End;
      If Not TimThay Then
          Writeln('Khong tim thay');
      Close(f);
      Writeln;
      Write('   Bam <Enter>... ');
      Readln
End.
104/Che dấu tập tin:
Code:
Program CheDau_TapTin;
Uses Dos,Crt;
Var
    f : File; {hoac f : Text }
   Filename : String;
   Ch : Char;
Begin
    Repeat
        ClrScr;
       TextColor(14);
       TextBackGround(2);
       GotoXY(23,4);
        Writeln('DAT THUOC TINH CHE DAU TAP TIN');
       GotoXY(23,5);
        Writeln('------------------------------');
       Writeln;
       TextColor(12);
       GotoXY(11,6);
       Writeln('*Khong hien thi duoc ten tap tin khi dung lenh DIR cua DOS*');
       GotoXY(15,8);
       TextColor(1);
       TextBackGround(14);
       Write('-Cho biet ten tap tin: ');
      Readln(Filename);
      TextColor(4+Blink);
      TextBackGround(14);
      GotoXY(25,24);
      Writeln('DANG THUC HIEN, XIN CHO DOI...');
      Assign(f,Filename);
      SetFAttr(f,Hidden);
      TextColor(4);
      TextBackGround(15);
      GotoXY(15,10);
      Case DosError Of
          0 : Writeln('Da hoan thanh tot dep');
         2 : Writeln('Khong tim thay tap tin nay');
         3 : Writeln('Khong tim thay duong dan')
      Else
          Writeln('Tap tin duoc bao ve, khong sua duoc');
      End;
      GotoXY(19,24);
      TextColor(14);
      TextBackGround(4);
      Writeln('Bam phim bat ky de tiep tuc, <Esc> de thoat ');
      Ch := Readkey;
      TextColor(White);
       TextBackGround(Black);
       ClrScr;
   Until Ch = #27;
End.
105/Cập nhật dữ liệu:
Code:
Program Cap_Nhat_Du_Lieu;
Uses Crt;
Type
    HoSo = RECORD
       Holot : String[17];
      Ten   : String[7];
      Tuoi  : 18..60;
      ChucVu: String[20];
      BacLuong : 300000..900000;
      End;
Var
    f : File Of HoSo;
   Nv : HoSo;
   ans : Char;
Begin
    ClrScr;
    Writeln('CAP NHAT DU LIEU VAO TAP TIN LUONG.DAT');
   Writeln('----------------------------------');
   Writeln;
   Assign(f,'LUONG.DAT');
   Reset(f);
   Seek(f,Filesize(f));
   Repeat
       With Nv Do
          Begin
             Write('-Ho lot: ');
            Readln(Holot);
            Write('-Ten   : ');
            Readln(Ten);
            Write('-Tuoi  : ');
            {$R+}
            Readln(tuoi);
            Write('-Chuc vu : ');
            Readln(ChucVu);
            Write('-Bac luong: ');
            Readln(BacLuong);
            Write(f,Nv);
         End;
      ans := Readkey;
   Until ans = #27;
   Close(f);
End.
106/Đọc tập tin:
Code:
Program Doc_Tap_tin;
Var
    f : Text;
   Filename : String;
   Ch : Char;
Begin
    Writeln('DOC TAP TIN VAN BAN');
   Writeln('-------------------');
   Writeln;
   Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f,filename);
   Reset(f);
   While Not EOF(f) Do
       Begin
          Read(f,Ch);
         Write(Ch);
      End;
   Close(f);
   Writeln;
   Write('Bam <Enter>... ');
   Readln
End.
107/Đọc chậm tập tin theo từng chử:
Code:
Program Doc_Tung_Chu;
Uses Crt;
Var
    Filename : String;
   f : Text;
   Line : String[251];
   k : Integer;
Begin
    ClrScr;
   Writeln('DOC CHAM TAP TIN THEO TUNG CHU');
   Writeln('------------------------------');
   Writeln;
   Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f,Filename);
   Reset(f);
   While Not EOF(f) Do
       Begin
          Readln(f,line);
         For k := 1 To Length(line) Do
             Begin
                Write(line[k]);
               Delay(150);
            End;
         Writeln;
      End;
   Close(f);
End.
108/Đọc ghi tập tin:
Code:
Program Doc_Ghi_Tap_Tin;
Var
    f1,f2 : Text;
   Filename : String;
   i : Integer;
   St : String;
Begin
    Writeln('DANH SO DONG TAP TIN');
   Writeln('--------------------');
   Writeln;
   Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f1,filename);
   Reset(f1);
   Assign(f2,'Newfile.txt');
   Rewrite(f2);
   i := 0;
   While Not EOF(f1) Do
       Begin
          i := i + 1;
         Readln(f1,st);
         Writeln(f2,i,' ',St);
      End;
   Close(f1);
   Close(f2);
   Writeln;
   Writeln('Da danh so dong va ghi vao tap tin NEWFILE.TXT');
   Writeln;
   Write('     Bam <Enter> de xem tap tin NEWFILE.TXT ');
   Readln;
   Assign(f2,'Newfile.txt');
   Reset(f2);
   While Not EOF(f2) Do
       Begin
          Readln(f2,st);
         Writeln(St);
      End;
   Close(f2);
   Writeln;
   Write('Xem xong, ban <Enter> ');
   Readln
End.
109/Tạo tập tin âm thanh Lambada:
Code:
Program Lambada;
Uses Crt;
Var
    f : Text;
   Note,dur : Word;
   Buf : Array[1..10240] Of Byte;
{---------------------------------}
    Procedure Play(Caodo,Truongdo : Word);
   Begin
       Sound(Caodo);
      Delay(Truongdo);
      NoSound;
   End;
{---------------------------------}
BEGIN
    ClrScr;
   TextColor(Yellow);
    Writeln('TAO TAP TIN AM THANH');
   TextColor(Red);
   Writeln('--------------------');
   Writeln;
   TextColor(Green);
   Writeln('Bam phim bat ky de tat am thanh');
   Repeat
        Assign(f,'lambada.not');
       SetTextBuf(f,buf);
       Reset(f);
       While (Not EOF(f)) And (Not KeyPressed) Do
            Begin
              Readln(f,Note,dur);
             Play(Note,Dur);
            End;
   Until KeyPressed;
   Close(f);
   NoSound;
END.
110/Karaoke:
Code:
Program Karaoke;
Uses Crt;
Const
    Lento = 10;
Type
    ConTro = ^Nhac;
   Nhac = RECORD
       Note,Dura : Word;
      Next      : ConTro;
      End;
Var
    f : Text;
   P,First, Last,HeapTop : ConTro;
{------------------------------------}
    Procedure AssignList(Filename : String);
   Begin
       Assign(f,Filename);
      {$I-}
      Reset(f);
      {$I+}
      If IOResult <> 0 Then
          Halt(1);
      First := Nil;
      Mark(HeapTop);
      While NOt EOF(f) Do
          Begin
             New(p);
            Readln(f,p^.Note,p^.Dura);
            If First = Nil Then
                First := p
            Else
                Last^.Next := p;
            Last := p;
            Last^.Next := Nil;
         End;
      Close(f);
   End;
{------------------------------------}
   Procedure Music;
   Begin
       p := First;
      While (p <> Nil) And Not (KeyPressed And (Readkey = #27)) Do
          Begin
             Sound(p^.Note);
            Delay(Lento*p^.Dura);
            p := p^.Next;
            If p = Nil Then
                p := First;
         End;
   End;
{------------------------------------}
BEGIN
    ClrScr;
   Writeln('    CHUONG TRINH NHAC EM DIU');
   Writeln('Truong do cham 10 lan so voi BT15_10');
   Writeln('     Bam <Esc> de ket thuc');
   Writeln('-------------------------------------');
    AssignList('Lambada.Not');
   Music;
   NoSound;
END.
111/Ghi điểm vào tập tin:
Code:
Program Nhap_Diem;
Type
    HocBa = RECORD
       HoTen : String[24];
      Van,Toan,Ly,Hoa,Tb: Real;
      End;
   FileHB = File Of HocBa;
Var
    f : FileHB;
   HS : HocBa;
   q : Boolean;
Begin
    Writeln('CHUONG TRINH GHI DIEM VAO TAP TIN');
   Writeln('--------------------------------------');
   Writeln;
   Assign(f,'DIEM.DAT');
   ReWrite(f);
   q := True;
   While q Do
       With HS Do
          Begin
             Write('-Ho ten hoc sinh,(<Enter> de ket thuc): ');
            Readln(HoTen);
            If HoTen = '' Then
                    Q := False
                Else
                    Begin
                   Write('-Diem Van : ');
                  Readln(Van);
                  Write('-Diem Toan: ');
                  Readln(Toan);
                  Write('-Diem Ly  : ');
                  Readln(Ly);
                  Write('-Diem Hoa : ');
                  Readln(Hoa);
                  Tb := ((Van*2)+(Toan*2)+Ly+Hoa)/6;
                  Write(f,HS);
                    End;
         End;
End.
112/Ghi thêm điểm vào tập tin:
Code:
Program Nhap_Them_Diem;
Type
    HocBa = RECORD
       HoTen : String[24];
      Van,Toan,Ly,Hoa,Tb: Real;
      End;
   FileHB = File Of HocBa;
Var
    f : FileHB;
   HS : HocBa;
   q : Boolean;
Begin
    Writeln('CHUONG TRINH GHI THEM DIEM VAO TAP TIN');
   Writeln('--------------------------------------');
   Writeln;
   Assign(f,'DIEM.DAT');
   Reset(f);
   Seek(f,filesize(f));
   q := True;
   While q Do
       With HS Do
          Begin
             Write('-Ho ten hoc sinh,(<Enter> de ket thuc): ');
            Readln(HoTen);
            If HoTen = '' Then
                    Q := False
                Else
                    Begin
                   Write('-Diem Van : ');
                  Readln(Van);
                  Write('-Diem Toan: ');
                  Readln(Toan);
                  Write('-Diem Ly  : ');
                  Readln(Ly);
                  Write('-Diem Hoa : ');
                  Readln(Hoa);
                  Tb := ((Van*2)+(Toan*2)+Ly+Hoa)/6;
                  Write(f,HS);
                    End;
         End;
End.
113/Tìm điểm theo họ tên:
Code:
Program Timp_Diem;
Type
    HocBa = RECORD
       HoTen : String[24];
      Van,Toan,Ly,Hoa,Tb: Real;
      End;
   FileHB = File Of HocBa;
Var
    f : FileHB;
   Hs : HocBa;
   St : String;
   TimThay : Boolean;
Begin
    Writeln('CHUONG TRINH TIM DIEM THEO HO TEN');
   Writeln('---------------------------------');
   Writeln;
   Write('-Ho ten hoc sinh muon tim: ');
   Readln(St);
   Assign(f,'DIEM.DAT');
   Reset(f);
   Timthay := False;
   While Not EOF(f) Do
       Begin
           Read(f,Hs);
               With Hs Do
                  If St = HoTen Then
                      Begin
                         TimThay := True;
                        Writeln(HoTen);
                           Writeln('-Diem Van : ',Van:5:2);
                        Writeln('-Diem Toan: ',Toan:5:2);
                        Writeln('-Diem Ly  : ',Ly:5:2);
                        Writeln('-Diem Hoa : ',Hoa:5:2);
                        Writeln('-Diem trung binh := ',Tb:5:2);
                        End
      End;
   If Not Timthay Then
       Writeln('Trong danh sach khong co hoc sinh: ',St);
   Close(f);
   Writeln;
   Write('   Bam <Enter>... ');
   Readln;
End.
114/Hồ sơ:
Code:
Program Ho_So;
Uses Crt;
Type
    LyLich = RECORD
       HoTen : String[24];
      NamSinh : Integer;
      ChucVu : String[20];
      BacLuong : Real;
      End;
Var
    f : File Of LyLich;
   q : Boolean;
   Nv : LyLich;
   Stt : Integer;
   Ch : Char;
Begin
    ClrScr;
   Assign(f,'HOSO.DAT');
   Rewrite(f);
   q := True;
   While q Do
       With Nv Do
           Begin
              Write('-Ho ten CBCNV (<Enter> de ngung): ');
             Readln(HoTen);
            If HoTen = '' Then
                q := False
            Else
                Begin
                   Write('-Nam sinh: ');
                  Readln(NamSinh);
                  Write('-Chuc vu: ');
                  Readln(Chucvu);
                  Write('-Bac luong: ');
                  Readln(BacLuong);
                  Write(f,Nv);
               End;
          End;
      Repeat
          GotoXY(28,24);
         Write('Co can sua khong? (c/k) ');
         Readln(Ch);
         If UpCase(Ch) = 'C' Then
             Begin
                Write('-Thay doi so thu tu : ');
               Readln(Stt);
               If Stt >= 1 Then
                   Begin
                      Seek(f,Stt-1);
                     With Nv Do
                         Begin
                            Write('-Ho ten CBCNV : ');
                           Readln(HoTen);
                            Write('-Nam sinh: ');
                              Readln(NamSinh);
                              Write('-Chuc vu: ');
                              Readln(Chucvu);
                              Write('-Bac luong: ');
                              Readln(BacLuong);
                              Write(f,Nv);
                        End;
                  End;
            End;
      Until UpCase(Ch) = 'K';
   Close(f)
End.
115/Trộn tập tin:
Code:
Program Tron_Tap_tin;
Uses Crt;
Var
    f1,f2,f3 : File Of Integer;
   So1,So2 : Integer;
   i : Integer;
   Ch : Char;
   ok1,ok2 : Boolean;
{--------------------------------}
    Function Layso1(Var So1 : Integer): Boolean;
   Begin
       If Not EOF(f1) Then
          Begin
             Read(f1,So1);
            LaySo1 := True;
         End
      Else
          layso1 := False;
   End;
{--------------------------------}
   Function Layso2(Var So2 : Integer): Boolean;
   Begin
       If Not EOF(f2) Then
          Begin
             Read(f2,So2);
            LaySo2 := True;
         End
      Else
          layso2 := False;
   End;
{--------------------------------}
BEGIN
    Assign(f1,'so1.dat');
   Rewrite(f1);
   ClrScr;
   Writeln('NHAP TAP TIN SO1');
   Writeln('----------------');
   Writeln;
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So1);
      Write(f1,so1);
      Write('-Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) = 'K';
   Close(f1);
   Assign(f2,'so2.dat');
   Rewrite(f2);
   ClrScr;
   Writeln('NHAP TAP TIN SO2');
   Writeln('----------------');
   Writeln;
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So2);
      Write(f2,so2);
      Write('-Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) = 'K';
   Close(f2);
   Assign(f3,'so3.dat');
   Rewrite(f3);
   Reset(f1);
   Reset(f2);
   ok1 := Layso1(So1);
   ok2 := Layso2(so2);
   While ok1 Or ok2 Do
       Begin
          If ok1 And ok2 Then {co ca 2 tap tin}
             Begin
                If So1 < So2 Then
                   Begin
                      Write(f3,so1);
                     ok1 := layso1(so1);
                  End
               Else
                   Begin
                      Write(f3,so2);
                     ok2 := Layso2(so2);
                  End;
            End
         Else
             If ok1 Then   {chi con tap tin so1.dat}
                Begin
                   Write(f3,so1);
                  ok1 := layso1(so1);
               End
            Else
                If ok2 Then   {chi con tap tin so2.dat}
                   Begin
                      Write(f3,so2);
                     ok2 := Layso2(so2);
                  End;
      End;
   Writeln;
   Reset(f3);
   While not EOF(f3) Do
       Begin
          Read(f3,i);
         Write(i:6);
      End;
   Close(f1);
   Close(f2);
   Close(f3);
   Writeln;
   Write('Da tron xong, bam <Enter>... ');
   Readln
END.
116/Đội tuyển:
Code:
Program Doi_Tuyen;
Uses Crt;
Type
    HocSinh = RECORD
       HoTen : String[24];
      Lop : String[4];
      Dtb : Real;
      End;
   Fhs = File Of HocSinh;
Var
    f : Fhs;
   Ch : Char;
{----------------------------------}
    Procedure Nhap(Var f : Fhs);
   Var
       Tam : HocSinh;
   Begin
       Rewrite(f);
      Repeat
          Write('-Nhap ho ten (0 de thoat): ');
            Readln(Tam.Hoten);
            If Tam.HoTen <> '0' Then
                Begin
                Write('-Lop: ');
               Readln(Tam.Lop);
               Write('-Diem trung binh: ');
               Readln(Tam.Dtb);
               Write(f,Tam);
                End;
      Until tam.HoTen ='0';
   Close(f);
   End;
{----------------------------------}
   Procedure Lapds(Var f:Fhs);
   Var
       Tam    : Hocsinh;
      a      : Array[1..1000] Of HocSinh;
      TenLop : Array[1..100] Of String[4];
      alop   : Array[1..200] Of HocSinh;
      Sohs12,Solop12,Sohslop : Integer;
      Stt    : Integer;
      i,j,k  : Integer;
      Coroi  : Boolean;
   Begin
       Reset(f);
      Sohs12 := 0;
      Solop12 := 0;
      While Not EOF(f) Do
          Begin
             Read(f,tam);
            If (Tam.Lop[1]='1') And (Tam.Lop[2]='2') Then
                Begin
                   Sohs12 := Sohs12 + 1;
                  a[Sohs12] := Tam;
                  Coroi := False;
                  For i := 1 To Solop12 Do
                      If Tenlop[i] = Tam.Lop Then
                         Coroi := True;
                  If Not coroi Then
                      Begin
                         Solop12 :=Solop12+1;
                        TenLop[Solop12] := Tam.Lop;
                     End;
               End;
         End;
      Writeln('|','STT','|','HO VA TEN':24,'|','  LOP  ','|','  HANG  ','|');
      Stt := 1;
      For i := 1 to Solop12 Do
          Begin
             Sohslop := 0;
            For j := 1 To Sohs12 Do
                If a[j].Lop = Tenlop[i] Then
                   Begin
                      Sohslop := Sohslop + 1;
                     alop[sohslop]:=a[j];
                  End;
            For k := 1 To Sohslop - 1 Do
                For j := sohslop DownTo k + 1 Do
                   If alop[j].Dtb > alop[j-1].Dtb Then
                      Begin
                         Tam := alop[j];
                        alop[j] := alop[j-1];
                        alop[j-1] := Tam;
                     End;
                  If Sohslop >=3 Then
                      For k := 1 To 3 Do
                         Begin
                            With alop[k] Do
                           Writeln('|',stt:3,' |',HoTen:24,' | ',
                                            Lop:5,' | ',k : 3,' |');
                           Stt := Stt + 1;
                        End
                  Else
                      For k := 1 To Sohslop Do
                         Begin
                            With alop[k] Do
                               Writeln('|',stt:3,' |',HoTen:24,' | ',
                                            Lop:5,' | ',k : 3,' |');
                              Stt := Stt + 1;
                        End;
         End;
      Close(f);
   End;


{----------------------------------}
BEGIN
    Assign(f,'doituyen.dat');
   Repeat
       Repeat
          Writeln('1-Nhap du lieu');
         Writeln('2-Danh sach doi du tuyen');
         Writeln('3-Ket thuc');
         Ch := Readkey;
      Until ch in ['1'..'3'];
      Case Ch Of
          '1' : Nhap(f);
         '2' : Lapds(f);
      End;
   Until Ch = '3';
END.
117/Tạo tập tin có kiểu:
Code:
Program Tao_Tap_Tin_Co_Kieu;
Type
    HocSinh = RECORD
       Ten : String[7];
      Diem : 0..10;
      End;
Var
    f : File Of Hocsinh;
{-------------------------------}
    Procedure TaoTapTin;
   Var
       Tam : HocSinh;
      Filename : String;
   Begin
       Write('-Cho biet ten tap tin: ');
      Readln(Filename);
      Assign(f,Filename);
      {$I-}
      Rewrite(f);


      {$I+}
      If IOResult <> 0 Then
          Begin
             Writeln('Khong mo duoc tap tin: ',Filename);
            Halt;
         End;
      Repeat
          Write('Ten (bam <Enter> de cham dut) : ');
         Readln(Tam.Ten);
            If Tam.Ten <> '' Then
             Begin
                Write('-Diem : ');
               Readln(Tam.Diem);
               Write(f,Tam);
            End;
      Until Tam.Ten = '';
      Close(f);
   End;
{-------------------------------}
   Procedure XemLaiBanGhi;
   Var
       RecNo : Word;
      Tam : HocSinh;
   Begin
       Write('-Xem lai ban ghi thu may: ');
      Readln(RecNo);
      Reset(f);
      Seek(f,RecNo-1);
      Read(f,Tam);
      Writeln('-Ten  : ',Tam.Ten);
      Writeln('-Diem : ',Tam.Diem);
   End;
{-------------------------------}
BEGIN
    TaoTapTin;
   Writeln;
   XemLaiBanGhi;
   Writeln;
   Write('    Bam <Enter>... ');
   Readln;
END.
118/Tạo danh sách:
Code:
Program Tao_Danh_Sach;
Type
    HocSinh = RECORD
       Ten : String[7];
      Diem : 0..10;
      End;


   T_pList = ^T_List;
   T_List = RECORD
       d : HocSinh;
      Next : T_pList;
      End;
Var
    f : File Of Hocsinh;
   First : Pointer;
   Curr, News : T_pList;
{-------------------------------}
    Procedure MoTapTin;
   Var
      Filename : String;
   Begin
       Write('-Cho biet ten tap tin: ');
      Readln(Filename);
      Assign(f,Filename);
      {$I-}
      Reset(f);


      {$I+}
      If IOResult <> 0 Then
          Begin
             Writeln('Khong mo duoc tap tin: ',Filename);
            Halt;
         End;
   End;
{-------------------------------}
    Procedure DocVaoList;
   Begin
       First := Nil;
      While NOt EOF(f) Do
          Begin
             New(News);
            News^.Next := Nil;
            Read(f,News^.d);
            If First = Nil Then
                First := News
            Else
                Curr^.Next := News;
            Curr := News;
         End;
      Close(f);
   End;
{-------------------------------}
   Procedure Xem;
   Begin
       Curr :=First;
      While Curr <> Nil Do
          Begin
             Writeln('-Ten: ',Curr^.D.Ten : 6, #32:10,
                '-Diem : ',Curr^.D.Diem);
            Curr := Curr^.Next;
         End;
   End;
{-------------------------------}
BEGIN
    MoTapTin;
   Writeln;
   DocVaoList;
   Writeln;
   Xem;
   Writeln;
   Write('    Bam <Enter>... ');
   Readln;
END.
119/Dự đoán bóng đá:
Code:
Program Du_Doan_Bong_Da;
Type
    Doi = RECORD
       Diem,hlv,tm,hv,ct,sb : Real;
      Ten : String[24];
      Hang : Integer;
      End;
   Filedb = file Of Doi;
   Mang = Array[1..40] Of Doi;
Var
    f : Filedb;
   i,j,n : Integer;
   a : Mang;
   t : Doi;
   q : Boolean;
Begin
    i := 1;
   q := True;
   While q Do
       With a[i] Do
          Begin
             Write('-Ten doi (bam <Enter> de ngung): ');
            Readln(Ten);
            If Ten = '' Then
                q := False
            Else
                Begin
                   Repeat
                      Write('=Diem huan luyen vien: ');
                     Readln(hlv);
                  Until hlv <=30;
                  Repeat
                      Write('=Diem thu mon: ');
                     Readln(tm);
                  Until tm <= 15;
                  Repeat
                      Write('=Diem hau ve: ');
                     Readln(hv);
                  Until hv <= 30;
                  Repeat
                      Write('=Diem cac cau thu khac: ');
                     Readln(ct);
                  Until ct <= 50;
                  Repeat
                      Write('=Diem thuan loi san bai: ');
                     Readln(sb);
                  Until sb <= 20;
                  Diem := hlv + hv + tm + ct + sb;
                  i := i + 1;
               End;
         End;
      n := i - 1;
      For i := 1 To N - 1 Do
          For j := 1 To N - i Do
             If a[j].Diem < a[j+1].Diem then
                Begin
                   t :=a[j];
                  a[j] := a[j+1];
                  a[j+1] := t;
               End;
      Assign(f,'diemdb.dat');
      Rewrite(f);
      For i := 1 to N Do
          Begin
             If (i > 1) And (a[i].Diem = a[i-1].Diem) Then
                a[i].Hang := a[i-1].Hang
            Else
                a[i].Hang := i;
            Write(f,a[i]);
         End;
      Close(f);
End.
120/Cắt tập tin:
Code:
Program Cat_Tap_tin;
Var
    f,g1,g2 : File;
   Buf : Array[1..63000] Of Byte;
   Trungdiem : LongInt;
{-------------------------------------}
    Procedure BaoLoi;
   Begin
       Writeln('Khong mo duoc tap tin');
      Halt;
   End;
{-------------------------------------}
    Procedure MoTapTin;
   Var
       TenTT,TenTT1,TenTT2: String;
   Begin
       Write('-Ten tap tin nguon: ');
      Readln(TenTT);
      Write('-Ten tap tin dich 1: ');
      Readln(TenTT1);
      Write('-Ten tap tin dich 2: ');
      Readln(TenTT2);
      Assign(f,TenTT);
      Reset(f,1);
      Assign(g1,TenTT1);
      Rewrite(g1,1);
      Assign(g2,TenTT2);
      Rewrite(g2,1);
      If IOResult <> 0 Then
          BaoLoi;
   End;
{-------------------------------------}
   Procedure TinhTrungDiem;
   Begin
       TrungDiem := (Filesize(f) Div 2);
   End;
{-------------------------------------}
    Procedure ChepNuaDau;
   Var
       S : LongInt;
      Num,SoDoc,SoGhi : Word;
   Begin
       S :=TrungDiem;
       Repeat
           If Sizeof(Buf) <= S Then
              Num := Sizeof(Buf)
          Else
              Num := S;
          BlockRead(f,Buf, Num,SoDoc);
          If IOResult <> 0 Then
              BaoLoi;
          BlockWrite(g1,Buf,SoDoc,SoGhi);
          If IOResult <> 0 Then
              BaoLoi;
          Dec(S,Num);
       Until S = 0;
       Close(g1);
   End;
{-------------------------------------}
    Procedure ChepNuaSau;
   Var
      SoDoc,SoGhi : Word;
   Begin
       Seek(f,TrungDiem);
      If IOResult <> 0 Then
          BaoLoi;
       Repeat
          BlockRead(f,Buf, Sizeof(Buf),SoDoc);
          If IOResult <> 0 Then
              BaoLoi;
          BlockWrite(g2,Buf,SoDoc,SoGhi);
          If IOResult <> 0 Then
              BaoLoi;
       Until (SoDoc = 0) Or (SoGhi <> SoDoc);
       Close(g2);
      Close(f);
   End;
{-------------------------------------}
BEGIN
    MoTapTin;
   TinhTrungDiem;
   ChepNuaDau;
   ChepNuaSau;
   Writeln;
   Write('Da thuc hien xong, bam <Enter>... ');
   Readln;
END.
121/Tạo menu:
Code:
Program Menu;
Uses Crt;
Type
    St17 = String[17];
   St7 = String[7];
   HoSo = RECORD
       Holot : St17;
      Ten   : St7;
      ns    : Integer;
      Diem  : Real
      End;
   Mang = Array[1..100] Of HoSo;
   fhs = File Of HoSo;
Var
    Filename : String[11];
   f : fhs;
   Tam : HoSo;
   Ch : Char;
{----------------------------------}
    Procedure Nhap(Var f : fhs);
   Begin
       Rewrite(f);
      With Tam Do
          Repeat
             Write('-Ho lot (0 de ket thuc): ');
            Readln(Holot);
            If Holot <> '0' Then
                Begin
                   Write('-Ten: ');
                  Readln(Ten);
                  Write('-Nam sinh: ');
                  Readln(Ns);
                  Write('-Diem: ');
                  Readln(Diem);
                  Write(f,tam);
               End;
         Until HoLot = '0';
         Close(f);
   End;
{----------------------------------}
   Procedure SapXep(Var f : Fhs);
   Var
       i,j,Spt : Integer;
       ds : Mang;
   Begin
       Reset(f);
      Spt := 0;
      While Not EOF(f) Do
          Begin
             Spt := Spt + 1;
            Read(f,ds[spt]);
         End;
      For i := 1 To spt - 1 Do
          For j := spt Downto i + 1 Do
             If ds[j].Ten[1] < ds[j-1].Ten Then
                Begin
                   Tam := ds[j];
                  ds[j] := ds[j-1];
                  ds[j-1] := Tam;
               End;
      Rewrite(f);
      For i := 1 To spt Do
          Write(f,ds[i]);
      Close(f);
      Writeln;
      Write('Da sap xep xong, bam <Enter>... ');
      Readln;
   End;
{----------------------------------}
   Procedure Xem(Var f : Fhs);
   Begin
       ClrScr;
      Writeln('       HO VA TEN              DIEM');
      Reset(f);
      While Not EOF(f) Do
          Begin
             Read(f,Tam);
            With Tam Do
                Writeln(Holot:17,' ',Ten:7,'      ',Diem:6:1);
         End;
      Readln;
   End;
{----------------------------------}
   Procedure CapNhat(Var f : Fhs);


{--------------------}
   Procedure Sua(Var f:Fhs);
   Var
       Holot1 : St17;
      Ten1 : St7;
      TimThay : Boolean;
   Begin
       Repeat
          Write('-Holot: ');
         Readln(Holot1);
         Write('-Ten  : ');
         Readln(Ten1);
         TimThay := False;
         Reset(f);
         While Not EOF(f) Do
             With Tam Do
                 Begin
                    Read(f,Tam);
                   If (Holot = Holot1) And (Ten = Ten1) Then
                       Begin
                          Timthay := True;
                         Writeln(Holot,' ',Ten,' Diem : ',Diem : 0:1);
                         Repeat
                             Writeln('Co sua khong ? (c/k) ');
                            Ch := Readkey;
                         Until Ch in['c','C','k','K'];
                         If Upcase(Ch) = 'C' Then
                             Begin
                                Write('-Ho lot: ');
                               Readln(Holot);
                               Write('-Ten   : ');
                               Readln(Ten);
                               Write('-Nam sinh : ',ns);
                               Write('-Diem : ');
                               Readln(Diem);
                               Seek(f,filepos(f)-1);
                               Write(f,Tam);
                            End;
                      End;
                End;
               If Not TimThay Then
                   Writeln('Khong tim thay');
               Repeat
                   Writeln('Tim nu khong ? (c/k) ');
                  Ch := Readkey;
               Until Ch in['c','C','k','K'];
      Until Upcase(Ch) = 'K'
   End;
{--------------------}
   Procedure Them(Var f: Fhs);
   Begin
       Reset(f);
      Seek(f,Filesize(f));
      With Tam Do
          Repeat
             Write('-Ho lot: ');
            Readln(Holot);
            Write('-Ten   : ');
            Readln(Ten);
            Write('-Nam sinh : ',ns);
            Write('-Diem : ');
            Readln(Diem);
            Write(f,Tam);
            Repeat
                Writeln('Them nua khong ? (c/k) ');
               Ch := Readkey;
            Until Ch in['c','C','k','K'];
         Until Upcase(Ch) = 'K';
   End;
{-------------------}
   Procedure Xoa(Var f : Fhs);
   Var
       ds : Mang;
      Holot1 : St17;
      Ten1 : St7;
      i,spt,vitri : Integer;
      TimThay : Boolean;
   Begin
       Reset(f);
      spt := 0;
      While Not EOF(f) Do
          Begin
             Read(f,Tam);
            spt := spt + 1;
            ds[spt] := Tam;
         End;
      Repeat
          Write('-Ho lot : ');
         Readln(holot1);
         Write('-Ten   : ');
         Readln(Ten1);
         TimThay := False;
         i := 0;
         Repeat
             i := i + 1;
            If (ds[i].Holot = Holot1) And (ds[i].Ten = Ten1) Then
                Begin
                   TimThay := True;
                  vitri := i;
               End;
         Until TimThay Or (i > spt);
         If TimThay Then
             Begin
                With ds[vitri] Do
                   Writeln(Holot,' ',Ten,' Diem: ',Diem:0:1);
                  Repeat
                      Writeln('Co xoa khong ? (c/k) ');
                     Ch := Readkey;
                  Until Ch in['c','C','k','K'];
                  If Upcase(Ch) = 'C' Then
                      Begin
                         spt := spt - 1;
                        For i := vitri To spt Do
                            ds[i] := ds[i+1];
                     End;
            End
         Else
             Writeln('Khong tim thay');
         Repeat
             Writeln('Tim nua khong ? (c/k) ');
            Ch := Readkey;
         Until Ch in['c','C','k','K'];
      Until Upcase(Ch) = 'K';
      Rewrite(f);
      For i := 1 To spt Do
          Write(f,ds[i]);
      Close(f);
   End;
   {-----Chuong trinh chiinh cua cap nhat-------}
   Begin
       Repeat
          Repeat
             ClrScr;
            Writeln('  MENU CAP NHAT  ');
            Writeln('1-Sua');
            Writeln('2-Them');
            Writeln('3-Xoa');
            Writeln('4-Thoat');
            Ch := Readkey;
         Until Ch in['1'..'4'];
         Case Ch Of
             '1' : Sua(f);
            '2' : Them(f);
            '3' : Xoa(f);
         End;
      Until Ch = '4'
   End;
 {************ CHUONG TRINH CHINH ***********}
 BEGIN
     ClrScr;
   Write('-Ten tap tin : ');
   Readln(Filename);
   Assign(f,Filename);
   Repeat
       Repeat
          ClrScr;
         Writeln('      MENU CHINH');
         Writeln('   1-Nhap');
         Writeln('   2-Sap xep');
         Writeln('   3-Xem');
         Writeln('   4-Cap nhat');
         Writeln('   5-Ket thuc');
         Writeln;
         Ch := Readkey;
      Until ch in['1'..'5'];
      Case Ch Of
          '1' : Nhap(f);
         '2' : SapXep(f);
         '3' : Xem(f);
         '4' : CapNhat(f);
      End;
   Until Ch = '5'
 END.
122/Độ dài của dòng:
Code:
Program D0_Dai_Cua_Dong;
Var
    f : Text;
   Filename : String[12];
   St : String;
   Max,Min: Integer;
   Sodong,Tong : Integer;
Begin
    Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f,Filename);
   Reset(f);
   Readln(f,St);
   Max := length(St);
   Min := Length(St);
   Sodong := 1;
   Tong := Length(St);
   While Not EOF(f) Do
       Begin
          Readln(f,St);
         If Max < Length(St) Then
             Max := Length(St);
         If Min > Length(St) Then
             Min := Length(St);
         Sodong := sodong + 1;
         Tong := Tong + Length(St);
      End;
   Writeln('-Dong dai nhat  : ',Max);
   Writeln('-Dong ngan nhat : ',Min);
   Writeln('-Trung binh     : ',Tong / Sodong : 6:1);
   Writeln;
   Write('Bam <Enter>... ');
   Readln
End.
123/Điểm Sản phẩm:
Code:
Program Diem_San_Pham;
Uses Crt;
Var
    f : Text;
   Nhom : Char;
   d1,d2 : Real;
   TongA1,TongA2 : Real;
   TongB1,TongB2 : Real;
   TongC1,TongC2 : Real;
   SoA,SoB,SoC : Integer;
   i : Integer;
Begin
    Assign(f,'sanpham.txt');
   Rewrite(f);
   Writeln(f,'Nhom nguoi',' San pham 1 ','  San pham 2  ');
   Writeln(f);
   ClrScr;
   Repeat
       Write('Nhom nguoi ($ de thoat): ');
      Readln(Nhom);
      If Nhom <> '$' Then
          Begin
             Write('-Diem san pham 1 : ');
            Readln(d1);
            Write('-Diem san pham 2 : ');
            Readln(d2);
            Writeln(f,Upcase(Nhom):6,d1:16:1,d2:16:1);
         End;
   Until Nhom = '$';
   Close(f);
   ClrScr;
   Reset(f);
   Readln(f);
   Readln(f);
   TongA1 := 0;TongA2 := 0;SoA := 0;
   TongB1 := 0;TongB2 := 0;SoB := 0;
   TongC1 := 0;TongC2 := 0;SoC := 0;
   While Not EOF(f) Do
       Begin
          For i := 1 To 6 Do {So vong lap bang vi tri cua nhom }
             Read(f,Nhom);
         Readln(f,d1,d2);
         Case Nhom Of
             'A' : Begin
                      TongA1 := TongA1 + d1;
                     TongA2 := TongA2 + d2;
                     SoA := SoA + 1;
                  End;
            'B' : Begin
                      TongB1 := TongB1 + d1;
                     TongB2 := TongB2 + d2;
                     SoB := SoB + 1;
                  End;
            'C' : Begin
                      TongC1 := TongC1 + d1;
                     TongC2 := TongC2 + d2;
                     SoC := SoC + 1;
                  End;
         End;
      End;
      ClrScr;
      Writeln('NHOM NGUOI',' TB San pham 1',' TB San pham 2');
      Writeln;
      If SoA <> 0 Then
          Writeln('A':6,TongA1/SoA:16:1,TongA2/SoA:16:1);
        If SoB <> 0 Then
          Writeln('B':6,TongB1/SoB:16:1,TongB2/SoB:16:1);
      If SoC <> 0 Then
          Writeln('C':6,TongC1/SoC:16:1,TongC2/SoC:16:1);
      Readln
End.
124/Đếm chử:
Code:
Program DemChu;
Uses Crt;
Type
    MangChu = Array[Char] Of Integer;
Var
   f : Text;
    Filename : String;
   Line : String[25];
   Chu : Char;
   Letters,Lines,k : Integer;
   Dem : MangChu;
Begin
    ClrScr;
   For Chu := Chr(0) To Chr(127) Do
       Dem[chu] := 0;
   Letters := 0;
   Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f,Filename);
   Reset(f);
   While Not EOF(f) Do
      Begin
          Readln(f,Line);
         For k := 1 To Length(line) Do
             Begin
                If Line[k] In ['a'..'z'] Then
                   Letters := Letters + 1;
               Dem[Line[k]] := Dem[Line[k]] + 1;
            End;
      End;
    Lines := 1;
    Close(f);
    Writeln('Tap tin: ',Filename,' co tat ca: ',Letters,' chu khong viet hoa');
    Writeln;
    Writeln('Phan phoi tan suat cua cac chu nhu sau:');
    Writeln;
    For Chu :='a' To 'z' Do
        Begin
          Write('-Chu: ',Chu,' = ');
         Write((Dem[chu]/Letters * 100):6:2,' % ');
         If (Lines Mod 4) = 0 Then
             Writeln;
         Lines := Lines + 1;
      End;
   Readln
End.
125/Tạo tập tin văn bản:
Code:
Program Tao_Tap_Tin_Van_Ban;
Var
    f : Text;
   Filename : String;
{---------------------------------}
    Procedure Timvb(Var f: text; n : Word);
   Var
       i : Word;
   Begin
       Reset(f);
      For i :=1 To n Do
      Readln(f);
   End;
{---------------------------------}
   Procedure MoTapTin;
   Begin
       Write('-Cho biet ten tap tin van ban: ');
      Readln(Filename);
      {$I-}
      Assign(f,Filename);
      Rewrite(f);
      If IOResult <> 0 Then
          Begin
             Writeln('Khong the mo tap tin moi: '+Filename+' ');
            Halt;
         End;
   End;
{---------------------------------}
    Procedure Nhap4dong;
   Var
       Tam : String;
      i : Byte;
   Begin
       Writeln;
        Writeln;
      For i := 1 to 4 Do
          Begin
             Write('-Nhap dong thu: ',i:2,' : ');
            Readln(Tam);
            Writeln(f,Tam);
         End;
   End;
{---------------------------------}
   Procedure Xuatdong2;
   Var
       Tam : String;
   Begin
       Timvb(f,2);
      Readln(f,Tam);
      Writeln('Dong thu 3 cua tap tin co noi dung la: ');
      Writeln;
      Writeln('     ',Tam);
   End;
{---------------------------------}
BEGIN
    MoTapTin;
   Nhap4dong;
   Writeln;
   Xuatdong2;
   Writeln;
   Write(' Bam <Enter>... ');
   Readln;
END.
126/Xóa dòng tập tin văn bản:
Code:
Program Xoa_Dong_Tap_Tin_Van_Ban;
Var
    f : Text;
   Filename : String;
{---------------------------------}
   Procedure MoTapTin;
   Var
       Tam : String;
      i : Byte;
   Begin
       Write('-Cho biet ten tap tin van ban: ');
      Readln(Filename);
      {$I-}
      Assign(f,Filename);
      Rewrite(f);
      {$I+}
      If IOResult <> 0 Then
          Begin
             Writeln('Khong the mo tap tin moi: '+Filename+' ');
            Halt;
         End;
       For i := 1 to 4 Do
             Begin
                Write('-Nhap dong thu: ',i:2,' : ');
             Readln(Tam);
              Writeln(f,Tam);
          End;
      Close(f);
   End;
{---------------------------------}
   Procedure XemTapTin(Var f : Text);
   Var
       Tam : String;
   Begin
       Reset(f);
      While Not EOF(f) Do
          Begin
             Readln(f,Tam);
            Writeln(Tam);
         End;
   End;
{---------------------------------}
    Procedure Xoadong(Var f : Text; n : Word);
   Var
      g : Text;
       Tam : String;
      i : Word;
   Begin
       Assign(g,Filename);
       Reset(g);
      Assign(f,'XOADONG.TXT');
       Rewrite(f);
       i := 0;
       While Not EOF(g) Do
           Begin
              Readln(g,Tam);
             If i <> n Then
                 Writeln(f,Tam);
            Inc(i);
          End;
       Close(f);
   End;
{---------------------------------}


BEGIN
    MoTapTin;
   Writeln;
   Writeln('        Noi dung tap tin da tao');
   Writeln;
   XemTaptin(f);
   Writeln;
   Xoadong(f,2);
   Writeln('      Noi dung con lai sau khi xoa dong 3');
   Writeln;
   XemTapTin(f);
   Writeln;
   Write(' Bam <Enter>... ');
   Readln;
END.
127/Xóa chú thích:
Code:
Program Xoa_chu_thich;
Var
    Filename : String;
   f,fn : Text;
   Ch : Char;
Begin
    Write('-Ten tap tin Pascal: ');
   Readln(Filename);
   Assign(f,Filename);
   Assign(fn,'new.pas');
   reset(f);
   Rewrite(fn);
   While not EOF(f) Do
       Begin
          Read(f,ch);
         If Ch <> '{' Then
             Write(fn,ch)
         Else
             Repeat
                Read(f,ch);
            Until (Ch = '}') Or EOF(f);
      End;
   Close(f);
   Close(fn);
   Writeln;
   Write('Da thuc hien xong, bam <Enter>... ');
   Readln;
End.
128/Tìm chuỗi kí tự:
Code:
Program Tim_Chuoi_Ky_Tu;
Var
    Filename : String[12];
   f : Text;
   St : String;
   Ch : Char;
   Ok : Boolean;
   i,solan:Integer;
Begin
    Write('-Ten tap tin: ');
   Readln(Filename);
   Write('-Nhap chuoi ky tu: ');
   Readln(St);
   Assign(f,Filename);
   Reset(f);
   Solan := 0;
   While NOt EOF(f) Do
       Begin
          Read(f,Ch);
         If ch = St[1] Then
             Begin
                Ok := True;
               i := 1;
               While Not OK And ( i < length(St)) Do
                   Begin
                      Read(f,Ch);
                     If (Ch <> Chr(10)) And (Ch <> Chr(13)) Then
                         If Ch = St[1] Then
                            i := 1
                        Else
                            Begin
                               i := i + 1;
                              If (Ch <> St[i]) Then
                                  Ok := False;
                           End;
                  End;
               If Ok Then
                   Solan := Solan + 1;
            End;
      End;
   Write('-Chuoi: ',St,' xuat hien : ',solan,' lan trong tap tin');
   Readln;
   Close(f);
End.
129/Xử lí dòng:
Code:
Program Xu_ly_dong;
Var
    f1,f2 : Text;
   Filename : String[12];
   lmax : Integer;
   Tam,st,dong : String;
{--------------------------------------}
    Procedure Catdong(Var st,dong:String;lmax :Integer);
   Var
       i : Integer;
   Begin
       i := lmax;
      While st[i] <> ' ' Do
          i:= i-1;
         Dong := copy(st,1,i-1);
         Delete(St,1,i);
   End;
{--------------------------------------}
   Procedure Lamday(Var dong: String;lmax : Integer);
   Var
       i,j : Integer;
   Begin
       i := lmax - length(dong);
      While  i <> 0 Do
          Begin
             j := Length(dong);
            While (j > 1) And (i <> 0) Do
                If (dong[j]=' ') And (dong[j-1] <> ' ') Then
                   Begin
                      Insert(' ',dong,j);
                     j :=j-1;
                     i := i-1;
                  End
               Else
                   j := j-1;
         End;
   End;
{--------------------------------------}
BEGIN
    Write('-Ten tap tin: ');
   Readln(Filename);
   Write('-Chieu dai cua dong: ');
   Readln(lmax);
   Assign(f1,filename);
   Reset(f1);
   Assign(f2,'new.txt');
   Rewrite(f2);
   St:=' ';
   While NOt EOF(f1) Do
       Begin
          Readln(f1,tam);
         St := St + Tam + ' ';
         While length(St) >= lmax Do
             Begin
                Catdong(St,dong,lmax);
               Lamday(dong,lmax);
               Writeln(f2,dong);
            End;
      End;
   Writeln(f2,St);
   Writeln;
   Writeln('Da thuc hien xong, bam <Enter>... ');
   Readln;
   reset(f2);
   While Not EOF(f2) Do
       Begin
          Readln(f2,dong);
         Writeln(dong);
      End;
    Writeln;
   Write('    Xem xong bam <Enter>... ');
   Readln;
   Close(f1);
   Close(f2);
END.
130/Chạy chử:
Code:
Program Chay_Chu;
Uses Crt;
Var
    St : String;
   n,i,j : Integer;
Begin
    ClrScr;
   Write('Nhap mot chuoi ky tu: ');
   Readln(St);
   ClrScr;
   n := 40-(Length(St) Div 2);
   For j := 1 To Length(St) Do
       For i := 80 DownTo n+j Do
          Begin
             GotoXY(i,12);
            Write(St[j]);
            ClrEoL;
            Sound(400+j*200);
            Delay(30);
            Nosound;
         End;
   Readln;
End.
131/Đường thẳng:
Code:
Program Duong_Thang;
Uses Graph;
Var
    Gd,Gm,k : Integer;
Begin
    Gd :=Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   SetBkColor(Blue);
   k := -300;
   Repeat
       SetColor(14);
       MoveTo(160,100);
      LineRel(k,100);
      LineRel(k,-100);
      MoveTo(160,100);
      LineRel(k,-100);
      LineRel(k,100);
      k := k+15;
   Until k = 0;
   Repeat
       Line(k,0,k,200);
      k := k-15;
   Until k = 0;
   Line(0,100,320,100);
   Readln;
   CloseGraph;
End.
132/Chùm đường thẳng đồng quy:
Code:
Program Chum_duong_thang_dong_quy;
Uses Crt,Graph;
Var
    Palette : PaletteType;
   Gd,Gm,k,i : Integer;
   Color : Word;
   Tri : String[4];
Begin
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   Str(GetColor: 2,Tri);
   OutTextXY(10,10,Tri);
   With Palette Do
       Begin
          Size := 4;
         Colors[0] := White;
         Colors[1] := Red;
         Colors[2] := Blue;
         Colors[3] := Magenta;
         SetAllPalette(Palette);
      End;
   SetBkColor(LightBlue);
   Randomize;
   k := 1;
   Repeat
       Color := Succ(GetColor);
      If Color > Palette.Size Then
          Color := 2;
      SetColor(Color);
      i := k Mod 4;
      SetLineStyle(i,0,3);
      LineTo(Random(GetMaxX),Random(GetMaxY));
      Delay(100);
      k := k+1;
   Until k =15;
   SetColor(1);
   OutTextXY(10,100,'Chao mung nam 2000');
   Delay(2000);
   CloseGraph;
End.
133/Đa giác:
Code:
Program Da_Giac;
Uses Graph;
Const M : Array[0..5] Of PointType = ((x:0;y:10),(x:53;y:29),
          (x:112;y:134),(x:65;y:100),(x:34;y:100),(x:0;y:10));
Var
    Gd,Gm : Integer;
Begin
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   DrawPoly(7,M);
   Readln;
   CloseGraph;
End.
134/Vòng Olympic:
Code:
Program Vong_Olympic;
Uses Graph;
Var
    Gd,Gm:Integer;
   MaxX,MaxY:Integer;
   R : Integer;
   Y1,Y2 : Integer;
   X1,X2,X3,X4,X5 : Integer;
   Kc : Integer;
Begin
    Write('-Ban kinh = ');
   Readln(R);
   Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOK Then
       Halt(1);
   MaxX := GetMaxX;
   MaxY := GetMaxY;
   Y1 := (MaxY - 3*R) Div 2 + R;
   Y2 := Y1 + R;
   Kc := R Div 5;
   X1 := (MaxX - 6*R -2*Kc) Div 2 + R;
   X2 := X1 + Kc + 2*R;
   X3 := X2 + Kc + 2*R;
   X4 := X1 + R + (Kc Div 2);
   X5 := X2 + R + (Kc Div 2);
   SetColor(14);
   Circle(X1,Y1,R);
   Circle(X2,Y1,R);
   Circle(X3,Y1,R);
   Circle(X4,Y2,R);
   Circle(X5,Y2,R);
   Readln;
   CloseGraph;
End.
135/Hình quạt:
Code:
Program Hinh_Quat;
Uses Graph;
Var
    Gd,Gm : Integer;
   CenterX,CenterY,Radius : Word;
Begin
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   SetGraphMode(0);
   SetBkColor(Blue);
   CenterX := GetMaxX Div 2;
   CenterY := GetMaxY Div 2;
   Radius := CenterY - 10;
   SetFillStyle(2,2);
   Pieslice(CenterX,CenterY,0,120,Radius);
   SetFillStyle(3,1);
   Pieslice(CenterX,CenterY,120,245,Radius);
   SetFillStyle(4,3);
   Pieslice(CenterX,CenterY,245,360,Radius);
   Readln;
   CloseGraph;
End.
136/Biểu đồ cột:
Code:
Program Bieu_Do_Cot;
Uses Graph;
Const h = 60;
Var
    Gd,Gm : Integer;
   Socot : Integer;
   a : Array[1..100] Of Integer;
   Max : Integer;
   i : Integer;
   Mx,My : Integer;
   Xstep,Ystep : Integer;
   x : Integer;
Begin
    Write('-Tong so cot: ');
   Readln(Socot);
   For i := 1 To Socot Do
       Begin
          Write('    +Cot thu : ',i:2,' = ');
         Readln(a[i]);
      End;
   Max := a[1];
   For i := 2 To Socot Do
   If a[i] > Max Then
       Max := a[i];
   Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   Mx := GetMaxX;
   My := GetMaxY;
   Rectangle(0,0,Mx,My);
   Line(h,h,h,My-h);
   Line(h,My-h,MX-h,My-h);
   Xstep := Round((Mx-3*h)/Socot);
   Ystep := Round((My-2*h)/Max);
   x := h;
   For i := 1 To Socot Do
       Begin
          SetFillStyle(i,i);
         Bar(x,(My-h)-a[i]*Ystep,x+Xstep,My-h);
         Rectangle(x,(My-h)-a[i]*Ystep,x+Xstep,My-h);
         x := x + Xstep;
      End;
   Readln;
   CloseGraph;
End.
137/Biểu đồ PIE:
Code:
Program Bieu_Do_PIE;
Uses Graph;
Var
    Gd,Gm : Integer;
   Somuc : Integer;
   a : Array[1..100] Of Real;
   Tong,Goc : Real;
   r,i : Integer;
Begin
    Write('-Tong so muc: ');
   Readln(Somuc);
   Tong := 0;
   For i := 1 To Somuc Do
       Begin
          Write('    +Muc thu : ',i:2,' = ');
         Readln(a[i]);
         Tong := Tong + a[i];
      End;
   For i := 1 To Somuc Do
       a[i]:=(a[i]/Tong)*360;
   Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   R := GetMaxY Div 3;
   Rectangle(0,0,GetMaxX,GetMaxY);
   Goc := 0;
   For i := 1 To Somuc Do
       Begin
          SetFillStyle(i,i);
         PieSlice(GetMaxX Div 2, GetMaxY Div 2,Round(Goc),Round(Goc+a[i]),R);
         Goc := Goc + a[i];
      End;
   Readln;
   CloseGraph;
End.
138/Đồ thị:
Code:
Program Do_Thi;
Uses Graph;
Var
    Gd,Gm,j,mx,my : Integer;
   i,x,y : Real;
   Xasp,Yasp,CenterX,CenterY : Word;
   Pattern : Word;
   Palette : PaletteType;
{----------------------------------}
    Function Adjasp(Value: Integer) : Integer;
   Begin
       Adjasp := (LongInt(Value)*Xasp) Div Yasp;
   End;
{----------------------------------}
BEGIN
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt;
   SetGraphMode(0);
   SetBkColor(Blue);
   GetPalette(Palette);
   SetAllPalette(Palette);
   GetAspectRatio(Xasp,Yasp);
   CenterX := GetMaxX Div 2;
   CenterY := GetMaxY Div 2;
   SetTextJustify(CenterText,CenterText);
   SetColor(2);
   Line(0,CenterY,GetMaxX-25,CenterY);
   Line(CenterX,20,CenterX,GetMaxY);
   OutTextXY(CenterX-10,CenterY+5,'0');
   OutTextXY(GetMaxX-16,CenterY,'>X ');
   SetTextStyle(DefaultFont,VertDir,0);
   OutTextXY(CenterX,18,'>');
   SetTextStyle(DefaultFont,HorizDir,0);
   OutTextXY(CenterX,8,'Y');
   i := 0;
   SetColor(2);
   While i <= GetMaxX Do
       Begin
          x :=(i-160)/20;
         mx := Round(i);
         y := (sin(x))*(Sin(x))*(Sin(x));
         my := CenterY - Adjasp(Round(y*20));
         If abs(my) < 200 Then
             PutPixel(mx,my,14);
         i := i+(2/7);
      End;
   Rectangle(CenterX+10,CenterY+10,GetMaxX-10,GetMaxY-15);
   SetViewPort(CenterX+9,CenterY+9,GetMaxX-9,GetMaxY-16,ClipOn);
   SetTextStyle(2,0,4);
   OutTextXY(48,12,'He truc toa do');
   SetTextStyle(1,0,3);
   OutTextXY(60,40,'DESCARTES');
   Readln;
   CloseGraph;
END.
139/Cá chép miệng:
Code:
Program Ca_Chep_Mieng;
Uses Crt,Graph;
Var
    Gd,Gm : Integer;
   Active,Visual,Temp:Word;
   Xcenter,YCenter,Radius,StAngle,EndAngle : Integer;
{--------------------------------}
    Procedure Initialize;
   Begin
       Gd := Detect;
      InitGraph(Gd,Gm,'C:\BP\BGI');
      SetColor(Red);
      SetFillStyle(SolidFill,Blue);
      Xcenter := GetMaxX Div 2;
      YCenter := GetMaxY Div 2;
      StAngle := 15;
      Radius := GetMaxY Div 8;
      Active := 0;
      Visual := 1;
   End;
{--------------------------------}
    Procedure Veca;
   Begin
       if StAngle = 15 Then  {ve bung ca}
          Begin
             StAngle := 30;
            EndAngle := 330;
         End
      Else
          Begin
             StAngle := 15;
            EndAngle := 345;
         End;
      PieSlice(Xcenter,YCenter,StAngle,EndAngle,Radius);
          {ve mat ca}
      Circle(Xcenter+Radius Div 2,YCenter - Radius Div 2,4);
          {ve duoi ca}
      Line(Xcenter-Radius,Ycenter,Xcenter-2*Radius,Ycenter-Radius);
      Line(Xcenter-Radius,Ycenter,Xcenter-2*Radius,Ycenter+Radius);
   End;
{--------------------------------}
BEGIN
    Initialize;
   While Not KeyPressed Do
       Begin
          SetActivePage(Active);
         SetvisualPage(Visual);
         Veca;
         Temp := Active;
         Active := Visual;
         Visual := Temp;
      End;
END.
140/Âm thanh:
Code:
Program Am_thanh;
Uses Crt;
CONST
    Notdon=8*58;
   Notdoi=Notdon Div 2;
TYPE
    Notnhac=(c,cf,d,df,e,f,ff,g,gf,a,af,b);
Var
    Kyam:Notnhac;
   (*----------------------*)
   PROCEDURE Bannhac(Kyam:Notnhac;Caodo,Truongdo:Integer);
   Var
       Tanso:Real;
      i:Integer;
   Begin
       Tanso:=32.625;
      For i:=1 To Caodo Do
          Tanso:=Tanso * 2;
      For i:=1 To Ord(Kyam) Do
          Tanso:=Tanso * 1.05946;
      If Truongdo <> 0 Then
          Begin
             Sound(Round(Tanso));
            Delay(Truongdo);
            NoSound
         End
      Else
          Sound(Round(Tanso))
   End;
   (*----------------------*)
BEGIN
    Bannhac(c,4,Notdon);
   Bannhac(f,4,Notdon);
   Bannhac(g,4,Notdon);
   Bannhac(a,4,Notdon);
   Bannhac(a,4,Notdon);
END.
141/3 cạnh của tam giác:
Code:
Program Tam_giac;
Var
    a,b,c:Integer;
   tamgiac,deu,can:Boolean;
Begin
    Writeln('BA CANH CUA TAM GIAC ?');
   Writeln('----------------------');
   Write('-Nhap so thu nhat= ');
   Readln(a);
   Write('-Nhap so thu hai = ');
   Readln(b);
   Write('-Nhap so thu ba  = ');
   Readln(c);
   tamgiac:=False;
   deu:=False;
   can:=False;
   If (a+b>c) And (b+c>a) And (c+a>b) Then
       Begin
          tamgiac:=True;
         If (a=b) And (b=c) Then
             deu:=True;
         If (a=b) Or (b=c) Or (c=a) Then
             can:=True;
      End;
    Writeln;
   Writeln(' 3 so vua nhap la:');
   Writeln('+Tam giac: ',tamgiac);
   Writeln('+Tam giac deu: ',deu);
   Writeln('+Tam giac can: ',can);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.
142/Bài toán cổ điển:
Code:
Program Tram_trau;
Var
    dung,nam,gia,co,trau:Integer;
Begin
    Writeln('BAI TOAN CO DIEN');
   Writeln('Tram trau tram co');
   Writeln('Trau dung an 5');
   Writeln('Trau nam an 3');
   Writeln('Ba trau gia an 1');
   Writeln('----------------');
   Writeln('           Bai toan nay co cac loi giai sau');
   For dung:=0 To 20 Do
       For nam:=0 To 33-dung Do
          For gia:=0 To (100-(dung+nam)) Do
             Begin
                co:=5*dung+3*nam+(gia Div 3);
               trau:=dung+nam+gia;
               If (gia Mod 3 =0) And (trau=100) And ( co=100) Then
                   Writeln('-Trau dung ',dung,' con, -Trau nam ',nam,' con, -Trau gia ',gia,' con');
            End;
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.
143/Các hàm lượng giác:
Code:
Program Cac_ham_luong_giac;
CONST
    g='|';
   ke='--------------------------------------------------';
   Ten='               CAC HAM LUONG GIAC';
   Tde='|DO | RADIAN |   SIN  | COSIN  |  TANG  | COTANG |';
Var
    Doo:1..89;
   Rad,s,c,t,ct:Real;
Begin
    Repeat
       Write('-Nhap do (tu 1 den 89, so 0 de ngung): ');
      Readln(Doo);
      If Doo= 0 Then
          Exit;
        Writeln(Ten);
       Writeln(ke);
       Writeln(Tde);
       Writeln(ke);
       Rad:=Doo*Pi/180;
      s:=Sin(rad);
      c:=Cos(Rad);
      t:=s/c;
      ct:=c/s;
       Writeln(g,Doo:2,#248,g,Rad:8:6,g,s:8:6,g,
                            c:8:6,g,t:8:5,g,ct:8:5,g);
      Writeln(ke);
      Writeln;
   Until Doo=0;
End.
144/Bài toán gà, chó:
Code:
Program ga_cho;
Var
   x,y,n:Integer;
Begin
      n:=1;
   Writeln('* CAC LOI GIAI BAI TOAN CO DIEN GA,CHO');
   Writeln('----------------------------------');
   For x:=1 To 36 Do
      For y:=1 To (36-x) Do
         If ((x*2)+(y*4) =100) then {and ((x+y) =36) Then}
            Begin
                 Writeln('      * Loi giai thu : ',n:3);
              Write('- Ga  = ',x:2,' con = ',(x*2):2,' chan   ');
              Write('- Cho = ',y:2,' con = ',(y*4):2,' chan ');
              If x+y<36 Then
                    Writeln('Ga+Cho= ',x+y:2,' con,khong dung')
              Else If x+y=36 Then
                     Writeln('Ga+Cho= ',x+y:2,' con,loi giai dung');
                  n:=n+1;
             End;
       Writeln('      * Tong cong co: ',(n-1):3,' loi giai');
       Writeln;
       Writeln('   Bam phim <Enter> de ket thuc');
       Readln
   End.
145/Các nguyên âm, phụ âm trong 1 chuỗi:
Code:
Program Nguyen_am_Phu_am;
TYPE
    Kytu=Set of Char;
Var
    a,b,Nguyen,Phu:Kytu;
   Chuoi:String;
   i:Integer;
   Ch:Char;
Begin
    Writeln('CAC NGUYEN AM, PHU AM TRONG MOT CHUOI');
   Writeln('-------------------------------------');
   Write('-Nhap mot chuoi ky tu: ');
   Readln(Chuoi);
   a:=['a','e','i','o','u','A','E','I','O','U'];
   b:=['a'..'z','A'..'Z'] - a;
   Nguyen:=[];
   Phu:=[];
   For I:=1 To Length(Chuoi) Do
       Begin
          If Chuoi[i] In a Then
             Nguyen:=Nguyen + [Chuoi[i]];
         If Chuoi[i] In b Then
             Phu:=Phu +[Chuoi[i]];
      End;
   Writeln;
   Writeln('*Chuoi nay co cac nguyen am sau day:');
   Write('     ');
   For Ch:='A' To 'z' Do
       If Ch In Nguyen Then
          Write(Upcase(ch),', ');
   Writeln;
   Writeln('*Chuoi nay co cac phu am sau day:');
   Write('     ');
   For Ch:='A' To 'z' Do
       If Ch In Phu Then
          Write(Upcase(Ch),', ');
   Writeln;
   Writeln;
   Write('    Bam phim <Enter> de ket thuc ');
   Readln
End.
146/Các phép toán trong tập hợp:
Code:
Program Cac_phep_Toan;
TYPE
    KyTu=Set of Char;
Var
    a,b,Cong,Nhan,tru1,tru2:KyTu;
   p:Array[1..100] Of Char;
   m,n,i:Byte;
Begin
    Writeln('CAC PHEP TOAN TRONG TAP HOP');
   Writeln('---------------------------');
   a:=[];
   b:=[];
   Write('-So phan tu cua tap hop A= ');
   Readln(m);
   For i:=1 To M Do
       Begin
          Write('  -Phan tu A[',i,']= ');
         Readln(p[i]);
         a:=a + [p[i]];
      End;
   Write('-So phan tu cua tap hop B= ');
   Readln(n);
   For i:=1 To N Do
       Begin
          Write('  -Phan tu B[',i,']= ');
         Readln(p[i]);
         b:=b + [p[i]];
      End;
   Nhan:=a * b;
   Writeln('A * B gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Nhan Then
          Write(Char(i),#32);
   Writeln;
   Cong:=a + b;
   Writeln('A + B gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Cong Then
          Write(Char(i),#32);
   Writeln;
    Tru1:=a - b;
   Writeln('A - B gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Tru1 Then
          Write(Char(i),#32);
   Writeln;
    Tru2:=b - a;
   Writeln('B - A gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Tru2 Then
          Write(Char(i),#32);
   Writeln;
   If A <= B Then
       Writeln('-Tap hop A nho hon tap hop B');
    If B <= A Then
       Writeln('-Tap hop B nho hon tap hop A');
   Writeln;
   Write('   Bam phim <Enter> de ket thuc ');
   Readln
End.
147/Các phép toán:
Code:
Program Cac_phep_toan;
Var
    a,b,c,d,e,x,y,g,h,i:Integer;
Begin
    Writeln('CAC PHEP TOAN');
   Writeln('-------------');
   Writeln;
   a:=124;
   b:=12;
   Writeln(a:3,' DIV ',b:2,' = ',a DIV b);
   Writeln(a:3,' MOD ',b:2,' = ',a MOD b);
   c:=12;
   d:=22;
   Writeln(c:2,' AND ',d:2,' = ',c AND d);
   Writeln(c:2,' OR ',d:2,' = ',c OR d);
   Writeln(c:2,' XOR ',d:2,' = ',c XOR d);
   x:=2;
   g:=x Shl 7;
   Writeln('g = ',x:2,' Shl 7 = ',g);
   x:=256;
   h:=x Shr 7;
   Writeln('h = ',x:2,' Shr 7 = ',h);
   i:=g+h;
   Writeln('i = g + h = ',i);
   Writeln('Lo(i) = ',Lo(i));
   Writeln('Hi(i) = ',Hi(i));
   Writeln('Swap(i) = ',Swap(i));
   Writeln;
   Writeln('    Bam phim <Enter> de ket thuc');
   Readln
End.
148/Các số nguyên tố:
Code:
Program So_nguyen_to;
Var
    NguyenTo,Sang:Set of 1..100;
   so:1..100;
   i:Integer;
Begin
    Writeln('             CAC SO NGUYEN TO TU 1 DEN 100');
   Writeln('             -----------------------------');
   Writeln;
   NguyenTo:=[];
   Sang:=[2..100];
   So:=2;
   Repeat
       While Not (So In Sang) Do
          So:=So+1;
      NguyenTo:=NguyenTo + [So];
      Write(So,' ');
      I:=So;
      While I <= 100 Do
          Begin
             Sang:=Sang -[I];
            I:=I + So;
         End;
   Until Sang=[];
   Writeln;
   Writeln;
   Write('             Bam phim <Enter> de ket thuc ');
   Readln
End.
149/Cho biết ngày hôm nay sẽ tính được ngày mai:
Code:
Program Ngay_mai_la_ngay_may;
Var
    Nam:1900..2000;
   Thang:1..12;
   Ngay:1..31;
Begin
    Writeln('CHO BIET NGAY HOM NAY SE TINH DUOC NGAY MAI');
   Writeln('-------------------------------------------');
   Repeat
       Write('-Cho biet ngay ( so 0 de ngung): ');
      Readln(Ngay);
      If Ngay = 0 Then
          Exit;
      Write('-Cho biet thang: ');
      Readln(Thang);
      Write('-Cho biet nam: ');
      Readln(Nam);
      Case Thang Of
          1,3,5,7,8,10,12 : If Ngay < 31 Then
                                     Ngay:=Ngay+1
                                 Else
                              If Thang = 12 Then
                                  Begin
                                     Nam:=Nam+1;
                                    Thang:=1;
                                 End
                               Else
                                 Begin
                                     Thang:=Thang+1;
                                    Ngay:=1;
                                 End;
         4,6,9,11    :  If Ngay < 30 Then
                             Ngay:=Ngay+1
                         Else
                         Begin
                            Thang:=Thang+1;
                           Ngay:=1;
                        End;
         2: If (Ngay < 28) Or ((Ngay=28) And (Nam Mod 4 = 0)) then
                 Ngay:=Ngay+1
             Else
                Begin
                   Thang:=Thang+1;
                  Ngay:=1;
               End;
      End;
   Writeln;
   Writeln('+Ngay mai la ngay: ',Ngay:2,' / ',Thang:2,' / ',Nam:4);
   Writeln;
   Until Ngay=0;
End.
150/Chọn loại giải trí thích hợp:
Code:
Program Giai_Tri;
Var
    t:Byte;
Begin
    Writeln('CHON LOAI GIAI TRI THICH HOP');
   Writeln('----------------------------');
   Write('-Cho biet nhiet do ngay hom nay: ');
   Readln(t);
   If t < 20 Then
       Writeln('Troi lanh, ban nen o nha coi TV');
   If ((t > 20) And (t < 25)) Then
       Writeln('Troi mat me, ban nen di cam trai');
   If ((t > 25) And (t < 30)) Then
       Writeln('Troi hoi nong, ban nen di tam bien Vung Tau');
   If t > 30 Then
       Writeln('Troi nong, ban nen di nghi mat o Da Lat');
    Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.
 

loveIT

Thành viên Vip
201/Làm tròn số thực:
Code:
 [FONT=Tahoma]Program Lam_tron;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          so:Real;[/FONT]
  [FONT=Tahoma]   le:Integer;[/FONT]
  [FONT=Tahoma](*---------------*)[/FONT]
  [FONT=Tahoma]          FUNCTION Tron(so:Real;le:Integer):Real;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          i,n:LongInt;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          For i:=1 To le+1 Do[/FONT]
  [FONT=Tahoma]          so:=so*10;[/FONT]
  [FONT=Tahoma]      n:=Trunc(so);[/FONT]
  [FONT=Tahoma]      If (n Mod 10) >= 5 Then[/FONT]
  [FONT=Tahoma]          n:=(n Div 10) +1[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          n:=n Div 10;[/FONT]
  [FONT=Tahoma]      so:=n;[/FONT]
  [FONT=Tahoma]      For i:=1 To le Do[/FONT]
  [FONT=Tahoma]          so:=so/10;[/FONT]
  [FONT=Tahoma]      Tron:=so;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma](*---------------*)[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Writeln('LAM TRON SO THUC');[/FONT]
  [FONT=Tahoma]   Writeln('  Su dung ham');[/FONT]
  [FONT=Tahoma]   Writeln('----------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so: ');[/FONT]
  [FONT=Tahoma]   Readln(so);[/FONT]
  [FONT=Tahoma]   Write('-Can bao nhieu so le: ');[/FONT]
  [FONT=Tahoma]   Readln(le);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('       KET QUA');[/FONT]
  [FONT=Tahoma]   Writeln('*So nhap vao = ',so:12:10);[/FONT]
  [FONT=Tahoma]   Writeln('*So lam tron = ',Tron(so,le):12:le);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('   Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
202/Loang màu:
Code:
 [FONT=Tahoma]Program Loang_mau;[/FONT]
  [FONT=Tahoma]          Uses Crt;[/FONT]
  [FONT=Tahoma]          Const[/FONT]
  [FONT=Tahoma]                   St='       Chao mung ban da den voi THPTXuanLoc.CoM       ';[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          k:Integer;[/FONT]
  [FONT=Tahoma]   Procedure Mau(nen,chu:Integer);[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          TextBackGround(nen);[/FONT]
  [FONT=Tahoma]         TextColor(chu);[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          TextMode(C80);[/FONT]
  [FONT=Tahoma]   TextBackGround(Black);[/FONT]
  [FONT=Tahoma]   ClrScr;[/FONT]
  [FONT=Tahoma]   For k:=2 To 23 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Mau(k Mod 8,(k+4) Mod 8 + 8);[/FONT]
  [FONT=Tahoma]         GotoXY(1,k);[/FONT]
  [FONT=Tahoma]         Write(St)[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
203/Máy tính tay:
Code:
 [FONT=Tahoma]Program May_tinh_tay;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          so1,so2,kq:Real;[/FONT]
  [FONT=Tahoma]   toantu,tiep:Char;[/FONT]
  [FONT=Tahoma]   thuchien:Boolean;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('        MAY TINH TAY');[/FONT]
  [FONT=Tahoma]   Writeln('Thuc hien 4 phep tinh so hoc');[/FONT]
  [FONT=Tahoma]   Writeln('----------------------------');[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          Write('-Bam so: ');[/FONT]
  [FONT=Tahoma]          Readln(so1);[/FONT]
  [FONT=Tahoma]          Write('-Phep toan(+,-,*,/): ');[/FONT]
  [FONT=Tahoma]          Readln(toantu);[/FONT]
  [FONT=Tahoma]      Write('-Bam so: ');[/FONT]
  [FONT=Tahoma]      Readln(so2);[/FONT]
  [FONT=Tahoma]      thuchien:=True;[/FONT]
  [FONT=Tahoma]      Case toantu Of[/FONT]
  [FONT=Tahoma]          '+'      :kq:=so1+so2;[/FONT]
  [FONT=Tahoma]         '-'        :kq:=so1-so2;[/FONT]
  [FONT=Tahoma]         '*'       :kq:=so1*so2;[/FONT]
  [FONT=Tahoma]         '/'        :If so2 <> 0 Then[/FONT]
  [FONT=Tahoma]                                                                   kq:=so1/so2[/FONT]
  [FONT=Tahoma]                Else[/FONT]
  [FONT=Tahoma]                             thuchien:=False;[/FONT]
  [FONT=Tahoma]      Else                 thuchien:=False;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]      If thuchien Then[/FONT]
  [FONT=Tahoma]          Writeln('+Ket qua = ',kq:6:2)[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          Writeln('+Khong lam duoc');[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]      Write('-Thuc hien tiep khong ? (C/K) ');[/FONT]
  [FONT=Tahoma]      Readln(tiep);[/FONT]
  [FONT=Tahoma]   Until Upcase(tiep) = 'K';[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
204/Năm nhuận hay năm thường:
Code:
 [FONT=Tahoma]Program Nam_nhuan;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          nam:Word;[/FONT]
  [FONT=Tahoma]   nhuan:boolean;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('NAM NHUAN HAY NAM THUONG');[/FONT]
  [FONT=Tahoma]   Writeln('------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap vao nam can kiem tra: ');[/FONT]
  [FONT=Tahoma]   Readln(nam);[/FONT]
  [FONT=Tahoma]   If nam Mod 100 = 0 Then[/FONT]
  [FONT=Tahoma]          Nhuan:=(nam Mod 400)=0[/FONT]
  [FONT=Tahoma]   Else[/FONT]
  [FONT=Tahoma]          Nhuan:=(nam Mod 4)=0;[/FONT]
  [FONT=Tahoma]   Write('Nam: ',nam, ' la: ');[/FONT]
  [FONT=Tahoma]   If nhuan Then[/FONT]
  [FONT=Tahoma]          Writeln('nam nhuan')[/FONT]
  [FONT=Tahoma]   Else[/FONT]
  [FONT=Tahoma]          Writeln('nam thuong ( khong nhuan)');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
205/Ngày thứ mấy trong tuần:
Code:
 [FONT=Tahoma]Program Thu_trong_tuan;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          thu,ngay,thang:Byte;[/FONT]
  [FONT=Tahoma]   Nam,luu:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('NGAY THU MAY TRONG TUAN');[/FONT]
  [FONT=Tahoma]   Writeln('-----------------------');[/FONT]
  [FONT=Tahoma]   Write('-Ngay: ');[/FONT]
  [FONT=Tahoma]   Readln(ngay);[/FONT]
  [FONT=Tahoma]   Write('-Thang: ');[/FONT]
  [FONT=Tahoma]   Readln(thang);[/FONT]
  [FONT=Tahoma]   Write('-Nam: ');[/FONT]
  [FONT=Tahoma]   Readln(nam);[/FONT]
  [FONT=Tahoma]   luu:=nam;[/FONT]
  [FONT=Tahoma]   nam:=1900 + (nam Mod 1900);[/FONT]
  [FONT=Tahoma]   If thang < 3 Then[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          thang:=thang + 12;[/FONT]
  [FONT=Tahoma]         nam:=nam - 1;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   thu:=ABS(ngay+2*thang+3*(thang+1) Div 5+nam+nam Div 4) Mod 7;[/FONT]
  [FONT=Tahoma]   Case thu Of[/FONT]
  [FONT=Tahoma]          0        :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('        +La ngay Chu Nhat');[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      1  :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('+La ngay Thu Hai');[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      2  :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('        +La ngay Thu Ba');[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      3  :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('        +La ngay Thu Tu');[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      4  :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('        +La ngay Thu Nam');[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      5  :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('        +La ngay Thu Sau');[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      6  :        Begin[/FONT]
  [FONT=Tahoma]                             Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5);[/FONT]
  [FONT=Tahoma]               Writeln('        +La ngay Thu Bay');[/FONT]
  [FONT=Tahoma]                    End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
206/Phân tích N thành tích các thừa số nguyên tố:
Code:
 [FONT=Tahoma]Program thuaso;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          n,i:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('PHAN TICH N THANH TICH CAC THUA SO NGUYEN TO');[/FONT]
  [FONT=Tahoma]   Writeln('--------------------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          i:=2;[/FONT]
  [FONT=Tahoma]      While (n Mod i <> 0) And (i < n ) Do[/FONT]
  [FONT=Tahoma]          i:=i + 1;[/FONT]
  [FONT=Tahoma]      Write(i:4);[/FONT]
  [FONT=Tahoma]      n:=n Div i;[/FONT]
  [FONT=Tahoma]   Until n=1;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
207/Phân tích số nguyên dương nhỏ nhất:
Code:
 [FONT=Tahoma]Program Phan_tich;[/FONT]
  [FONT=Tahoma]          Const[/FONT]
  [FONT=Tahoma]          n=15;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          a:Array[1..n, 1..n] Of Longint;[/FONT]
  [FONT=Tahoma]      i,j,i1,j1:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('PHAN TICH SO NGUYEN DUONG NHO NHAT');[/FONT]
  [FONT=Tahoma]   Writeln('----------------------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   For i:=1 To n Do[/FONT]
  [FONT=Tahoma]          For j:=1 To n Do[/FONT]
  [FONT=Tahoma]          a[i,j]:=i*i*i + j*j*j;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('IN KET QUA');[/FONT]
  [FONT=Tahoma]   Writeln('----------');[/FONT]
  [FONT=Tahoma]   For i:=1 To n Do[/FONT]
  [FONT=Tahoma]          For j:=1 To i Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          For i1:= i+1 To n Do[/FONT]
  [FONT=Tahoma]                   For j1:=1 To j-1 Do[/FONT]
  [FONT=Tahoma]                   If a[i,j]=a[i1,j1] Then[/FONT]
  [FONT=Tahoma]                   Writeln(a[i,j],' = ',i,' ^3 ',' + ',j,' ^3 ',' = ',[/FONT]
  [FONT=Tahoma]                     i1,' ^3 ',' + ',j1,' ^3');[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('  Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
208/Phép chia chỉ là phép trừ:
Code:
 [FONT=Tahoma]Program Phep_chia;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          chia,bichia,luu,thuong,du:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('PHEP CHIA CHI LA PHEP TRU');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so bi chia: ');[/FONT]
  [FONT=Tahoma]   Readln(bichia);[/FONT]
  [FONT=Tahoma]   Write('-Nhap so chia: ');[/FONT]
  [FONT=Tahoma]   Readln(chia);[/FONT]
  [FONT=Tahoma]   luu:=bichia;[/FONT]
  [FONT=Tahoma]   thuong:=0;[/FONT]
  [FONT=Tahoma]   While bichia >=chia Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]                             bichia:=bichia-chia;[/FONT]
  [FONT=Tahoma]         thuong:=thuong+1;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   du:=bichia;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+Neu dem so ',luu,' chia cho so ',chia,' ket qua la: ');[/FONT]
  [FONT=Tahoma]   Writeln('  *So thuong = ',thuong:6);[/FONT]
  [FONT=Tahoma]   Writeln('  *So du     = ',du:6);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
209/Quay Xổ Số:
Code:
 [FONT=Tahoma]Program Xo_so;[/FONT]
  [FONT=Tahoma]Uses Crt;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          quacau,i:Byte;[/FONT]
  [FONT=Tahoma]   ch:Char;[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]   ClrScr;[/FONT]
  [FONT=Tahoma]   TextColor(Red);[/FONT]
  [FONT=Tahoma]   Writeln('                             QUAY XO SO');[/FONT]
  [FONT=Tahoma]   TextColor(Magenta);[/FONT]
  [FONT=Tahoma]   Writeln('                        Su dung ham Random');[/FONT]
  [FONT=Tahoma]   TextColor(Yellow);[/FONT]
  [FONT=Tahoma]   Writeln('                        -------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   TextColor(Green);[/FONT]
  [FONT=Tahoma]   Write('                      Cho so qua cau de quay: ');[/FONT]
  [FONT=Tahoma]   Readln(quacau);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   TextColor(Cyan);[/FONT]
  [FONT=Tahoma]   Write('                Bam phim bat ky de bat dau quay xo so');[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          i:= Random(9);[/FONT]
  [FONT=Tahoma]   Until KeyPressed;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   TextColor(LightBlue);[/FONT]
  [FONT=Tahoma]   Write('                   Bam phim <Enter> de ngung quay');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]   ch:=ReadKey;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   TextColor(Yellow);[/FONT]
  [FONT=Tahoma]   Writeln('                     KET QUA TRUNG THUONG LA SO: ');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   TextColor(Red);[/FONT]
  [FONT=Tahoma]   Write('                   ');[/FONT]
  [FONT=Tahoma]   For i:=1 To quacau Do[/FONT]
  [FONT=Tahoma]          Write(' ',Random(9):3);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   TextColor(Magenta);[/FONT]
  [FONT=Tahoma]   Write('                   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
210/Số nguyên tố:
Code:
 [FONT=Tahoma]Program So_nguyen_to;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          n,i:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('SO VUA NHAP CO PHAI LA SO NGUYEN TO ?');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap mot so : ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   While n > 1 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          i:=2;[/FONT]
  [FONT=Tahoma]         While (n Mod i <> 0) Do[/FONT]
  [FONT=Tahoma]          i:=i+1;[/FONT]
  [FONT=Tahoma]            if i=n Then[/FONT]
  [FONT=Tahoma]                   Writeln('-So ',n,' la so nguyen to')[/FONT]
  [FONT=Tahoma]            Else[/FONT]
  [FONT=Tahoma]                   Writeln('-So ',n,' khong phai la so nguyen to');[/FONT]
  [FONT=Tahoma]            Write('-Nhap mot so (so 0 de ngung): ');[/FONT]
  [FONT=Tahoma]                                Readln(n);[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
211/Số ngẫu nhiên:
Code:
 [FONT=Tahoma]Program So_ngau_Nhien;[/FONT]
  [FONT=Tahoma]Uses Crt;[/FONT]
  [FONT=Tahoma]CONST[/FONT]
  [FONT=Tahoma]           N = 100;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]          Mang : Array[1..N] Of ^Word;[/FONT]
  [FONT=Tahoma]   HeapTop : Pointer;[/FONT]
  [FONT=Tahoma]{-------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure TaoSo;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          i : Byte;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Randomize;[/FONT]
  [FONT=Tahoma]      For i := 1 To N Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          New(Mang[i]);[/FONT]
  [FONT=Tahoma]            Mang[i]^ := Random(999);[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure SapXep;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          i : Byte;[/FONT]
  [FONT=Tahoma]      Tam : Word;[/FONT]
  [FONT=Tahoma]      KetThuc : Boolean;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Repeat[/FONT]
  [FONT=Tahoma]          KetThuc := True;[/FONT]
  [FONT=Tahoma]         For i := 1 To n-1 Do[/FONT]
  [FONT=Tahoma]          If Mang[i]^ > Mang[i+1]^ Then[/FONT]
  [FONT=Tahoma]                   Begin[/FONT]
  [FONT=Tahoma]                   Tam := Mang[i]^;[/FONT]
  [FONT=Tahoma]                  Mang[i]^ := Mang[i+1]^;[/FONT]
  [FONT=Tahoma]                  Mang[i+1]^ := Tam;[/FONT]
  [FONT=Tahoma]                  KetThuc := False;[/FONT]
  [FONT=Tahoma]               End;[/FONT]
  [FONT=Tahoma]      Until ketThuc;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure InKq;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          i :Byte;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          For i := 1 To N Do[/FONT]
  [FONT=Tahoma]          Write(Mang[i]^:4);[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-------------------------------}[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]   Writeln('           TAO VA SAP XEP THU TU 100 SO NGAU NHIEN');[/FONT]
  [FONT=Tahoma]   Writeln('            ---------------------------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          Mark(HeapTop);[/FONT]
  [FONT=Tahoma]   TaoSo;[/FONT]
  [FONT=Tahoma]   SapXep;[/FONT]
  [FONT=Tahoma]   Inkq;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('           Bam <Enter> . . . ');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]   Release(HeapTop);[/FONT]
  [FONT=Tahoma]END. [/FONT]
212/Số ngày trong tháng:
Code:
 [FONT=Tahoma]Program So_ngay;[/FONT]
  [FONT=Tahoma]Uses Crt;[/FONT]
  [FONT=Tahoma]TYPE[/FONT]
  [FONT=Tahoma]          Nam=1900..2000;[/FONT]
  [FONT=Tahoma]   Thang=1..12;[/FONT]
  [FONT=Tahoma]   Ngay=1..31;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          Nam1,Nam2:Nam;[/FONT]
  [FONT=Tahoma]   Thang1,Thang2:Thang;[/FONT]
  [FONT=Tahoma]   Ngay1,Ngay2:Ngay;[/FONT]
  [FONT=Tahoma]   n:Real;[/FONT]
  [FONT=Tahoma]   kq:Boolean;[/FONT]
  [FONT=Tahoma]   (*--------------------*)[/FONT]
  [FONT=Tahoma]   FUNCTION KTngay(d:Ngay;m:Thang;y:Nam):Boolean;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          KTngay:=True;[/FONT]
  [FONT=Tahoma]      Case m Of[/FONT]
  [FONT=Tahoma]          4,6,9,11: If d > 30 Then[/FONT]
  [FONT=Tahoma]                   KTngay:=False;[/FONT]
  [FONT=Tahoma]         2 : If (d > 29) Or ((d =29) And (y Mod 4 <> 0)) Then[/FONT]
  [FONT=Tahoma]                   KTngay:=True;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   (*--------------------*)[/FONT]
  [FONT=Tahoma]   FUNCTION Julian(d:Ngay;m:Thang;y:Nam):Real; {Lich Julieng}[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          Tam:Real;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Tam:=Int((m-14.0)/12.0);[/FONT]
  [FONT=Tahoma]      Julian:=d-32075.0+[/FONT]
  [FONT=Tahoma]                   Int(1461.0*(y+4800.0+Tam)/4.0+[/FONT]
  [FONT=Tahoma]      Int(367.0*(m-2.0-Tam*12.0)/12.0)-[/FONT]
  [FONT=Tahoma]      Int(3.0*Int(y+4900.00+Tam)/100.0)/4.0)[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   (*--------------------*)[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          {$R+}[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]      Writeln('    *Nhap moc thoi gian dau');[/FONT]
  [FONT=Tahoma]      Write('-Ngay: ');[/FONT]
  [FONT=Tahoma]      Readln(Ngay1);[/FONT]
  [FONT=Tahoma]      Write('-Thang: ');[/FONT]
  [FONT=Tahoma]      Readln(Thang1);[/FONT]
  [FONT=Tahoma]      Write('-Nam: ');[/FONT]
  [FONT=Tahoma]      Readln(Nam1);[/FONT]
  [FONT=Tahoma]      Kq:=KTngay(Ngay1,Thang1,Nam1);[/FONT]
  [FONT=Tahoma]      If not Kq Then[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Sound(100);[/FONT]
  [FONT=Tahoma]            Delay(50);[/FONT]
  [FONT=Tahoma]            NoSound;[/FONT]
  [FONT=Tahoma]            Writeln('-Ngay khong hop le');[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   Until Kq;[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]      Writeln('    *Nhap moc thoi gian cuoi');[/FONT]
  [FONT=Tahoma]      Write('-Ngay: ');[/FONT]
  [FONT=Tahoma]      Readln(Ngay2);[/FONT]
  [FONT=Tahoma]      Write('-Thang: ');[/FONT]
  [FONT=Tahoma]      Readln(Thang2);[/FONT]
  [FONT=Tahoma]      Write('-Nam: ');[/FONT]
  [FONT=Tahoma]      Readln(Nam2);[/FONT]
  [FONT=Tahoma]      Kq:=KTngay(Ngay2,Thang2,Nam2);[/FONT]
  [FONT=Tahoma]      If not Kq Then[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Sound(100);[/FONT]
  [FONT=Tahoma]            Delay(50);[/FONT]
  [FONT=Tahoma]            NoSound;[/FONT]
  [FONT=Tahoma]            Writeln('-Ngay khong hop le');[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   Until Kq;[/FONT]
  [FONT=Tahoma]   n:=Julian(Ngay2,Thang2,Nam2)-Julian(Ngay1,Thang1,Nam1);[/FONT]
  [FONT=Tahoma]   Writeln('Ket qua: ',n:8:0,' ngay');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('  Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
213/Tháng X có bao nhiêu ngày:
Code:
 [FONT=Tahoma]Program Ngay_cua_thang;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          thang,nam,luu,songay:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('THANG. X . CO BAO NHIEU NGAY');[/FONT]
  [FONT=Tahoma]   Writeln('---------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Ban muon hoi thang nao co bao nhieu ngay: ');[/FONT]
  [FONT=Tahoma]   Readln(thang);[/FONT]
  [FONT=Tahoma]   Write('-Cho biet nam : ');[/FONT]
  [FONT=Tahoma]   Readln(nam);[/FONT]
  [FONT=Tahoma]   luu:=nam;[/FONT]
  [FONT=Tahoma]   Case thang Of[/FONT]
  [FONT=Tahoma]          1,3,5,7,8,10,12: songay:=31;[/FONT]
  [FONT=Tahoma]      4,6,9,11                    : songay:=30;[/FONT]
  [FONT=Tahoma]      2  :Case nam Mod 4 Of[/FONT]
  [FONT=Tahoma]                   1,2,3 :songay:=28;[/FONT]
  [FONT=Tahoma]               0            :songay:=29;[/FONT]
  [FONT=Tahoma]          End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   If songay >=30 Then[/FONT]
  [FONT=Tahoma]          Writeln('+Thang:',thang:3,', nam: ',luu:4,', co: ',songay:3,' ngay')[/FONT]
  [FONT=Tahoma]   Else[/FONT]
  [FONT=Tahoma]          Writeln('+Thang:',thang:3,', nam: ',luu:5,', co: ',songay:3,' ngay');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phin <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
214/Tìm 10 số ngẫu nhiên không âm:
Code:
 [FONT=Tahoma]Program So_ngau_nhien;[/FONT]
  [FONT=Tahoma]CONST[/FONT]
  [FONT=Tahoma]          N=100;[/FONT]
  [FONT=Tahoma]TYPE[/FONT]
  [FONT=Tahoma]          Nguyen= Set of 1..N;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          a:Nguyen;[/FONT]
  [FONT=Tahoma]   So,i,spt:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TIM 10 S0 NGUYEN NGAU NHIEN KHONG AM');[/FONT]
  [FONT=Tahoma]          Writeln('  NHO HON 100, KHONG TRUNG NHAU');[/FONT]
  [FONT=Tahoma]   Writeln('------------------------------------');[/FONT]
  [FONT=Tahoma]   spt:=0;[/FONT]
  [FONT=Tahoma]   a:=[];[/FONT]
  [FONT=Tahoma]   Randomize;[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          So:=Random(100);[/FONT]
  [FONT=Tahoma]      If Not (So In a) Then[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          a:=a+[So];[/FONT]
  [FONT=Tahoma]            Spt:=Spt +1;[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   Until Spt = 10;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('10 so ngau nhien nho hon 100 la: ');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   For i:= 0 To 100 Do[/FONT]
  [FONT=Tahoma]          If i In a Then[/FONT]
  [FONT=Tahoma]          Write(i,', ');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('   Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
215/Tìm 2 phần tử liên tiếp bằng giá trị X:
Code:
 [FONT=Tahoma]Program Tim_PT_Mang;[/FONT]
  [FONT=Tahoma]          Uses Crt;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          a:Array[1..1000] Of Integer;[/FONT]
  [FONT=Tahoma]   {----------------------------}[/FONT]
  [FONT=Tahoma]   Procedure Tao;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          k:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Randomize;[/FONT]
  [FONT=Tahoma]      For k:=1 To 100 Do[/FONT]
  [FONT=Tahoma]          a[k]:=Random(100);[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {----------------------------}[/FONT]
  [FONT=Tahoma]   Procedure Tim;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          k,x:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Write('-Nhap gia tri X= ');[/FONT]
  [FONT=Tahoma]      Readln(x);[/FONT]
  [FONT=Tahoma]      For k:=1 To 999 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]                   If a[k] +a[k+1] = X Then[/FONT]
  [FONT=Tahoma]                   Writeln('a[',K,'] + a[',K+1,']= ',X)[/FONT]
  [FONT=Tahoma]          Else[/FONT]
  [FONT=Tahoma]                   Writeln('Khong co 2 phan tu nao bang: ',X);[/FONT]
  [FONT=Tahoma]          End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Writeln('TIM 2 PHAN TU LIEN TIEP BANG GIA TRI X');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Tao;[/FONT]
  [FONT=Tahoma]   Tim;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('  Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]END. [/FONT]
216/Tìm các số nguyên tố từ 2 đến N:
Code:
 [FONT=Tahoma]Program Tim_so_nguyen_to;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          n,i,j:Integer;[/FONT]
  [FONT=Tahoma]   nguyento:Boolean;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TIM CAC SO NGUYEN TO TU 2 DEN N');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   For i:=2 To n Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]         nguyento:=True;[/FONT]
  [FONT=Tahoma]         j:=2;[/FONT]
  [FONT=Tahoma]          While nguyento And (j <i) Do[/FONT]
  [FONT=Tahoma]                                                Begin[/FONT]
  [FONT=Tahoma]                             If (i Mod j)=0 Then[/FONT]
  [FONT=Tahoma]                             nguyento:=False;[/FONT]
  [FONT=Tahoma]                   j:=j+1;[/FONT]
  [FONT=Tahoma]                                                End;[/FONT]
  [FONT=Tahoma]         If nguyento Then[/FONT]
  [FONT=Tahoma]          Write(i:4);[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
217/Tìm các ước số của số nguyên:
Code:
 [FONT=Tahoma]Program uoc_so;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]   i,n:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TIM CAC UOC SO CUA SO NGUYEN');[/FONT]
  [FONT=Tahoma]   Writeln('----------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap mot so nguyen: ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+Cac uoc so cua so ',n,' la: ');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   For i:=1 To N Do[/FONT]
  [FONT=Tahoma]          If (n Mod i) = 0 Then[/FONT]
  [FONT=Tahoma]          Write(i:6);[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
218/Tìm số lớn nhất trong n số nguyên:
Code:
 [FONT=Tahoma]Program Cuc_dai;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          i,n:Byte;[/FONT]
  [FONT=Tahoma]   so,solon:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TIM SO LON NHAT TRONG N SO NGUYEN');[/FONT]
  [FONT=Tahoma]   Writeln('---------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Muon nhap bao nhieu so: ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   i:=1;[/FONT]
  [FONT=Tahoma]   Write('-So thu ',i,' = ');[/FONT]
  [FONT=Tahoma]   Readln(so);[/FONT]
  [FONT=Tahoma]   solon:=so;[/FONT]
  [FONT=Tahoma]   For i:=2 To N Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Write('-So thu ',i,' = ');[/FONT]
  [FONT=Tahoma]         Readln(so);[/FONT]
  [FONT=Tahoma]         If solon < so Then[/FONT]
  [FONT=Tahoma]          solon:=so;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+So lon nhat trong ',n,' so vua nhap la so: ',solon);[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
219/Số lớn nhất và nhỏ nhất:
Code:
 [FONT=Tahoma]Program So_lon_so_nho;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          so1,so2,so3,so4,max,min:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TIM SO LON NHAT VA SO NHO NHAT');[/FONT]
  [FONT=Tahoma]   Writeln('-----------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so thu nhat: ');[/FONT]
  [FONT=Tahoma]   Readln(so1);[/FONT]
  [FONT=Tahoma]   Write('-Nhap so thu hai : ');[/FONT]
  [FONT=Tahoma]   Readln(so2);[/FONT]
  [FONT=Tahoma]   Write('-Nhap so thu ba  : ');[/FONT]
  [FONT=Tahoma]   Readln(so3);[/FONT]
  [FONT=Tahoma]   Write('-Nhap so thu tu  : ');[/FONT]
  [FONT=Tahoma]   Readln(so4);[/FONT]
  [FONT=Tahoma]   max:=so1;[/FONT]
  [FONT=Tahoma]   min:=so1;[/FONT]
  [FONT=Tahoma]   If max < so2 Then[/FONT]
  [FONT=Tahoma]          max:=so2[/FONT]
  [FONT=Tahoma]   Else[/FONT]
  [FONT=Tahoma]          min:=so2;[/FONT]
  [FONT=Tahoma]   If max < so3 Then[/FONT]
  [FONT=Tahoma]          max:=so3[/FONT]
  [FONT=Tahoma]   Else[/FONT]
  [FONT=Tahoma]          min:=so3;[/FONT]
  [FONT=Tahoma]   If max < so4 Then[/FONT]
  [FONT=Tahoma]          max:=so4;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+So lon nhat trong 4 so: ',so1,',',so2,',',so3,',',so4,' la: ',max);[/FONT]
  [FONT=Tahoma]   Writeln('+Va so nho nhat trong 4 so do la       : ',min);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
220/Tính độ dài vectơ:
Code:
 [FONT=Tahoma]Program Tinh_do_dai_vec_to;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]       x,y,z:Integer;[/FONT]
  [FONT=Tahoma]                  l:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH CHIEU DAI VECTO');[/FONT]
  [FONT=Tahoma]   Writeln('---------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('-Cho biet toa do X : ');[/FONT]
  [FONT=Tahoma]   Readln(x);[/FONT]
  [FONT=Tahoma]   Write('-Cho biet toa do Y : ');[/FONT]
  [FONT=Tahoma]   Readln(y);[/FONT]
  [FONT=Tahoma]   Write('-Cho biet toa do Z : ');[/FONT]
  [FONT=Tahoma]   Readln(z);[/FONT]
  [FONT=Tahoma]   l:= Sqrt(Sqr(x) + Sqr(y) + Sqr(z));[/FONT]
  [FONT=Tahoma]   Writeln('+Chieu dai cua vecto = ',l:10:2);[/FONT]
  [FONT=Tahoma]   Writeln('    Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
221/Tính chu kì dao động con lắc:
Code:
 [FONT=Tahoma]Program Chu_ky_con_lac;[/FONT]
  [FONT=Tahoma]Const[/FONT]
  [FONT=Tahoma]          g=918;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          l,t:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH CHU KY DAO DONG CON LAC DON');[/FONT]
  [FONT=Tahoma]   Writeln('-----------------------');[/FONT]
  [FONT=Tahoma]   Write('-Cho biet chieu dai con lac: ');[/FONT]
  [FONT=Tahoma]   Readln(l);[/FONT]
  [FONT=Tahoma]   t:=2*pi*sqrt(l/g);[/FONT]
  [FONT=Tahoma]   Writeln('+Chu ky dao dong dieu hoa cua con lac: ',t:10:3);[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]End. [/FONT]
222/Chu vi diện tích hcn:
Code:
 [FONT=Tahoma]Program Chu_vi_Dien_tich;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          d,r,p,s:Integer;[/FONT]
  [FONT=Tahoma]   tiep:Char;[/FONT]
  [FONT=Tahoma]   (*------------------*)[/FONT]
  [FONT=Tahoma]   PROCEDURE Chuvi(x,y:Integer);[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          p:=(x+y)*2;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]  (*------------------*)[/FONT]
  [FONT=Tahoma]   PROCEDURE Dientich(x,y:Integer);[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          s:=x * y;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   (*------------------*)[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Repeat[/FONT]
  [FONT=Tahoma]                   Writeln('TINH CHU VI, DIEN TICH HINH CHU NHAT');[/FONT]
  [FONT=Tahoma]          Writeln('           Su dung thu tuc');[/FONT]
  [FONT=Tahoma]          Writeln('------------------------------------');[/FONT]
  [FONT=Tahoma]          Write('-Nhap chieu rong: ');[/FONT]
  [FONT=Tahoma]          Readln(r);[/FONT]
  [FONT=Tahoma]          Write('-Nhap chieu dai : ');[/FONT]
  [FONT=Tahoma]          Readln(d);[/FONT]
  [FONT=Tahoma]      Chuvi(r,d);[/FONT]
  [FONT=Tahoma]      Dientich(r,d);[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]          Writeln('+Chu vi hinh chu nhat= ',p);[/FONT]
  [FONT=Tahoma]          Writeln('+Dien tich hinh chu nhat= ',s);[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]          Write('  Co thuc hien tiep khong ? (c/k) ');[/FONT]
  [FONT=Tahoma]          Readln(tiep);[/FONT]
  [FONT=Tahoma]   Until (tiep='k') Or (tiep='K');[/FONT]
  [FONT=Tahoma]END. [/FONT]
223/Chu vi diện tích vòng tròn:
Code:
 [FONT=Tahoma]Program Vong_tron;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          Radius,s,cv :Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH CHU VI, DIEN TICH VONG TRON');[/FONT]
  [FONT=Tahoma]   Writeln('--------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Cho biet ban kinh : ');[/FONT]
  [FONT=Tahoma]   Readln(Radius);[/FONT]
  [FONT=Tahoma]   cv:=2*Pi*Radius;[/FONT]
  [FONT=Tahoma]   S:=Pi*Radius*Radius;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+Chu vi vong tron    = ',cv:10:2);[/FONT]
  [FONT=Tahoma]   Writeln('+Dien tich vong tron = ',s:10:2);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('       Bam phim <Enter> de tro ve cua so soan thao');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
224/Tính dân số sau 5 năm:
Code:
 [FONT=Tahoma]Program Dan_so;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          i:Byte;[/FONT]
  [FONT=Tahoma]   sodan:LongInt;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH DAN SO SAU 5 NAM');[/FONT]
  [FONT=Tahoma]   Writeln('---------------------');[/FONT]
  [FONT=Tahoma]   sodan:=5000000;[/FONT]
  [FONT=Tahoma]   Writeln('-So dan hien nay = ',sodan);[/FONT]
  [FONT=Tahoma]   Writeln('-Ty le tang dan so hang nam = 1.5%');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('So dan tang tung nam trong 5 nam toi la:');[/FONT]
  [FONT=Tahoma]   For i:=1 To 5 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          sodan:=round(sodan * 1.015);[/FONT]
  [FONT=Tahoma]         Writeln('-Nam thu ',i,' so dan la: ',sodan,' nguoi');[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
225/Tính diện tích hình học sơ cấp:
Code:
 [FONT=Tahoma]Program Hinh_hoc_so_cap;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          a,b,c,h,r:Integer;[/FONT]
  [FONT=Tahoma]   s:Real;[/FONT]
  [FONT=Tahoma]   chon:Byte;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH DIEN TICH HINH HOC SO CAP');[/FONT]
  [FONT=Tahoma]   Writeln('------------------------------');[/FONT]
  [FONT=Tahoma]   Writeln('    1-Hinh vuong');[/FONT]
  [FONT=Tahoma]   Writeln('    2-Hinh chu nhat');[/FONT]
  [FONT=Tahoma]   Writeln('    3-Hinh tam gia1c');[/FONT]
  [FONT=Tahoma]   Writeln('    4-Hinh thang');[/FONT]
  [FONT=Tahoma]   Writeln('    5-Hinh tron');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('-Ban chon cac so tu 1 den 5 de tinh dien tich hinh tuong ung');[/FONT]
  [FONT=Tahoma]   Readln(chon);[/FONT]
  [FONT=Tahoma]   Case chon Of[/FONT]
  [FONT=Tahoma]          1        :Begin[/FONT]
  [FONT=Tahoma]                   Write('-Nhap canh hinh vuong: ');[/FONT]
  [FONT=Tahoma]            Readln(a);[/FONT]
  [FONT=Tahoma]            s:=a*a;[/FONT]
  [FONT=Tahoma]            Writeln('+Dien tich hinh vuong = ',s:10:2,' met vuong');[/FONT]
  [FONT=Tahoma]           End;[/FONT]
  [FONT=Tahoma]      2  :Begin[/FONT]
  [FONT=Tahoma]                   Write('-Nhap chieu rong : ');[/FONT]
  [FONT=Tahoma]            Readln(a);[/FONT]
  [FONT=Tahoma]            Write('-Nhap chieu dai  : ');[/FONT]
  [FONT=Tahoma]            Readln(b);[/FONT]
  [FONT=Tahoma]            s:=a*b;[/FONT]
  [FONT=Tahoma]            Writeln('+Dien tich hinh chu nhat = ',s:10:2,' met vuong');[/FONT]
  [FONT=Tahoma]           End;[/FONT]
  [FONT=Tahoma]       3 :Begin[/FONT]
  [FONT=Tahoma]                   Write('-Nhap canh day : ');[/FONT]
  [FONT=Tahoma]            Readln(a);[/FONT]
  [FONT=Tahoma]            Write('-Nhap chieu cao  : ');[/FONT]
  [FONT=Tahoma]            Readln(h);[/FONT]
  [FONT=Tahoma]            s:=a*h/2;[/FONT]
  [FONT=Tahoma]            Writeln('+Dien tich hinh tam giac = ',s:10:2,' met vuong');[/FONT]
  [FONT=Tahoma]           End;[/FONT]
  [FONT=Tahoma]                    4       :Begin[/FONT]
  [FONT=Tahoma]                   Write('-Nhap day duoi : ');[/FONT]
  [FONT=Tahoma]            Readln(a);[/FONT]
  [FONT=Tahoma]            Write('-Nhap day tren : ');[/FONT]
  [FONT=Tahoma]            Readln(b);[/FONT]
  [FONT=Tahoma]            Write('-Nhap chieu cao: ');[/FONT]
  [FONT=Tahoma]            Readln(h);[/FONT]
  [FONT=Tahoma]            s:=0.5*(a+b)*h;[/FONT]
  [FONT=Tahoma]            Writeln('+Dien tich hinh thang = ',s:10:2,' met vuong');[/FONT]
  [FONT=Tahoma]           End;[/FONT]
  [FONT=Tahoma]       5 :Begin[/FONT]
  [FONT=Tahoma]                   Write('-Nhap ban kinh : ');[/FONT]
  [FONT=Tahoma]            Readln(r);[/FONT]
  [FONT=Tahoma]            s:=r*r*pi;[/FONT]
  [FONT=Tahoma]            Writeln('+Dien tich hinh tron = ',s:10:2,' met vuong');[/FONT]
  [FONT=Tahoma]           End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
226/Tính giai thừa của n:
Code:
 [FONT=Tahoma]Program Giai_thua;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          n:Integer;[/FONT]
  [FONT=Tahoma](*---------------------*)[/FONT]
  [FONT=Tahoma]          FUNCTION Gt(x:Integer):Integer;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          k,s:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          s:=1;[/FONT]
  [FONT=Tahoma]      For k:=1 To x Do[/FONT]
  [FONT=Tahoma]          s:=s*k;[/FONT]
  [FONT=Tahoma]      Gt:=s;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma](*---------------------*)[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Writeln('TINH GIAI THUA CUA N');[/FONT]
  [FONT=Tahoma]   Writeln('    Su dung ham');[/FONT]
  [FONT=Tahoma]   Writeln('--------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+Giai thua cua ',n,' = ',Gt(n));[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('  Bam <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
227/Tính giờ phút giây:
Code:
 [FONT=Tahoma]Program Tinh_Gio_Phut_Giay;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          sogiay,gio,phut,giay:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH GIO:PHUT:GIAY');[/FONT]
  [FONT=Tahoma]   Writeln('------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so giay can tinh: ');[/FONT]
  [FONT=Tahoma]   Readln(sogiay);[/FONT]
  [FONT=Tahoma]   gio:=sogiay DIV 3600;[/FONT]
  [FONT=Tahoma]   sogiay:= sogiay MOD 3600;[/FONT]
  [FONT=Tahoma]   phut:=sogiay DIV 60;[/FONT]
  [FONT=Tahoma]   giay:=sogiay MOD 60;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('KET QUA CHUYEN DOI');[/FONT]
  [FONT=Tahoma]   Writeln('+Neu nhap vao: ',sogiay,' giay');[/FONT]
  [FONT=Tahoma]   Writeln('+Doi thanh: ',gio,' gio, ',phut,' phut, ',giay,' giay');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
228/Tính khoảng cách từ 1 điểm đến đt:
Code:
 [FONT=Tahoma]Program Tinh_khoang_cach;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          a,b,c,d,x,y:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH KHOANG CACH TU 1 DIEM DEN DUONG THANG');[/FONT]
  [FONT=Tahoma]   Writeln('------------------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap he so a= ');[/FONT]
  [FONT=Tahoma]   Readln(a);[/FONT]
  [FONT=Tahoma]   Write('-Nhap he so b= ');[/FONT]
  [FONT=Tahoma]   Readln(b);[/FONT]
  [FONT=Tahoma]   Write('-Nhap he so c= ');[/FONT]
  [FONT=Tahoma]   Readln(c);[/FONT]
  [FONT=Tahoma]   Write('-Nhap toa do x= ');[/FONT]
  [FONT=Tahoma]   Readln(x);[/FONT]
  [FONT=Tahoma]   Write('-Nhap toa do y= ');[/FONT]
  [FONT=Tahoma]   Readln(y);[/FONT]
  [FONT=Tahoma]   d:=((a*x) + (b*y) + c) / Sqrt(Sqr(a) + Sqr(b));[/FONT]
  [FONT=Tahoma]   Writeln('+Khoang cach tu diem I den duong thang la: ',d:10:2);[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
229/Tính sin(x):
Code:
 [FONT=Tahoma]Program Tinh_sin;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          goc:Integer;[/FONT]
  [FONT=Tahoma]          rad,x:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH SIN(X)');[/FONT]
  [FONT=Tahoma]   Writeln('-----------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap vao mot goc: ');[/FONT]
  [FONT=Tahoma]   Readln(goc);[/FONT]
  [FONT=Tahoma]   rad:=(pi * goc) / 180;[/FONT]
  [FONT=Tahoma]   x:=sin(rad);[/FONT]
  [FONT=Tahoma]   Writeln('+Sin(',goc:2,') = ',x:10:8);[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]End. [/FONT]
230/Tính tiền gửi ngân hàng:
Code:
 [FONT=Tahoma]Program Tinh_tien;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          v:Integer;[/FONT]
  [FONT=Tahoma]   l,n:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH TIEN GUI NGAN HANG');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('-So tien gui = ');[/FONT]
  [FONT=Tahoma]   Readln(v);[/FONT]
  [FONT=Tahoma]   Write('-Lai suat    = ');[/FONT]
  [FONT=Tahoma]   Readln(l);[/FONT]
  [FONT=Tahoma]   n:=(v * (1 + (l/100)));[/FONT]
  [FONT=Tahoma]   Writeln('*Neu gui: ',v,' dong, lai suat 1 nam= ',l:4:2,' %');[/FONT]
  [FONT=Tahoma]   Writeln('*So tien lai trong 1 nam = ',Round(v*l/100),' dong');[/FONT]
  [FONT=Tahoma]   Writeln('*Von + Lai trong 1 nam   = ',Round(n),' dong');[/FONT]
  [FONT=Tahoma]   Writeln('  Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
231/Tổ hợp chập k của n:
Code:
 [FONT=Tahoma]Program To_hop_chp_k_cua_N;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          i,k,n:Integer;[/FONT]
  [FONT=Tahoma]   c:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH TO HOP CHAP k CUA N');[/FONT]
  [FONT=Tahoma]   Writeln('     Voi k <= N');[/FONT]
  [FONT=Tahoma]   Writeln('------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   Write('-Nhap so phan tu k= ');[/FONT]
  [FONT=Tahoma]   Readln(k);[/FONT]
  [FONT=Tahoma]   If k > N Then[/FONT]
  [FONT=Tahoma]          Writeln('+Vi k lon hon N nen khong tinh duoc')[/FONT]
  [FONT=Tahoma]   Else[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          c:=1;[/FONT]
  [FONT=Tahoma]         For i:=1 To k Do[/FONT]
  [FONT=Tahoma]          c:=c*(n-k+i)/i;[/FONT]
  [FONT=Tahoma]                             Writeln('+To hop chap ',k,' cua ',n,' la: ',c:2:2);[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
232/Tổng bình phương các số lẻ:
Code:
 [FONT=Tahoma]Program Tong_binh_phuong;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          i,n,tong:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH TONG BINH PHUONG CAC SO LE');[/FONT]
  [FONT=Tahoma]   Writeln('          Tu 1 den N');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   tong:=0;[/FONT]
  [FONT=Tahoma]   For i:=1 To N Do[/FONT]
  [FONT=Tahoma]          If odd(i) Then[/FONT]
  [FONT=Tahoma]          tong:=tong+sqr(i);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+Tong binh phuong cac so le cua ',n,' so nguyen= ',tong);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
233/Tổng nghịch đảo n số nguyên đầu tiên:
Code:
 [FONT=Tahoma]Program Tong_nghich_dao;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          n,i:Integer;[/FONT]
  [FONT=Tahoma]   s:Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH TONG NGHICH DAO N SO NGUYEN DAU TIEN');[/FONT]
  [FONT=Tahoma]   Writeln('-----------------------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap so N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   S:=0;[/FONT]
  [FONT=Tahoma]   For i:= 1 To N Do[/FONT]
  [FONT=Tahoma]          S:=S+(1/i);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+Tong nghich dao cua ',n,' so nguyen dau tien= ',S:0:2);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
234/Giá trị của X luỹ thừ N:
Code:
 [FONT=Tahoma]Program Luy_thua;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          x,n,tich,luythua:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH TRI CUA X LUY THUA N');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap vao so X= ');[/FONT]
  [FONT=Tahoma]   Readln(x);[/FONT]
  [FONT=Tahoma]   Write('-Nhap vao luy thua N= ');[/FONT]
  [FONT=Tahoma]   Readln(n);[/FONT]
  [FONT=Tahoma]   tich:=1;[/FONT]
  [FONT=Tahoma]   luythua:=1;[/FONT]
  [FONT=Tahoma]   While luythua <= n Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          tich:=tich * x;[/FONT]
  [FONT=Tahoma]         luythua:=luythua + 1;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]   Writeln(x,' luy thua ',n,' = ',tich);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
235/Ước chung lớn nhất, bội chung nhỏ nhất:
Code:
 [FONT=Tahoma]Program Uoc_so_chung_Boi_so_chung;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          so1,so2:Word;[/FONT]
  [FONT=Tahoma]   p:LongInt;[/FONT]
  [FONT=Tahoma]   tiep:Char;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TINH UOC SO CHUNG LON NHAT, BOI SO CHUNG NHO NHAT');[/FONT]
  [FONT=Tahoma]   Writeln('       Su dung vong lap Repeat... Until');[/FONT]
  [FONT=Tahoma]   Writeln('-------------------------------------------------');[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]      Write('-Nhap so thu nhat: ');[/FONT]
  [FONT=Tahoma]      Readln(so1);[/FONT]
  [FONT=Tahoma]      Write('-Nhap so thu hai : ');[/FONT]
  [FONT=Tahoma]      Readln(so2);[/FONT]
  [FONT=Tahoma]      p:=so1 * so2;[/FONT]
  [FONT=Tahoma]      Write('+Uoc so chung lon nhat cua ',so1,' va ',so2,' la: ');[/FONT]
  [FONT=Tahoma]      Repeat[/FONT]
  [FONT=Tahoma]          if so1 > so2 Then[/FONT]
  [FONT=Tahoma]          so1:=so1 - so2[/FONT]
  [FONT=Tahoma]         Else[/FONT]
  [FONT=Tahoma]          so2:=so2 - so1;[/FONT]
  [FONT=Tahoma]      Until so1=so2;[/FONT]
  [FONT=Tahoma]      Writeln(so1);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]      Writeln('+Boi so chung nho nhat: ',P Div so1);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]      Write('-Co tiep tuc nua khong ? (C/K) ');[/FONT]
  [FONT=Tahoma]      Readln(tiep);[/FONT]
  [FONT=Tahoma]   Until Upcase(tiep)='K';[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
236/Tổng tích ma trận:
Code:
 [FONT=Tahoma]Program Tong_Tich_Ma_tran;[/FONT]
  [FONT=Tahoma]          Uses Crt;[/FONT]
  [FONT=Tahoma]   Type[/FONT]
  [FONT=Tahoma]          Matran=array[1..3,1..3] Of Integer;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          a,b,c,d:Matran;[/FONT]
  [FONT=Tahoma]      i,j,k:Byte;[/FONT]
  [FONT=Tahoma]      Ch:Char;[/FONT]
  [FONT=Tahoma]   {*****************************}[/FONT]
  [FONT=Tahoma]   Procedure Nhap(Var m:Matran; Ten:Char);[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]      GotoXY(26,6);[/FONT]
  [FONT=Tahoma]      Write('-Nhap ma tran: ',Ten);[/FONT]
  [FONT=Tahoma]      For i:=1 To 3 Do[/FONT]
  [FONT=Tahoma]          For j:=1 to 3 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]                   GotoXY(20*i-8,10+2*j);[/FONT]
  [FONT=Tahoma]               Write(Ten,'[',i,',',j,']= ');[/FONT]
  [FONT=Tahoma]               Readln(m[i,j]);[/FONT]
  [FONT=Tahoma]            End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {*****************************}[/FONT]
  [FONT=Tahoma]   Procedure Xuat(m:Matran; Ten:Char);[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]      GotoXY(26,6);[/FONT]
  [FONT=Tahoma]      Write('CAC PHAN TU CUA MA TRAN: ',Ten);[/FONT]
  [FONT=Tahoma]      For i:=1 To 3 Do[/FONT]
  [FONT=Tahoma]          For j:=1 To 3 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]                   GotoXY(20*i-8,10+2*j);[/FONT]
  [FONT=Tahoma]               Write(Ten,'[',i,',',']= ',m[i,j]);[/FONT]
  [FONT=Tahoma]            End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {*****************************}[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Nhap(a,'A');[/FONT]
  [FONT=Tahoma]   Nhap(b,'B');[/FONT]
  [FONT=Tahoma]   For i:=1 To 3 Do[/FONT]
  [FONT=Tahoma]          For j:=1 To 3 Do[/FONT]
  [FONT=Tahoma]          c[i,j]:=a[i,j]+b[i,j];[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('MA TRAN TONG');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Xuat(c,'C');[/FONT]
  [FONT=Tahoma]   GotoXY(10,25);[/FONT]
  [FONT=Tahoma]   Write('Bam phim <Esc> de xem ma tran tich');[/FONT]
  [FONT=Tahoma]   For i:=1 to 3 Do[/FONT]
  [FONT=Tahoma]          For j:=1 To 3 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          d[i,j]:=0;[/FONT]
  [FONT=Tahoma]            For k:=1 To 3 Do[/FONT]
  [FONT=Tahoma]                   d[i,j]:=a[i,k]*b[k,j]+d[i,j];[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          Ch:=Readkey;[/FONT]
  [FONT=Tahoma]      If Ch=#0 then[/FONT]
  [FONT=Tahoma]          Ch:=Readkey;[/FONT]
  [FONT=Tahoma]   Until Ch=#27;[/FONT]
  [FONT=Tahoma]   Writeln('MA TRAN TICH= ');[/FONT]
  [FONT=Tahoma]   Xuat(d,'D');[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]   Until KeyPressed;[/FONT]
  [FONT=Tahoma]END. [/FONT]
237/Trò chơi One Two Three:
Code:
 [FONT=Tahoma]Program One_Two_Three;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          a,b:Char;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('TRO CHOI ONE TWO THREE');[/FONT]
  [FONT=Tahoma]   Writeln(' Keo (k), Bua (b), Giay (g)');[/FONT]
  [FONT=Tahoma]   Writeln('---------------------------');[/FONT]
  [FONT=Tahoma]   Write('-Ban A chon: ');[/FONT]
  [FONT=Tahoma]   Readln(a);[/FONT]
  [FONT=Tahoma]   Write('-Ban B chon: ');[/FONT]
  [FONT=Tahoma]   Readln(b);[/FONT]
  [FONT=Tahoma]   Case Upcase(a) Of[/FONT]
  [FONT=Tahoma]          'K':     Case Upcase(b) Of[/FONT]
  [FONT=Tahoma]                             'K'       :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Keo');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B cung chon Keo');[/FONT]
  [FONT=Tahoma]                           Writeln('+Keo gap Kep, hoa nhau');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]               'B' :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Keo');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B chon Bua');[/FONT]
  [FONT=Tahoma]                           Writeln('+Bua dap Keo, B thang');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]               'G' :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Keo');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B chon Giay');[/FONT]
  [FONT=Tahoma]                           Writeln('+Keo cat Giay, A thang');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      'B':         Case Upcase(b) Of[/FONT]
  [FONT=Tahoma]                   'K'       :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Bua');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B chon Keo');[/FONT]
  [FONT=Tahoma]                           Writeln('+Bua dap Keo, A thang');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]               'B' :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Bua');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B cung chon Bua');[/FONT]
  [FONT=Tahoma]                           Writeln('+Bua gap Bua, hoa nhau');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]               'G' :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Bua');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B chon Giay');[/FONT]
  [FONT=Tahoma]                           Writeln('+Giay boc Bua, B thang');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]      'G':         Case Upcase(b) Of[/FONT]
  [FONT=Tahoma]                   'K'       :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Giay');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B chon Keo');[/FONT]
  [FONT=Tahoma]                           Writeln('+Keo cat Giay, B thang');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]               'B' :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Giay');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B chon Bua');[/FONT]
  [FONT=Tahoma]                           Writeln('+Giay boc Bua, A thang');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]               'G' :        Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Ban A chon Giay');[/FONT]
  [FONT=Tahoma]                           Writeln('+Ban B cung chon Giay');[/FONT]
  [FONT=Tahoma]                           Writeln('+Giay gap Giay, hoa nhau');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
238/Vẽ hình chử nhật rỗng:
Code:
 [FONT=Tahoma]Program Ve_hinh_chu_nhat;[/FONT]
  [FONT=Tahoma]CONST[/FONT]
  [FONT=Tahoma]          Hoathi='*';[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          r,d,i:Integer;[/FONT]
  [FONT=Tahoma]   tiep:Char;[/FONT]
  [FONT=Tahoma](*---------------*)[/FONT]
  [FONT=Tahoma]          PROCEDURE Ve(x,y:Integer);[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          k:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          For k:=1 To y Do[/FONT]
  [FONT=Tahoma]         Write(Hoathi);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]      For k:=1 To x-2 Do[/FONT]
  [FONT=Tahoma]          Writeln(Hoathi,Hoathi:y-1);[/FONT]
  [FONT=Tahoma]      For k:=1 To y Do[/FONT]
  [FONT=Tahoma]          Write(Hoathi);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma](*---------------*)[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Repeat[/FONT]
  [FONT=Tahoma]                   Writeln('VE HINH CHU NHAT RONG');[/FONT]
  [FONT=Tahoma]          Writeln('   Dung thu tuc');[/FONT]
  [FONT=Tahoma]          Writeln('---------------------');[/FONT]
  [FONT=Tahoma]          Write('-Chieu rong = ');[/FONT]
  [FONT=Tahoma]          Readln(r);[/FONT]
  [FONT=Tahoma]          Write('-Chieu dai = ');[/FONT]
  [FONT=Tahoma]          Readln(d);[/FONT]
  [FONT=Tahoma]          Ve(r,d);[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]      Write('  Co tiep tuc khong ? (c/k) ');[/FONT]
  [FONT=Tahoma]      Readln(tiep);[/FONT]
  [FONT=Tahoma]   Until Upcase(tiep)='K';[/FONT]
  [FONT=Tahoma]END. [/FONT]
239/Vẽ tam giác rỗng:
Code:
 [FONT=Tahoma]Program Tam_giac_rong;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          cao,i:Byte;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('VE TAM GIAC RONG');[/FONT]
  [FONT=Tahoma]   Writeln('----------------');[/FONT]
  [FONT=Tahoma]   Write('-Nhap chieu cao cua tam giac: ');[/FONT]
  [FONT=Tahoma]   Readln(cao);[/FONT]
  [FONT=Tahoma]   Writeln('*':cao);[/FONT]
  [FONT=Tahoma]   For i:=2 To cao-1 Do[/FONT]
  [FONT=Tahoma]          Writeln('*':cao-i+1,'*':2*i-2);[/FONT]
  [FONT=Tahoma]   For i:=1 To 2*cao-1 Do[/FONT]
  [FONT=Tahoma]          Write('*');[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
240/Xếp loại học tập:
Code:
 [FONT=Tahoma]Program Phan_loai;[/FONT]
  [FONT=Tahoma]Var[/FONT]
  [FONT=Tahoma]          ten:String;[/FONT]
  [FONT=Tahoma]          diem:Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('XEP LOAI HOC TAP');[/FONT]
  [FONT=Tahoma]   Writeln('----------------');[/FONT]
  [FONT=Tahoma]   Write('-Cho biet ten: ');[/FONT]
  [FONT=Tahoma]   Readln(ten);[/FONT]
  [FONT=Tahoma]   Write('-Cho biet diem: ');[/FONT]
  [FONT=Tahoma]   Readln(diem);[/FONT]
  [FONT=Tahoma]   Case diem Of[/FONT]
  [FONT=Tahoma]          0,1,2,3,4:     Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Hoc sinh: ',ten);[/FONT]
  [FONT=Tahoma]                     Writeln('+So diem : ',diem);[/FONT]
  [FONT=Tahoma]                     Writeln('+Xep loai KEM');[/FONT]
  [FONT=Tahoma]                                      End;[/FONT]
  [FONT=Tahoma]      5,6:                           Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Hoc sinh: ',ten);[/FONT]
  [FONT=Tahoma]                     Writeln('+So diem : ',diem);[/FONT]
  [FONT=Tahoma]                     Writeln('+Xep loai TRUNG BINH');[/FONT]
  [FONT=Tahoma]                             End;[/FONT]
  [FONT=Tahoma]      7,8:                           Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Hoc sinh: ',ten);[/FONT]
  [FONT=Tahoma]                     Writeln('+So diem : ',diem);[/FONT]
  [FONT=Tahoma]                     Writeln('+Xep loai KHA');[/FONT]
  [FONT=Tahoma]                             End;[/FONT]
  [FONT=Tahoma]      9:                             Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Hoc sinh: ',ten);[/FONT]
  [FONT=Tahoma]                     Writeln('+So diem : ',diem);[/FONT]
  [FONT=Tahoma]                     Writeln('+Xep loai GIOI');[/FONT]
  [FONT=Tahoma]                             End;[/FONT]
  [FONT=Tahoma]      10:                            Begin[/FONT]
  [FONT=Tahoma]                                                Writeln('+Hoc sinh: ',ten);[/FONT]
  [FONT=Tahoma]                     Writeln('+So diem : ',diem);[/FONT]
  [FONT=Tahoma]                     Writeln('+Xep loai XUAT SAC');[/FONT]
  [FONT=Tahoma]                             End;[/FONT]
  [FONT=Tahoma]      Else        Writeln('Khong co loai diem nay hoac ban go sai');[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('   Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
241/Ma trận chuyển vị:
Code:
 [FONT=Tahoma]Program Ma_tran_Chuyen_Vi;[/FONT]
  [FONT=Tahoma]          Uses Crt;[/FONT]
  [FONT=Tahoma]          Const[/FONT]
  [FONT=Tahoma]          Max=10;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          a:Array[1..Max, 1..Max] Of Integer;[/FONT]
  [FONT=Tahoma]   Procedure Tao;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]      j,k:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Randomize;[/FONT]
  [FONT=Tahoma]      For k:=1 To Max Do[/FONT]
  [FONT=Tahoma]          For j:= 1 To Max Do[/FONT]
  [FONT=Tahoma]          a[k,j]:=Random(100);[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {----------------}[/FONT]
  [FONT=Tahoma]   Procedure Xuat;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          k,j:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Window(5,3,36,24);[/FONT]
  [FONT=Tahoma]          For k:=1 to Max Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          For j:=1 To Max Do[/FONT]
  [FONT=Tahoma]                   Write(a[k,j]:3);[/FONT]
  [FONT=Tahoma]            Writeln(#10);[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]      Window(45,3,76,24);[/FONT]
  [FONT=Tahoma]      For k:=1 To Max Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          If Odd(k) Then[/FONT]
  [FONT=Tahoma]                   For j:= 1 To Max Do[/FONT]
  [FONT=Tahoma]                   Write(a[k,j]:3)[/FONT]
  [FONT=Tahoma]            Else[/FONT]
  [FONT=Tahoma]                   For J:=Max Downto 1 Do[/FONT]
  [FONT=Tahoma]                   Write(a[k,j]:3);[/FONT]
  [FONT=Tahoma]            Writeln(#10);[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]   Writeln('CHUYEN VI PHAN TU CUA MA TRAN');[/FONT]
  [FONT=Tahoma]   Writeln('     --------------');[/FONT]
  [FONT=Tahoma]   Tao;[/FONT]
  [FONT=Tahoma]   Xuat;[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
242/Giải thuật quicksort:
Code:
 [FONT=Tahoma]Program Gt_QuickSort;[/FONT]
  [FONT=Tahoma]          Uses Crt;[/FONT]
  [FONT=Tahoma]          Const[/FONT]
  [FONT=Tahoma]          Max=1000;[/FONT]
  [FONT=Tahoma]   Type[/FONT]
  [FONT=Tahoma]                   Mang = Array[1..Max] Of Integer;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          a:Mang;[/FONT]
  [FONT=Tahoma]      i:Integer;[/FONT]
  [FONT=Tahoma]   {-------------------}[/FONT]
  [FONT=Tahoma]   Procedure Hoanvi(Var m,n : Integer);[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          Tam:Byte;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Tam:=m;[/FONT]
  [FONT=Tahoma]      m:=n;[/FONT]
  [FONT=Tahoma]      n:=Tam;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {-------------------}[/FONT]
  [FONT=Tahoma]   Procedure Xuat;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          i:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]          For i:= 1 to Max Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]                   If i Mod 240 =0  Then[/FONT]
  [FONT=Tahoma]                                                Readln;[/FONT]
  [FONT=Tahoma]                                      Write(' ',a[i]:6,' ');[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {-------------------}[/FONT]
  [FONT=Tahoma]   Procedure Nhap;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]         i:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          For i:=1 To Max Do[/FONT]
  [FONT=Tahoma]          a[i]:=Random(1000);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]      Write('  *Bam phim <Enter> de xem danh sach sap xep');[/FONT]
  [FONT=Tahoma]      Readln[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]          {-------------------}[/FONT]
  
  [FONT=Tahoma]   Procedure QuickSort(Var A: Mang; Lo,Hi: Integer);[/FONT]
  [FONT=Tahoma]          Procedure Sort(Left, Right:Integer);[/FONT]
  [FONT=Tahoma]                   Var[/FONT]
  [FONT=Tahoma]                   i,j,x:Integer;[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]                   i:=Left;[/FONT]
  [FONT=Tahoma]                   j:=Right;[/FONT]
  [FONT=Tahoma]          x:=a[(Left + Right) Div 2];[/FONT]
  [FONT=Tahoma]          Repeat[/FONT]
  [FONT=Tahoma]                   While a[i] < x Do[/FONT]
  [FONT=Tahoma]                             Inc(i);[/FONT]
  [FONT=Tahoma]          While x < a[j] Do[/FONT]
  [FONT=Tahoma]                    Dec(j);[/FONT]
  [FONT=Tahoma]          If i <=j Then[/FONT]
  [FONT=Tahoma]                   Begin[/FONT]
  [FONT=Tahoma]                             Hoanvi(a[i],a[j]);[/FONT]
  [FONT=Tahoma]                   Inc(i);[/FONT]
  [FONT=Tahoma]                   Dec(j);[/FONT]
  [FONT=Tahoma]                   End;[/FONT]
  [FONT=Tahoma]                   Until i > j;[/FONT]
  [FONT=Tahoma]          If Left < j Then[/FONT]
  [FONT=Tahoma]                   Sort(Left,j);[/FONT]
  [FONT=Tahoma]          If i < Right Then[/FONT]
  [FONT=Tahoma]                   Sort(i,Right);[/FONT]
  [FONT=Tahoma]          End;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Sort(Lo,Hi);[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]   {-------------------}[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]   Writeln('GIAI THUAT QUICKSORT');[/FONT]
  [FONT=Tahoma]   Writeln('--------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          Nhap;[/FONT]
  [FONT=Tahoma]   Quicksort(a,1,Max);[/FONT]
  [FONT=Tahoma]   Xuat;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('    Bam phim <Enter> de ket thuc');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
243/Tìm tuần tự:
Code:
 [FONT=Tahoma]Program Tim_Tuan_Tu;[/FONT]
  [FONT=Tahoma]          Uses Crt;[/FONT]
  [FONT=Tahoma]          Const[/FONT]
  [FONT=Tahoma]          Max= 100;[/FONT]
  [FONT=Tahoma]   Type[/FONT]
  [FONT=Tahoma]          Mang=Array[1..Max] Of Integer;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          Pti: Mang;[/FONT]
  [FONT=Tahoma]      So:Integer;[/FONT]
  [FONT=Tahoma]{-----------------------------------}[/FONT]
  [FONT=Tahoma]   Function TuanTu(X:Integer; A:Mang;N:Integer):Integer;[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          i:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          i:=1;[/FONT]
  [FONT=Tahoma]      While (i <=N) And Not(X=A[i]) Do[/FONT]
  [FONT=Tahoma]          Inc(i);[/FONT]
  [FONT=Tahoma]      If i <=N Then[/FONT]
  [FONT=Tahoma]          TuanTu:=i[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          TuanTu:=0;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-----------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure TaoMang(Var A:Mang; N:Integer);[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          i:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Randomize;[/FONT]
  [FONT=Tahoma]      For i:= 1 To N Do[/FONT]
  [FONT=Tahoma]          A[i]:=Random(3000);[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-----------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure InMang(A:Mang; N:Integer);[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          i:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          For i:= 1 To N Do[/FONT]
  [FONT=Tahoma]          Write(A[i]:8);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-----------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure TimX(X:Integer; A:Mang; N:Integer);[/FONT]
  [FONT=Tahoma]          Var[/FONT]
  [FONT=Tahoma]          j:Integer;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          j:=TuanTu(X,A,N);[/FONT]
  [FONT=Tahoma]      If j <> 0 Then[/FONT]
  [FONT=Tahoma]          Writeln('So: ',X:3,' la gia tri cua phan tu thu: ',j:2)[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          Writeln('Khong co phan tu nao bang so : ',So);[/FONT]
  [FONT=Tahoma]      Writeln;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{-----------------------------------}[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]          Writeln('GIAI THUAT TIM KIEM TUAN TU');[/FONT]
  [FONT=Tahoma]   Writeln('---------------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('-Tao 100 so ngau nhien');[/FONT]
  [FONT=Tahoma]   TaoMang(Pti,100);[/FONT]
  [FONT=Tahoma]   Write('-Bam phim <Enter> de in mang ');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]   InMang(Pti,100);[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          Writeln;[/FONT]
  [FONT=Tahoma]          Write('-Ban can tim so nao: ');[/FONT]
  [FONT=Tahoma]      Readln(So);[/FONT]
  [FONT=Tahoma]      TimX(So,Pti,100);[/FONT]
  [FONT=Tahoma]      Write('Bam <Enter> de tim so khac, <Esc> de cham dut ');[/FONT]
  [FONT=Tahoma]   Until Readkey = #27;[/FONT]
  [FONT=Tahoma]END. [/FONT]
244/Bản ghi và con trỏ:
Code:
 [FONT=Tahoma]Program Ban_ghi_va_Con_Tro;[/FONT]
  [FONT=Tahoma]Uses Crt;[/FONT]
  [FONT=Tahoma]TYPE[/FONT]
  [FONT=Tahoma]          ConTro = ^LyLich;[/FONT]
  [FONT=Tahoma]   LyLich = RECORD[/FONT]
  [FONT=Tahoma]          HoLot : String[17];[/FONT]
  [FONT=Tahoma]      Ten   : String[7];[/FONT]
  [FONT=Tahoma]      BacLuong,PhuCap,Tong : LongInt;[/FONT]
  [FONT=Tahoma]      Next : ConTro;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]          First, Last, Newp : ConTro;[/FONT]
  [FONT=Tahoma]   Ch : Char;[/FONT]
  [FONT=Tahoma]   i : Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]   GoToXY(5,25);[/FONT]
  [FONT=Tahoma]   Write('Bam nut bat ky de tiep tuc. Bam <Esc> de dung ');[/FONT]
  [FONT=Tahoma]   Window(1,1,80,24);[/FONT]
  [FONT=Tahoma]   Writeln('**       CHUONG TRINH TINH LUONG    **');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('               Thang 11 nam 1999');[/FONT]
  [FONT=Tahoma]   First := NIL; {Khoi tao bien First la con tro rong}[/FONT]
  [FONT=Tahoma]   i := 0;[/FONT]
  [FONT=Tahoma]   Repeat[/FONT]
  [FONT=Tahoma]          i := i + 1;[/FONT]
  [FONT=Tahoma]      New(Newp); {Khoi tao bien cn tro moi la bien Newp}[/FONT]
  [FONT=Tahoma]      With Newp^ Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Write('-Ho cua nguoi thu: ',i:2,' la= ');[/FONT]
  [FONT=Tahoma]            Readln(Holot);[/FONT]
  [FONT=Tahoma]            Write('-Ten = ');[/FONT]
  [FONT=Tahoma]            Readln(Ten);[/FONT]
  [FONT=Tahoma]            Write('-Bac luong = ');[/FONT]
  [FONT=Tahoma]            Readln(BacLuong);[/FONT]
  [FONT=Tahoma]            Write('-Phu cap = ');[/FONT]
  [FONT=Tahoma]            Readln(PhuCap);[/FONT]
  [FONT=Tahoma]            Tong := Trunc(BacLuong * 102.27) + PhuCap;[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]      If First = NIL Then[/FONT]
  [FONT=Tahoma]          First := Newp[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          Last^.Next := Newp;[/FONT]
  [FONT=Tahoma]      Last := Newp;[/FONT]
  [FONT=Tahoma]      Last^.Next := NIL;[/FONT]
  [FONT=Tahoma]      Ch := Readkey;[/FONT]
  [FONT=Tahoma]   Until Ch = #27;[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   While First <> NIL Do[/FONT]
  [FONT=Tahoma]          With First^ Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Writeln('-Ong ba: ',HoLot,' ',Ten);[/FONT]
  [FONT=Tahoma]            Writeln('-Bac luong: ',BacLuong:8,' -Phu cap: ',PhuCap : 6);[/FONT]
  [FONT=Tahoma]                                      Writeln('+Tien linh : ',Tong:8,' Dong');[/FONT]
  [FONT=Tahoma]            First :=Next;[/FONT]
  [FONT=Tahoma]                                      Writeln;[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
245/Quá trình sử dụng biến con trỏ:
Code:
 [FONT=Tahoma]Program Con_Tro;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]          p, q : ^Integer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('QUA TRINH SU DUNG BIEN CON TRO');[/FONT]
  [FONT=Tahoma]   Writeln('------------------------------');[/FONT]
  [FONT=Tahoma]   Writeln('-Buoc 1:Khai bao bien con tro p,q');[/FONT]
  [FONT=Tahoma]   Writeln('    Vung nho bay gio la: ',MemAvail,' bytes');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('-Buoc 2:Cap vung nho cho 2 bien dong p,q');[/FONT]
  [FONT=Tahoma]          New(p); {Cap phat vung nho cho p^}[/FONT]
  [FONT=Tahoma]   New(q); {Cap phat vung nho cho q^}[/FONT]
  [FONT=Tahoma]   Writeln('    Vung nho bay gio la: ',MemAvail,' bytes');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('-Buoc 3:Dien noi dung vao vung nho va thao tac');[/FONT]
  [FONT=Tahoma]   p^ := 1;{Dien noi dung vao vung nho cho p^}[/FONT]
  [FONT=Tahoma]   q^ := 1;{Dien noi dung vao vung nho cho q^}[/FONT]
  [FONT=Tahoma]   p^ := p^ + q^; {Thuc hien bieu thuc chua bien dong}[/FONT]
  [FONT=Tahoma]   Writeln('-p^ = ',p^);[/FONT]
  [FONT=Tahoma]   Writeln('-q^ = ',q^);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('    Vung nho bay gio la: ',MemAvail,' bytes');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('-Buoc 4:Giai phong vung nho ');[/FONT]
  [FONT=Tahoma]   Dispose(p);[/FONT]
  [FONT=Tahoma]   Dispose(q);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          Writeln('       Vung nho bay gio la: ',MemAvail,' bytes');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
246/Thủ tục FREEMEN & DISPOSE:
Code:
 [FONT=Tahoma]Program Thu_Tuc_FreeMem_Dispose;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]   p1       : ^Integer;[/FONT]
  [FONT=Tahoma]   p2       : ^String;[/FONT]
  [FONT=Tahoma]   p3       : ^Real;[/FONT]
  [FONT=Tahoma]   k        : Word;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('THU TUC FREEMEM VA DISPOSE');[/FONT]
  [FONT=Tahoma]   Writeln('--------------------------');[/FONT]
  [FONT=Tahoma]   Writeln('-Khi moi bat dau chuong trinh thi');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   New(p1);[/FONT]
  [FONT=Tahoma]   P1^ :=12345;[/FONT]
  [FONT=Tahoma]   Writeln('-Noi dung cua bien dong P1 la: ',P1^);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P1 (kieu Integer)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   k := Sizeof(p2^);[/FONT]
  [FONT=Tahoma]   GetMem(p2,Sizeof(p2^));[/FONT]
  [FONT=Tahoma]   P2^ :='Nha sach Minh Khai, 249 Nguyen Thi Minh Khai, Q1, Tel 8.331.124';[/FONT]
  [FONT=Tahoma]   Writeln('-Noi dung cua bien dong P2 la: ',P2^);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P2 (kieu String)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          New(p3);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P3 (kieu Real)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+   Bam phim <Enter> de xoa bien P1 bang thu tuc Dispose');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]   Dispose(p1);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi Xoa cac bien dong P1 (kieu Integer) ');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap bay gio la: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+   Bam phim <Enter> de xoa bien P2 bang thu tuc FreeMem');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]   Freemem(p2,k);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi Xoa cac bien dong P2 (kieu String) ');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap bay gio la: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('+   Bam phim <Enter> de xoa bien P3 bang thu tuc Dispose');[/FONT]
  [FONT=Tahoma]   Readln;[/FONT]
  [FONT=Tahoma]   Dispose(p3);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi Xoa cac bien dong P1 (kieu Integer) ');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap bay gio la: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Writeln('      Bam phim <Enter> de ket thuc ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
247/Thủ tục Dispose:
Code:
 [FONT=Tahoma]Program Thu_Tuc_Dispose;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]   p1       : ^Integer;[/FONT]
  [FONT=Tahoma]   p2       : ^String;[/FONT]
  [FONT=Tahoma]   p3       : ^Real;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('THU TUC DISPOSE');[/FONT]
  [FONT=Tahoma]   Writeln('---------------');[/FONT]
  [FONT=Tahoma]   Writeln('-Khi moi bat dau chuong trinh thi');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   New(p1);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P1 (kieu Integer)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   New(p2);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P2 (kieu String)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          New(p3);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P3 (kieu Real)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Dispose(p2);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi Xoa cac bien dong P2 (kieu String) ');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap bay gio la: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
248/Thủ tục release:
Code:
 [FONT=Tahoma]Program Thu_Tuc_Release;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]   p1       : ^Integer;[/FONT]
  [FONT=Tahoma]   p2       : ^String;[/FONT]
  [FONT=Tahoma]   p3       : ^Real;[/FONT]
  [FONT=Tahoma]   p        : Pointer;[/FONT]
  [FONT=Tahoma]Begin[/FONT]
  [FONT=Tahoma]          Writeln('THU TUC RELEASE');[/FONT]
  [FONT=Tahoma]   Writeln('---------------');[/FONT]
  [FONT=Tahoma]   Writeln('-Khi moi bat dau chuong trinh thi');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   New(p1);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P1 (kieu Integer)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Mark(p);[/FONT]
  [FONT=Tahoma]   New(p2);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P2 (kieu String)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          New(p3);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi cap phat bo nho cho bien dong P3 (kieu Real)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap con: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Release(p);[/FONT]
  [FONT=Tahoma]   Writeln('-Sau khi Xoa cac bien dong P2 (kieu String) va P3 (kieu Real)');[/FONT]
  [FONT=Tahoma]   Writeln('Vung nho Heap bay gio la: ',MemAvail,' bytes trong');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]End. [/FONT]
249/Danh sách vòng:
Code:
 [FONT=Tahoma]Program Danh_Sach_Vong;[/FONT]
  [FONT=Tahoma]Uses Crt;[/FONT]
  [FONT=Tahoma]TYPE[/FONT]
  [FONT=Tahoma]          Chuoi = String[24];[/FONT]
  [FONT=Tahoma]   NodePtr = ^Node;[/FONT]
  [FONT=Tahoma]   Node = RECORD[/FONT]
  [FONT=Tahoma]          Doivien : Chuoi;[/FONT]
  [FONT=Tahoma]      Next    : NodePtr;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]          R : NodePtr;[/FONT]
  [FONT=Tahoma]   N  : Word;[/FONT]
  [FONT=Tahoma]   HeapTop : Pointer;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure Append(St : Chuoi);[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          P : NodePtr;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          New(P);[/FONT]
  [FONT=Tahoma]      P^.Doivien := St;[/FONT]
  [FONT=Tahoma]      If R = Nil Then[/FONT]
  [FONT=Tahoma]          R := P[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          P^.Next := R^.Next;[/FONT]
  [FONT=Tahoma]      R^.Next := P;[/FONT]
  [FONT=Tahoma]      R := P;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]          Function Next(P: NodePtr) : NodePtr;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          If P <> R Then[/FONT]
  [FONT=Tahoma]          Next := P^.Next[/FONT]
  [FONT=Tahoma]      Else[/FONT]
  [FONT=Tahoma]          Next := Nil;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]          procedure Display;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          P : NodePtr;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]      P := R^.Next;[/FONT]
  [FONT=Tahoma]      While P <> Nil Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          Writeln(P^.Doivien);[/FONT]
  [FONT=Tahoma]            P := Next(P);[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure Input;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          St : Chuoi;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Writeln('NHAP DANH SACH DOI VIEN');[/FONT]
  [FONT=Tahoma]                   Writeln('-----------------------');[/FONT]
  [FONT=Tahoma]                   Writeln;[/FONT]
  [FONT=Tahoma]      Repeat[/FONT]
  [FONT=Tahoma]                             Write('-Doi vien: ');[/FONT]
  [FONT=Tahoma]                             Readln(St);[/FONT]
  [FONT=Tahoma]                             Append(St);[/FONT]
  [FONT=Tahoma]                             Writeln('          Bam <Enter> de nhap tiep, bam <Esc> de ngung ');[/FONT]
  [FONT=Tahoma]          Until Readkey = #27;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure DeleteNode(N :Word; Var P : NodePtr);[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          i : Word;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          i := 1;[/FONT]
  [FONT=Tahoma]      While i < N-1 Do[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          P := P^.Next;[/FONT]
  [FONT=Tahoma]            Inc(i);[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  [FONT=Tahoma]      If Next(P) = R Then[/FONT]
  [FONT=Tahoma]          R :=R^.Next;[/FONT]
  [FONT=Tahoma]      P^.Next := P^.Next^.Next;[/FONT]
  [FONT=Tahoma]      P := P^.Next;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]   Procedure Loaibo;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          N,i : Word;[/FONT]
  [FONT=Tahoma]      P   : NodePtr;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Write('-So de dem: ');[/FONT]
  [FONT=Tahoma]      Readln(n);[/FONT]
  [FONT=Tahoma]      If R <> Nil Then[/FONT]
  [FONT=Tahoma]          Begin[/FONT]
  [FONT=Tahoma]          P := R^.Next;[/FONT]
  [FONT=Tahoma]            While R^.Next <> R Do[/FONT]
  [FONT=Tahoma]                   Begin[/FONT]
  [FONT=Tahoma]                   DeleteNode(N,P);[/FONT]
  [FONT=Tahoma]                  Display;[/FONT]
  [FONT=Tahoma]                  GotoXY(10,22);[/FONT]
  [FONT=Tahoma]                  Writeln('Bam phim <Enter> de chon doi vien ke tiep ');[/FONT]
  [FONT=Tahoma]                  Readln;[/FONT]
  [FONT=Tahoma]               End;[/FONT]
  [FONT=Tahoma]         End;[/FONT]
  
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{--------------------------------------}[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          ClrScr;[/FONT]
  [FONT=Tahoma]          Mark(Heaptop);[/FONT]
  [FONT=Tahoma]   R := Nil;[/FONT]
  [FONT=Tahoma]   Input;[/FONT]
  [FONT=Tahoma]   ClrScr;[/FONT]
  [FONT=Tahoma]   Loaibo;[/FONT]
  [FONT=Tahoma]   ClrScr;[/FONT]
  [FONT=Tahoma]   Release(HeapTop);[/FONT]
  [FONT=Tahoma]END. [/FONT]
250/DateObject:
Code:
 [FONT=Tahoma]Program DateObject;[/FONT]
  [FONT=Tahoma]Uses Dos;  {Su dung Unit Dos }[/FONT]
  [FONT=Tahoma]TYPE[/FONT]
  [FONT=Tahoma]          Date = OBJECT[/FONT]
  [FONT=Tahoma]          Month,Day : Byte;[/FONT]
  [FONT=Tahoma]      Year : Word;[/FONT]
  [FONT=Tahoma]      Procedure Init(dd,mm,yy : Word);[/FONT]
  [FONT=Tahoma]      Function StrDate : String;[/FONT]
  [FONT=Tahoma]      End;[/FONT]
  [FONT=Tahoma]VAR[/FONT]
  [FONT=Tahoma]          Today : Date;[/FONT]
  [FONT=Tahoma]   Regs : Registers;[/FONT]
  [FONT=Tahoma]{----------------------------------}[/FONT]
  [FONT=Tahoma]          Procedure Date.Init;[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Day   := dd;[/FONT]
  [FONT=Tahoma]          Month := mm;[/FONT]
  [FONT=Tahoma]      Year  := yy;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{----------------------------------}[/FONT]
  [FONT=Tahoma]          Function Date.StrDate;[/FONT]
  [FONT=Tahoma]   Var[/FONT]
  [FONT=Tahoma]          Strdd,Strmm,Stryy : String[4];[/FONT]
  [FONT=Tahoma]   Begin[/FONT]
  [FONT=Tahoma]          Str(Day,Strdd);[/FONT]
  [FONT=Tahoma]      Str(Month,Strmm);[/FONT]
  [FONT=Tahoma]      Str(Year,Stryy);[/FONT]
  [FONT=Tahoma]      StrDate := Strdd + '/'+ Strmm + '/' + Stryy;[/FONT]
  [FONT=Tahoma]   End;[/FONT]
  [FONT=Tahoma]{----------------------------------}[/FONT]
  [FONT=Tahoma]BEGIN[/FONT]
  [FONT=Tahoma]          Writeln('DINH NGHIA KIEU CHA, KHONG DINH NGHIA KIEU CON');[/FONT]
  [FONT=Tahoma]   Writeln('         Xem ngay hien hanh cua may');[/FONT]
  [FONT=Tahoma]   Writeln('----------------------------------------------');[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]          Regs.Ah := 42;[/FONT]
  [FONT=Tahoma]   MsDos(Regs);[/FONT]
  [FONT=Tahoma]   With Regs Do[/FONT]
  [FONT=Tahoma]          Today.Init(dl, dh, cx);[/FONT]
  [FONT=Tahoma]   Writeln('-Hom nay la ngay: ',Today.StrDate);[/FONT]
  [FONT=Tahoma]   Writeln;[/FONT]
  [FONT=Tahoma]   Write('       Xem xong, bam <Enter>. . . ');[/FONT]
  [FONT=Tahoma]   Readln[/FONT]
  [FONT=Tahoma]END. [/FONT]
 
xây nhà trọn gói tại quảng ngãi xây nhà trọn gói quảng ngãi xây nhà trọn gói tại quảng ngãi nội thất quảng ngãi
Top