Kết quả 1 đến 3 của 3
  1. #1
    Ngày tham gia
    Aug 2011
    Bài viết
    447

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

    1/Sắp Xếp Theo Tên:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
      Program Hoan_Vi_Chuoi;
      Uses Crt;
      VAR
         Chuoi1,Chuoi2,Tam :^String;
      Begin
         ClrScr;
         Writeln('HOAN VI 2 CON TRO THAY CHO HOAN VI NOI DUNG');
         Writeln('-------------------------------------------');
         Writeln;
         New(Chuoi1);
         New(Chuoi2);
         Chuoi1^ := 'Giao trinh Turbo Pascal 7.0';
         Chuoi2^ := 'Giao trinh FoxPro 2.6';
         Writeln;
         Writeln('NOI DUNG BAN DAU CUA 2 CHUOI');
         Writeln('----------------------------');
         Writeln;
         Writeln('-Chuoi thu nhat: ',Chuoi1^);
         Writeln('-Chuoi thu hai : ',Chuoi2^);
         Writeln;
         Writeln('NOI DUNG SAU KHI HOAN VI 2 CON TRO');
         Writeln('----------------------------------');
         Writeln;
         Tam := Chuoi1;
         Chuoi1 := Chuoi2;
         Chuoi2 := Tam;
         Writeln('-Chuoi thu nhat: ',Chuoi1^);
         Writeln('-Chuoi thu hai : ',Chuoi2^);
         Dispose(Chuoi1);
         Dispose(Chuoi2);
         Writeln;
         Write('     Bam <Enter> . . . ');
         Readln;
      End.
    8/Tách danh sách chẳn lẻ:
    Mã:
      Program Tach_Danh_Sach_Chan_Le;
      Uses Crt;
      TYPE
                      Mang = Array[1..100] Of Integer;
      VAR
                      i,j,k,n : Integer;
      a,b,c : Mang;
      Begin
         ClrScr;
         Writeln('                     NHAP DANH SACH');
         Writeln('                     --------------');
         Write('-So phan tu: ');
         Readln(n);
         For i := 1 To n Do
            Begin
               Write('-Phan tu thu: ',i:2,' = ');
               Readln(a[i]);
            End;
         Writeln;
         Writeln('TACH THANH 2 DANH SACH');
         Writeln('----------------------');
         Writeln;
         j := 1;
         k := 1;
         For i := 1 To n Do
            If  Odd(a[i]) Then
               Begin
                  b[j] := a[i];
                  j := j + 1;
               End
            Else
               Begin
                  c[k] :=a[i];
                  k := k + 1;
               End;
         Writeln;
         Writeln('       -Danh sach thu nhat ( so le ) ');
         Writeln;
         For i := 1 To j-1 Do Write(b[i],' ');
         Writeln;
         Writeln;
         Writeln('       -Danh sach thu hai ( so chan ) ');
         Writeln;
         For i := 1 To k-1 Do Write(c[i],' ');
         Writeln;
         Write('          Bam <Enter> . . . ');
         Readln
      End.
    9/Đảo ngược danh sách:
    Mã:
      Program Dao_Nguoc_Danh_Sach;
      Uses Crt;
      TYPE
         ConTro = ^Nut;
         Nut = RECORD
             So : Integer;
             Next : ConTro;
          End;
      VAR
         Nut1,Tam1,Tam2 : ConTro;
         Ch       : Char;
      BEGIN
         ClrScr;
         Writeln('                DAO NGUOC DANH SACH');
         Writeln('                -------------------');
         Nut1 := Nil;
         Repeat
            New(Tam1);
            Write('-Nhap so: ');
            Readln(Tam1^.So);
            Tam1^.Next := Nut1;
            Nut1 := Tam1;
            Write('               Nhap nua khong ? (c/k) ');
            Readln(Ch);
         Until UpCase(Ch)= 'K';
         Tam1 := Nut1;
         Nut1 := Nil;
         Repeat
            Tam2 := Tam1^.Next;
            Tam1^.Next := Nut1;
            Nut1 := Tam1;
            Tam1 := Tam2;
         Until Tam1 = Nil;
         Writeln('Sau khi dao: ');
         Tam1 := Nut1;
         While Tam1 <> Nil Do
             Begin
               Write(Tam1^.So:6);
               Tam1 := Tam1^.Next;
            End;
         Writeln;
         Write('     Bam <Enter> . . . ');
         Readln
      END.
    10/Ghép Chuỗi:
    Mã:
      Program Ghep_Chuoi;
      Uses Crt;
      TYPE
        ConTro = ^Nut;
        Nut = RECORD
            Kt   : Char;
            Next : ConTro;
        End;
      VAR
         Dau1,Cuoi1 : ConTro;
         Dau2,Cuoi2 : ConTro;
         Tam        : ConTro;
         Ch         : Char;
         i          : Integer;
      BEGIN
         ClrScr;
         Writeln('CHUOI THU NHAT');
         Writeln('--------------');
         Writeln;
         i := 0;
         Repeat
            i := i + 1;
            New(Tam);
            Write('-Ky tu thu: ',i:2,' : ');
            Readln(Tam^.Kt);
            If i = 1 Then
            Begin
                  Dau1 := Tam;
                  Cuoi1 := Tam;
            End
            Else
            Begin
                  Cuoi1^.Next := Tam;
                  Cuoi1 := Tam;
            End;
            Write('Nhap nua khong ? (c/k) ');
            Readln(Ch);
         Until UpCase(Ch) = 'K';
         ClrScr;
         Writeln('CHUOI THU HAI');
         Writeln('--------------');
         Writeln;
         i := 0;
         Repeat
            i := i + 1;
            New(Tam);
            Write('-Ky tu thu: ',i:2,' : ');
            Readln(Tam^.Kt);
            If i = 1 Then
               Begin
                  Dau2  := Tam;
                  Cuoi2 := Tam;
               End
            Else
               Begin
                  Cuoi2^.Next := Tam;
                  Cuoi2 := Tam;
               End;
            Write('Nhap nua khong ? (c/k) ');
            Readln(Ch);
         Until UpCase(Ch) = 'K';
         Cuoi1^.Next := Dau2;
         Cuoi2^.Next :=Nil;
         Writeln;
         Writeln(' KET QUA');
         Writeln('---------');
         Tam := Dau1;
         While Tam <> Nil Do
             Begin
               Write(Tam^.Kt);
               Tam := Tam^.Next;
             End;
         Writeln;
         Write('     Bam <Enter> . . . ');
         Readln
      END.
    11/Cây nhị phân (hay):
    Mã:
      Program Cay_Nhi_Phan;
      Uses Crt;
      TYPE
         Str = String[24];
         ConTro = ^BanGhi;
         BanGhi = RECORD
            HoTen : Str;
            Luong : Real;
            Trai,Phai : ConTro;
            End;
      VAR
         Goc       : ConTro;
         Nv        : BanGhi;
         Ketthuc  : Boolean;
         Ch         : Char;
      {--------------------------------}
      Procedure Chen(Var Goc : ConTro; Nv : BanGhi);
         Var
                      P,P1 : ConTro;
         Begin
              If goc = Nil Then
                  Begin
                      New(Goc);
                      With Goc^ Do
                         Begin
                                      HoTen := NV.HoTen;
                        Luong := NV.Luong;
                                      Trai  := Nil;
                        Phai  := Nil;
                           End;
                  End
              Else
                  Begin
                      P := Goc;
                      P1 := Nil;
                      While P <> Nil Do
                        Begin
                          P1 := P;
                            If Nv.HoTen <= P^.HoTen Then
                                      P := P^.Trai
                            Else
                                      P := P^.Phai;
                          End;
                  New(P);
                  With P^ Do
                      Begin
                      HoTen := NV.HoTen;
                        Luong := NV.Luong;
                        Trai := Nil;
                        Phai := Nil;
                     End;
                  If NV.HoTen <=P1^.HoTen Then
                      P1^.Trai := P
                  Else
                      P1^.Phai := P;
               End;
         End;
      {--------------------------------}
      Procedure Xoa(Var Goc : ConTro; Nv : BanGhi);
      Var
         P,P1,Q,Q1 : ConTro;
         Nhanh :(NhanhTrai,NhanhPhai);
         Begin
            If Goc = Nil Then Writeln('Cay rong')
            Else
               Begin
                  P := Goc;
                  P1 := Nil;
                  While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
                      Begin
                      P1 := P;
                        If Nv.HoTen < P^.HoTen Then
                                      Begin
                                      P := P^.Trai;
                              Nhanh := NhanhTrai;
                           End
                        Else
                                      Begin
                                      P := P^.Phai;
                              Nhanh := NhanhPhai;
                           End;
                     End;
                  If P = Nil Then
                      Writeln('Khong tim thay')
                  Else
                      Begin
                      If (P^.Trai = Nil) Then
                                      Q := P^.Phai
                        Else
                                      Begin
                                      Q := P^.Trai;
                              Q1 := Nil;
                              While Q^.Phai <> Nil Do
                                      Begin
                                      Q1 := Q;
                                    Q := Q^.Phai;
                                 End;
                              If Q1  <> Nil Then
                                      Begin
                                      Q1^.Phai := Q^.Trai;
                                    Q^.Trai := P^.Trai;
                                 End;
                              If P1 = Nil Then
                                      Goc := Q
                              Else
                                      Begin
                                      If Nhanh = NhanhTrai Then
                                      P1^.Trai := Q
                                    Else
                                      P1^.Phai := Q;
                                 End;
                              Dispose(P);
                           End;
                     End;
               End;
         End;
      {--------------------------------}
      Procedure Tim(Goc : ConTro; Nv : BanGhi);
      Var
                      P : ConTro;
      Begin
      P := Goc;
      While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
      If NV.HoTen < P^.HoTen Then
         P := P^.Trai
      Else
         P := P^.Phai;
      If P = Nil Then        Writeln('Khong tim thay')
            Else
                      Begin
                      Writeln('Tim thay');
                  Writeln(P^.HoTen,' ', P^.Luong:8:1);
               End;
         End;
      {--------------------------------}
      Procedure LNRLietKe(Goc : ConTro);
         Begin
                      If Goc =  Nil Then
                      Begin
                      Writeln('Cay rong, chua co du lieu');
               End
            Else
                      Begin
                      If Goc^.Trai <> Nil Then
                      LNRLietKe(Goc^.Trai);
                  Writeln(Goc^.HoTen,', ',Goc^.Luong:8:1);
                  If Goc^.Phai <> Nil Then
                     LNRLietKe(Goc^.Phai);
               End;
         End;
      {--------------------------------}
      BEGIN
      Repeat
                      ClrScr;
                      Writeln;
                      Writeln('CAC CHUC NANG CAY NHI PHAN');
                      Writeln('--------------------------');
                      Writeln;
                      Writeln('1-Khoi tao cay');
                      Writeln('2-Noi them vao cay');
                      Writeln('3-Xoa khoi cay');
                      Writeln('4-Tim kiem tren cay');
                      Writeln('5-Liet ke danh sach');
                      Writeln('6-Ket thuc chuong trinh');
            Writeln;
                      Write('Chon cac chuc nang tu 1 den 6: ');
                      Readln(Ch);
                      Case Ch Of
                      '1'             : Begin
                                      ClrScr;
                                                                                         Writeln('1-KHOI TAO CAY');
                           Writeln('Cay co thu tu LNR');
                           Writeln('-----------------');
                           Writeln;
                         Goc := Nil;
                         KetThuc := False;
                        Repeat
                           With Nv Do
                              Begin
                                Write('-Ho ten hoac <Enter> de ngung: ');
                                 Readln(HoTen);
                                 If HoTen <> '' Then
                                      Begin
                                      Write('-Bac luong : ');
                                                      Readln(Luong);
                                                      Chen(Goc,Nv);
                                      End
                                      Else
                                      KetThuc := True;
                                      End;
                        Until ketThuc;
                                      End;
                      '2'             : Begin
                                      ClrScr;
                                      Writeln;
                                      Writeln('2-NOI VAO CAY THEO THU TU');
                           Writeln('-------------------------');
                           Writeln;
                         KetThuc := False;
                           Repeat
                           With Nv Do
                              Begin
                              Write('-Ho ten hoac <Enter> de ngung: ');
                              Readln(HoTen);
                              If HoTen <> '' Then
                              Begin
                                      Write('-Bac luong : ');
                                                      Readln(Luong);
                                                      Chen(Goc,Nv);
                                      End
                                      Else
                                                      KetThuc := True;
                                      End;
                                      Until ketThuc;
                                                                      End;
               '3'    :  Begin
                      ClrScr;
                        Writeln;
                      Writeln('3.XOA KHOI CAY');
                        Writeln('--------------');
                        Writeln;
                        KetThuc := False;
                        Repeat
                        With Nv Do
                        Begin
                        Write('Ho ten can xoa, hoac <Enter> de ngung: ');
                        Readln(HoTen);
                        If HoTen <> '' Then
                        Xoa(Goc,NV)
                                 Else
                                      KetThuc := True;
                        End;
                        Until KetThuc;
                      End;
               '4'    :               Begin
                                                                      ClrScr;
                                                                      Writeln('4-TIM KIEM TREN CAY');
                           Writeln('-------------------');
                           Writeln;
                           ketThuc := False;
                           Repeat
                                      With Nv Do
                                      Begin
                                      Write('Ho ten can tim, hoac <Enter> de ngung: ');
                                    Readln(HoTen);
                                    If HoTen <> '' Then
                                      Tim(Goc,NV)
                                    Else
                                      KetThuc := True;
                                 End;
                           Until KetThuc;
                                                      End;
               '5'    :               Begin
                                                                      ClrScr;
                                                                      Writeln('5-LIET KE NOI DUNG CAY');
                           Writeln('Hien thi theo thu tu ABC...');
                           Writeln('---------------------------');
                           Writeln;
                           LNRLietKe(Goc);
                           Writeln;
                           Write('Xem xong bam <Enter> . . . ');
                           Readln
                                                                                                      End;
               '6'    :                               Begin
                                                                      Writeln('7- KET THUC CHUONG TRINH');
                           Writeln;
                                                                                                      End;
            End;
         Until Ch = '6'
      END.
    12/Đổi thập phân ra nhị phân:
    Mã:
    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ự:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ẻ:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ử:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ã:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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.
    Bài viết liên quan

  2. #2
    Ngày tham gia
    Aug 2011
    Bài viết
    447
    101/Nhập số liệu cho 1 tập tin số nguyên:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ử:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ơ:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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 đá:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ử:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ự:
    Mã:
    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:
    Mã:
    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ử:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ị:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ó:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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ố:
    Mã:
    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:
    Mã:
    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:
    Mã:
    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.

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

Các Chủ đề tương tự

  1. Giáo trình CD-ROM Giáo trình Pascal
    Bởi trungtin1807 trong diễn đàn Tài Liệu
  2. Tổng hợp bài tập môn cấu trúc dữ liệu và giải thuật pascal
    Bởi loveIT trong diễn đàn Cấu trúc dữ liệu và giải thuật
  3. Giáo trình Pascal
    Bởi loveIT trong diễn đàn Tài Liệu
  4. Giáo trình Ngôn ngữ lập trình Pascal
    Bởi chatlove trong diễn đàn Tài Liệu
  5. Giáo trình lập trình Pascal nâng cao -Mediafire
    Bởi dayto.kdh trong diễn đàn Tài Liệu

Tag của Chủ đề này

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •  
Cam kết

Diễn đàn là một hệ thống mở, chúng tôi hoàn toàn không bảo đảm tính chính xác của nội dung và hoàn toàn không chịu trách nhiệm về bất kỳ nội dung nào. Đứng trên lập trường khách quan, chúng tôi tôn trọng tất cả các bài viết và ý kiến của bạn đọc. Chúng tôi chỉ xóa nội dung được cho là vi phạm bản quyền khi có yêu cầu từ phía tác giả hoặc đại diện.

Tài trợ
Trang điểm cô dâu | xem video tin tuc tai homevn.net | chữ ký số viettel, chữ ký số | m88.com | Sinh viên Thương mại | Miễn phí Tai Viber cho mobile | Tin tức hot nhất 24h qua | Cập nhật tin sao tại Yeutretho.com | Doc bao 24h
Theo dõi
Liên hệ
quantri.kdh@gmail.com|
Khung Upload nhanh

26868
Lượt xem