1. Đăng nhập
  2. Đăng kư
Hiện kết quả từ 1 tới 3 của 3
  1. #1
    Tham gia ngày
    Aug 2011
    Bài gửi
    462
    Cảm ơn
    3
    Thanked 121 Times in 78 Posts

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

    ►Xem: 25095 ►Trả Lời: 2
    ►Chia Sẽ:
    25-07-2012

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



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



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

    Xem thêm bài khác

  2. #2
    Tham gia ngày
    Aug 2011
    Bài gửi
    462
    Cảm ơn
    3
    Thanked 121 Times in 78 Posts

    101/Nhập số liệu cho 1 tập tin số nguyên:
    Code: 
    Program Tap_Tin_So_Nguyen;
    Uses Crt;
    Var
        f : File Of Integer;
       So : Integer;
       a : Array[1..10] Of Integer;
       Spt,i,j : Integer;
       Filename : String[11];
    Begin
       ClrScr;
        Writeln('NHAP SO LIEU CHO TAP TIN SONGUYEN.DAT');
       Writeln('-------------------------------------');
       Writeln;
       Assign(f,'songuyen.dat');
       ReWrite(f);
       For i := 1 To 10 Do
           Begin
              Write('-So thu: ',i:2,' = ');
             Readln(So);
             Write(f,so);
          End;
       Close(f);
       Spt := 0;
       Reset(f);
       While NOT EOF(f) Do
           Begin
              Spt := Spt + 1;
             Read(f,so);
             a[Spt] := so;
          End;
       Close(f);
       For i := 1 To Spt -1 Do
           For j := Spt Downto i + 1 Do
              If a[j] < a[j-1] Then
                 Begin
                    So := a[j];
                   a[j] := a[j-1];
                   a[j-1] := So;
                End;
       Writeln;
       Writeln('Sau khi sap xep: ');
       For i := 1 To 10 Do
           Write(a[i]:6);
       Writeln;
       Write(' Bam <Enter>... ');
       Readln
    End.
    102/Ghép tập tin:
    Code: 
    Program Ghep_Tap_Tin;
    Uses Crt;
    Var
        f1,f2,f3 : File Of Real;
       i : Integer;
       So : Real;
       Ch : Char;
    Begin
        ClrScr;
        Writeln('NHAP SO LIEU CHO TAP1.DAT');
       Writeln('-------------------------');
       Writeln;
       Assign(f1,'TAP1.DAT');
       Rewrite(f1);
       i := 0;
       Repeat
           i := i + 1;
          Write('-So thu: ',i:2,' = ');
          Readln(So);
          Write(f1,so);
          Write('    Nhap nua ? (c/k) ');
          Readln(Ch);
       Until Upcase(Ch) ='K';
       Close(f1);
       ClrScr;
       Writeln('NHAP SO LIEU CHO TAP2.DAT');
       Writeln('-------------------------');
       Writeln;
       Assign(f2,'TAP2.DAT');
       Rewrite(f2);
       i := 0;
       Repeat
           i := i + 1;
          Write('-So thu: ',i:2,' = ');
          Readln(So);
          Write(f2,so);
          Write('    Nhap nua ? (c/k) ');
          Readln(Ch);
       Until Upcase(Ch) ='K';
       Close(f2);
       ClrScr;
       Writeln('GHEP TAP1 va TAP2 thanh TAP3');
       Writeln('----------------------------');
       Writeln;
       Assign(f3,'TAP3.DAT');
       Rewrite(f3);
       Reset(f1);
       Reset(f2);
       While NOT EOF(f1) Do
           Begin
              Read(f1,So);
             Write(f3,So);
          End;
       While NOT EOF(f2) Do
           Begin
              Read(f2,so);
             Write(f3,so);
          End;
       Reset(f3);
       While NOT EOF(f3) Do
           Begin
              Read(f3,So);
             Write(So :8:1);
          End;
       Close(f1);
       Close(f2);
       Close(f3);
       Writeln;
       Writeln;
       Write('    Da ghep xong, Bam <Enter>...');
       Readln;
    End.
    103/Sổ tay điện thoại:
    Code: 
    Program So_tay_Dien_Tu;
    Uses Crt;
    Type
        DienThoai = RECORD
           HoTen : String[24];
          Tel   : LongInt;
          Add   : String;
          End;
    Var
        f       : File Of DienThoai;
       Tam     : DienThoai;
       St      : String;
       TimThay : Boolean;
    Begin
        ClrScr;
        Writeln('NHAP SO DIEN THOAI VA DIA CHI');
       Writeln('-----------------------------');
       Writeln;
       Assign(f,'Telephon.dat');
       Rewrite(f);
       With tam Do
           Repeat
              Write('-Ho ten, bam (0> de ket thuc: ');
             Readln(HoTen);
             If HoTen <> '0' Then
                 Begin
                     Write('-So phone : ');
                    Readln(Tel);
                    Write('-Dia chi : ');
                    Readln(Add);
                    Write(f,tam);
                End;
          Until Hoten = '0';
          Close(f);
          ClrScr;
          Writeln('TIM SO DIEN THOAI VA DIA CHI');
          Writeln('----------------------------');
          Writeln;
          Write('-Ho ten nguoi muon tim: ');
          Readln(St);
          Reset(f);
          TimThay := False;
          While NOT EOF(f) Do
              Begin
                 Read(f,Tam);
                With Tam Do
                    If St = HoTen then
                       Begin
                          TimThay := True;
                         Writeln(HoTen);
                         Writeln('-So Telephone: ',Tel);
                         Writeln('-Dia chi     : ',Add);
                      End;
             End;
          If Not TimThay Then
              Writeln('Khong tim thay');
          Close(f);
          Writeln;
          Write('   Bam <Enter>... ');
          Readln
    End.
    104/Che dấu tập tin:
    Code: 
    Program CheDau_TapTin;
    Uses Dos,Crt;
    Var
        f : File; {hoac f : Text }
       Filename : String;
       Ch : Char;
    Begin
        Repeat
            ClrScr;
           TextColor(14);
           TextBackGround(2);
           GotoXY(23,4);
            Writeln('DAT THUOC TINH CHE DAU TAP TIN');
           GotoXY(23,5);
            Writeln('------------------------------');
           Writeln;
           TextColor(12);
           GotoXY(11,6);
           Writeln('*Khong hien thi duoc ten tap tin khi dung lenh DIR cua DOS*');
           GotoXY(15,8);
           TextColor(1);
           TextBackGround(14);
           Write('-Cho biet ten tap tin: ');
          Readln(Filename);
          TextColor(4+Blink);
          TextBackGround(14);
          GotoXY(25,24);
          Writeln('DANG THUC HIEN, XIN CHO DOI...');
          Assign(f,Filename);
          SetFAttr(f,Hidden);
          TextColor(4);
          TextBackGround(15);
          GotoXY(15,10);
          Case DosError Of
              0 : Writeln('Da hoan thanh tot dep');
             2 : Writeln('Khong tim thay tap tin nay');
             3 : Writeln('Khong tim thay duong dan')
          Else
              Writeln('Tap tin duoc bao ve, khong sua duoc');
          End;
          GotoXY(19,24);
          TextColor(14);
          TextBackGround(4);
          Writeln('Bam phim bat ky de tiep tuc, <Esc> de thoat ');
          Ch := Readkey;
          TextColor(White);
           TextBackGround(Black);
           ClrScr;
       Until Ch = #27;
    End.
    105/Cập nhật dữ liệu:
    Code: 
    Program Cap_Nhat_Du_Lieu;
    Uses Crt;
    Type
        HoSo = RECORD
           Holot : String[17];
          Ten   : String[7];
          Tuoi  : 18..60;
          ChucVu: String[20];
          BacLuong : 300000..900000;
          End;
    Var
        f : File Of HoSo;
       Nv : HoSo;
       ans : Char;
    Begin
        ClrScr;
        Writeln('CAP NHAT DU LIEU VAO TAP TIN LUONG.DAT');
       Writeln('----------------------------------');
       Writeln;
       Assign(f,'LUONG.DAT');
       Reset(f);
       Seek(f,Filesize(f));
       Repeat
           With Nv Do
              Begin
                 Write('-Ho lot: ');
                Readln(Holot);
                Write('-Ten   : ');
                Readln(Ten);
                Write('-Tuoi  : ');
                {$R+}
                Readln(tuoi);
                Write('-Chuc vu : ');
                Readln(ChucVu);
                Write('-Bac luong: ');
                Readln(BacLuong);
                Write(f,Nv);
             End;
          ans := Readkey;
       Until ans = #27;
       Close(f);
    End.
    106/Đọc tập tin:
    Code: 
    Program Doc_Tap_tin;
    Var
        f : Text;
       Filename : String;
       Ch : Char;
    Begin
        Writeln('DOC TAP TIN VAN BAN');
       Writeln('-------------------');
       Writeln;
       Write('-Cho biet ten tap tin: ');
       Readln(Filename);
       Assign(f,filename);
       Reset(f);
       While Not EOF(f) Do
           Begin
              Read(f,Ch);
             Write(Ch);
          End;
       Close(f);
       Writeln;
       Write('Bam <Enter>... ');
       Readln
    End.
    107/Đọc chậm tập tin theo từng chử:
    Code: 
    Program Doc_Tung_Chu;
    Uses Crt;
    Var
        Filename : String;
       f : Text;
       Line : String[251];
       k : Integer;
    Begin
        ClrScr;
       Writeln('DOC CHAM TAP TIN THEO TUNG CHU');
       Writeln('------------------------------');
       Writeln;
       Write('-Cho biet ten tap tin: ');
       Readln(Filename);
       Assign(f,Filename);
       Reset(f);
       While Not EOF(f) Do
           Begin
              Readln(f,line);
             For k := 1 To Length(line) Do
                 Begin
                    Write(line[k]);
                   Delay(150);
                End;
             Writeln;
          End;
       Close(f);
    End.
    108/Đọc ghi tập tin:
    Code: 
    Program Doc_Ghi_Tap_Tin;
    Var
        f1,f2 : Text;
       Filename : String;
       i : Integer;
       St : String;
    Begin
        Writeln('DANH SO DONG TAP TIN');
       Writeln('--------------------');
       Writeln;
       Write('-Cho biet ten tap tin: ');
       Readln(Filename);
       Assign(f1,filename);
       Reset(f1);
       Assign(f2,'Newfile.txt');
       Rewrite(f2);
       i := 0;
       While Not EOF(f1) Do
           Begin
              i := i + 1;
             Readln(f1,st);
             Writeln(f2,i,' ',St);
          End;
       Close(f1);
       Close(f2);
       Writeln;
       Writeln('Da danh so dong va ghi vao tap tin NEWFILE.TXT');
       Writeln;
       Write('     Bam <Enter> de xem tap tin NEWFILE.TXT ');
       Readln;
       Assign(f2,'Newfile.txt');
       Reset(f2);
       While Not EOF(f2) Do
           Begin
              Readln(f2,st);
             Writeln(St);
          End;
       Close(f2);
       Writeln;
       Write('Xem xong, ban <Enter> ');
       Readln
    End.
    109/Tạo tập tin âm thanh Lambada:
    Code: 
    Program Lambada;
    Uses Crt;
    Var
        f : Text;
       Note,dur : Word;
       Buf : Array[1..10240] Of Byte;
    {---------------------------------}
        Procedure Play(Caodo,Truongdo : Word);
       Begin
           Sound(Caodo);
          Delay(Truongdo);
          NoSound;
       End;
    {---------------------------------}
    BEGIN
        ClrScr;
       TextColor(Yellow);
        Writeln('TAO TAP TIN AM THANH');
       TextColor(Red);
       Writeln('--------------------');
       Writeln;
       TextColor(Green);
       Writeln('Bam phim bat ky de tat am thanh');
       Repeat
            Assign(f,'lambada.not');
           SetTextBuf(f,buf);
           Reset(f);
           While (Not EOF(f)) And (Not KeyPressed) Do
                Begin
                  Readln(f,Note,dur);
                 Play(Note,Dur);
                End;
       Until KeyPressed;
       Close(f);
       NoSound;
    END.
    110/Karaoke:
    Code: 
    Program Karaoke;
    Uses Crt;
    Const
        Lento = 10;
    Type
        ConTro = ^Nhac;
       Nhac = RECORD
           Note,Dura : Word;
          Next      : ConTro;
          End;
    Var
        f : Text;
       P,First, Last,HeapTop : ConTro;
    {------------------------------------}
        Procedure AssignList(Filename : String);
       Begin
           Assign(f,Filename);
          {$I-}
          Reset(f);
          {$I+}
          If IOResult <> 0 Then
              Halt(1);
          First := Nil;
          Mark(HeapTop);
          While NOt EOF(f) Do
              Begin
                 New(p);
                Readln(f,p^.Note,p^.Dura);
                If First = Nil Then
                    First := p
                Else
                    Last^.Next := p;
                Last := p;
                Last^.Next := Nil;
             End;
          Close(f);
       End;
    {------------------------------------}
       Procedure Music;
       Begin
           p := First;
          While (p <> Nil) And Not (KeyPressed And (Readkey = #27)) Do
              Begin
                 Sound(p^.Note);
                Delay(Lento*p^.Dura);
                p := p^.Next;
                If p = Nil Then
                    p := First;
             End;
       End;
    {------------------------------------}
    BEGIN
        ClrScr;
       Writeln('    CHUONG TRINH NHAC EM DIU');
       Writeln('Truong do cham 10 lan so voi BT15_10');
       Writeln('     Bam <Esc> de ket thuc');
       Writeln('-------------------------------------');
        AssignList('Lambada.Not');
       Music;
       NoSound;
    END.
    111/Ghi điểm vào tập tin:
    Code: 
    Program Nhap_Diem;
    Type
        HocBa = RECORD
           HoTen : String[24];
          Van,Toan,Ly,Hoa,Tb: Real;
          End;
       FileHB = File Of HocBa;
    Var
        f : FileHB;
       HS : HocBa;
       q : Boolean;
    Begin
        Writeln('CHUONG TRINH GHI DIEM VAO TAP TIN');
       Writeln('--------------------------------------');
       Writeln;
       Assign(f,'DIEM.DAT');
       ReWrite(f);
       q := True;
       While q Do
           With HS Do
              Begin
                 Write('-Ho ten hoc sinh,(<Enter> de ket thuc): ');
                Readln(HoTen);
                If HoTen = '' Then
                        Q := False
                    Else
                        Begin
                       Write('-Diem Van : ');
                      Readln(Van);
                      Write('-Diem Toan: ');
                      Readln(Toan);
                      Write('-Diem Ly  : ');
                      Readln(Ly);
                      Write('-Diem Hoa : ');
                      Readln(Hoa);
                      Tb := ((Van*2)+(Toan*2)+Ly+Hoa)/6;
                      Write(f,HS);
                        End;
             End;
    End.
    112/Ghi thêm điểm vào tập tin:
    Code: 
    Program Nhap_Them_Diem;
    Type
        HocBa = RECORD
           HoTen : String[24];
          Van,Toan,Ly,Hoa,Tb: Real;
          End;
       FileHB = File Of HocBa;
    Var
        f : FileHB;
       HS : HocBa;
       q : Boolean;
    Begin
        Writeln('CHUONG TRINH GHI THEM DIEM VAO TAP TIN');
       Writeln('--------------------------------------');
       Writeln;
       Assign(f,'DIEM.DAT');
       Reset(f);
       Seek(f,filesize(f));
       q := True;
       While q Do
           With HS Do
              Begin
                 Write('-Ho ten hoc sinh,(<Enter> de ket thuc): ');
                Readln(HoTen);
                If HoTen = '' Then
                        Q := False
                    Else
                        Begin
                       Write('-Diem Van : ');
                      Readln(Van);
                      Write('-Diem Toan: ');
                      Readln(Toan);
                      Write('-Diem Ly  : ');
                      Readln(Ly);
                      Write('-Diem Hoa : ');
                      Readln(Hoa);
                      Tb := ((Van*2)+(Toan*2)+Ly+Hoa)/6;
                      Write(f,HS);
                        End;
             End;
    End.
    113/T́m điểm theo họ tên:
    Code: 
    Program Timp_Diem;
    Type
        HocBa = RECORD
           HoTen : String[24];
          Van,Toan,Ly,Hoa,Tb: Real;
          End;
       FileHB = File Of HocBa;
    Var
        f : FileHB;
       Hs : HocBa;
       St : String;
       TimThay : Boolean;
    Begin
        Writeln('CHUONG TRINH TIM DIEM THEO HO TEN');
       Writeln('---------------------------------');
       Writeln;
       Write('-Ho ten hoc sinh muon tim: ');
       Readln(St);
       Assign(f,'DIEM.DAT');
       Reset(f);
       Timthay := False;
       While Not EOF(f) Do
           Begin
               Read(f,Hs);
                   With Hs Do
                      If St = HoTen Then
                          Begin
                             TimThay := True;
                            Writeln(HoTen);
                               Writeln('-Diem Van : ',Van:5:2);
                            Writeln('-Diem Toan: ',Toan:5:2);
                            Writeln('-Diem Ly  : ',Ly:5:2);
                            Writeln('-Diem Hoa : ',Hoa:5:2);
                            Writeln('-Diem trung binh := ',Tb:5:2);
                            End
          End;
       If Not Timthay Then
           Writeln('Trong danh sach khong co hoc sinh: ',St);
       Close(f);
       Writeln;
       Write('   Bam <Enter>... ');
       Readln;
    End.
    114/Hồ sơ:
    Code: 
    Program Ho_So;
    Uses Crt;
    Type
        LyLich = RECORD
           HoTen : String[24];
          NamSinh : Integer;
          ChucVu : String[20];
          BacLuong : Real;
          End;
    Var
        f : File Of LyLich;
       q : Boolean;
       Nv : LyLich;
       Stt : Integer;
       Ch : Char;
    Begin
        ClrScr;
       Assign(f,'HOSO.DAT');
       Rewrite(f);
       q := True;
       While q Do
           With Nv Do
               Begin
                  Write('-Ho ten CBCNV (<Enter> de ngung): ');
                 Readln(HoTen);
                If HoTen = '' Then
                    q := False
                Else
                    Begin
                       Write('-Nam sinh: ');
                      Readln(NamSinh);
                      Write('-Chuc vu: ');
                      Readln(Chucvu);
                      Write('-Bac luong: ');
                      Readln(BacLuong);
                      Write(f,Nv);
                   End;
              End;
          Repeat
              GotoXY(28,24);
             Write('Co can sua khong? (c/k) ');
             Readln(Ch);
             If UpCase(Ch) = 'C' Then
                 Begin
                    Write('-Thay doi so thu tu : ');
                   Readln(Stt);
                   If Stt >= 1 Then
                       Begin
                          Seek(f,Stt-1);
                         With Nv Do
                             Begin
                                Write('-Ho ten CBCNV : ');
                               Readln(HoTen);
                                Write('-Nam sinh: ');
                                  Readln(NamSinh);
                                  Write('-Chuc vu: ');
                                  Readln(Chucvu);
                                  Write('-Bac luong: ');
                                  Readln(BacLuong);
                                  Write(f,Nv);
                            End;
                      End;
                End;
          Until UpCase(Ch) = 'K';
       Close(f)
    End.
    115/Trộn tập tin:
    Code: 
    Program Tron_Tap_tin;
    Uses Crt;
    Var
        f1,f2,f3 : File Of Integer;
       So1,So2 : Integer;
       i : Integer;
       Ch : Char;
       ok1,ok2 : Boolean;
    {--------------------------------}
        Function Layso1(Var So1 : Integer): Boolean;
       Begin
           If Not EOF(f1) Then
              Begin
                 Read(f1,So1);
                LaySo1 := True;
             End
          Else
              layso1 := False;
       End;
    {--------------------------------}
       Function Layso2(Var So2 : Integer): Boolean;
       Begin
           If Not EOF(f2) Then
              Begin
                 Read(f2,So2);
                LaySo2 := True;
             End
          Else
              layso2 := False;
       End;
    {--------------------------------}
    BEGIN
        Assign(f1,'so1.dat');
       Rewrite(f1);
       ClrScr;
       Writeln('NHAP TAP TIN SO1');
       Writeln('----------------');
       Writeln;
       i := 0;
       Repeat
           i := i + 1;
          Write('-So thu: ',i:2,' = ');
          Readln(So1);
          Write(f1,so1);
          Write('-Nhap nua ? (c/k) ');
          Readln(Ch);
       Until Upcase(Ch) = 'K';
       Close(f1);
       Assign(f2,'so2.dat');
       Rewrite(f2);
       ClrScr;
       Writeln('NHAP TAP TIN SO2');
       Writeln('----------------');
       Writeln;
       i := 0;
       Repeat
           i := i + 1;
          Write('-So thu: ',i:2,' = ');
          Readln(So2);
          Write(f2,so2);
          Write('-Nhap nua ? (c/k) ');
          Readln(Ch);
       Until Upcase(Ch) = 'K';
       Close(f2);
       Assign(f3,'so3.dat');
       Rewrite(f3);
       Reset(f1);
       Reset(f2);
       ok1 := Layso1(So1);
       ok2 := Layso2(so2);
       While ok1 Or ok2 Do
           Begin
              If ok1 And ok2 Then {co ca 2 tap tin}
                 Begin
                    If So1 < So2 Then
                       Begin
                          Write(f3,so1);
                         ok1 := layso1(so1);
                      End
                   Else
                       Begin
                          Write(f3,so2);
                         ok2 := Layso2(so2);
                      End;
                End
             Else
                 If ok1 Then   {chi con tap tin so1.dat}
                    Begin
                       Write(f3,so1);
                      ok1 := layso1(so1);
                   End
                Else
                    If ok2 Then   {chi con tap tin so2.dat}
                       Begin
                          Write(f3,so2);
                         ok2 := Layso2(so2);
                      End;
          End;
       Writeln;
       Reset(f3);
       While not EOF(f3) Do
           Begin
              Read(f3,i);
             Write(i:6);
          End;
       Close(f1);
       Close(f2);
       Close(f3);
       Writeln;
       Write('Da tron xong, bam <Enter>... ');
       Readln
    END.
    116/Đội tuyển:
    Code: 
    Program Doi_Tuyen;
    Uses Crt;
    Type
        HocSinh = RECORD
           HoTen : String[24];
          Lop : String[4];
          Dtb : Real;
          End;
       Fhs = File Of HocSinh;
    Var
        f : Fhs;
       Ch : Char;
    {----------------------------------}
        Procedure Nhap(Var f : Fhs);
       Var
           Tam : HocSinh;
       Begin
           Rewrite(f);
          Repeat
              Write('-Nhap ho ten (0 de thoat): ');
                Readln(Tam.Hoten);
                If Tam.HoTen <> '0' Then
                    Begin
                    Write('-Lop: ');
                   Readln(Tam.Lop);
                   Write('-Diem trung binh: ');
                   Readln(Tam.Dtb);
                   Write(f,Tam);
                    End;
          Until tam.HoTen ='0';
       Close(f);
       End;
    {----------------------------------}
       Procedure Lapds(Var f:Fhs);
       Var
           Tam    : Hocsinh;
          a      : Array[1..1000] Of HocSinh;
          TenLop : Array[1..100] Of String[4];
          alop   : Array[1..200] Of HocSinh;
          Sohs12,Solop12,Sohslop : Integer;
          Stt    : Integer;
          i,j,k  : Integer;
          Coroi  : Boolean;
       Begin
           Reset(f);
          Sohs12 := 0;
          Solop12 := 0;
          While Not EOF(f) Do
              Begin
                 Read(f,tam);
                If (Tam.Lop[1]='1') And (Tam.Lop[2]='2') Then
                    Begin
                       Sohs12 := Sohs12 + 1;
                      a[Sohs12] := Tam;
                      Coroi := False;
                      For i := 1 To Solop12 Do
                          If Tenlop[i] = Tam.Lop Then
                             Coroi := True;
                      If Not coroi Then
                          Begin
                             Solop12 :=Solop12+1;
                            TenLop[Solop12] := Tam.Lop;
                         End;
                   End;
             End;
          Writeln('|','STT','|','HO VA TEN':24,'|','  LOP  ','|','  HANG  ','|');
          Stt := 1;
          For i := 1 to Solop12 Do
              Begin
                 Sohslop := 0;
                For j := 1 To Sohs12 Do
                    If a[j].Lop = Tenlop[i] Then
                       Begin
                          Sohslop := Sohslop + 1;
                         alop[sohslop]:=a[j];
                      End;
                For k := 1 To Sohslop - 1 Do
                    For j := sohslop DownTo k + 1 Do
                       If alop[j].Dtb > alop[j-1].Dtb Then
                          Begin
                             Tam := alop[j];
                            alop[j] := alop[j-1];
                            alop[j-1] := Tam;
                         End;
                      If Sohslop >=3 Then
                          For k := 1 To 3 Do
                             Begin
                                With alop[k] Do
                               Writeln('|',stt:3,' |',HoTen:24,' | ',
                                                Lop:5,' | ',k : 3,' |');
                               Stt := Stt + 1;
                            End
                      Else
                          For k := 1 To Sohslop Do
                             Begin
                                With alop[k] Do
                                   Writeln('|',stt:3,' |',HoTen:24,' | ',
                                                Lop:5,' | ',k : 3,' |');
                                  Stt := Stt + 1;
                            End;
             End;
          Close(f);
       End;
    
    
    {----------------------------------}
    BEGIN
        Assign(f,'doituyen.dat');
       Repeat
           Repeat
              Writeln('1-Nhap du lieu');
             Writeln('2-Danh sach doi du tuyen');
             Writeln('3-Ket thuc');
             Ch := Readkey;
          Until ch in ['1'..'3'];
          Case Ch Of
              '1' : Nhap(f);
             '2' : Lapds(f);
          End;
       Until Ch = '3';
    END.
    117/Tạo tập tin có kiểu:
    Code: 
    Program Tao_Tap_Tin_Co_Kieu;
    Type
        HocSinh = RECORD
           Ten : String[7];
          Diem : 0..10;
          End;
    Var
        f : File Of Hocsinh;
    {-------------------------------}
        Procedure TaoTapTin;
       Var
           Tam : HocSinh;
          Filename : String;
       Begin
           Write('-Cho biet ten tap tin: ');
          Readln(Filename);
          Assign(f,Filename);
          {$I-}
          Rewrite(f);
    
    
          {$I+}
          If IOResult <> 0 Then
              Begin
                 Writeln('Khong mo duoc tap tin: ',Filename);
                Halt;
             End;
          Repeat
              Write('Ten (bam <Enter> de cham dut) : ');
             Readln(Tam.Ten);
                If Tam.Ten <> '' Then
                 Begin
                    Write('-Diem : ');
                   Readln(Tam.Diem);
                   Write(f,Tam);
                End;
          Until Tam.Ten = '';
          Close(f);
       End;
    {-------------------------------}
       Procedure XemLaiBanGhi;
       Var
           RecNo : Word;
          Tam : HocSinh;
       Begin
           Write('-Xem lai ban ghi thu may: ');
          Readln(RecNo);
          Reset(f);
          Seek(f,RecNo-1);
          Read(f,Tam);
          Writeln('-Ten  : ',Tam.Ten);
          Writeln('-Diem : ',Tam.Diem);
       End;
    {-------------------------------}
    BEGIN
        TaoTapTin;
       Writeln;
       XemLaiBanGhi;
       Writeln;
       Write('    Bam <Enter>... ');
       Readln;
    END.
    118/Tạo danh sách:
    Code: 
    Program Tao_Danh_Sach;
    Type
        HocSinh = RECORD
           Ten : String[7];
          Diem : 0..10;
          End;
    
    
       T_pList = ^T_List;
       T_List = RECORD
           d : HocSinh;
          Next : T_pList;
          End;
    Var
        f : File Of Hocsinh;
       First : Pointer;
       Curr, News : T_pList;
    {-------------------------------}
        Procedure MoTapTin;
       Var
          Filename : String;
       Begin
           Write('-Cho biet ten tap tin: ');
          Readln(Filename);
          Assign(f,Filename);
          {$I-}
          Reset(f);
    
    
          {$I+}
          If IOResult <> 0 Then
              Begin
                 Writeln('Khong mo duoc tap tin: ',Filename);
                Halt;
             End;
       End;
    {-------------------------------}
        Procedure DocVaoList;
       Begin
           First := Nil;
          While NOt EOF(f) Do
              Begin
                 New(News);
                News^.Next := Nil;
                Read(f,News^.d);
                If First = Nil Then
                    First := News
                Else
                    Curr^.Next := News;
                Curr := News;
             End;
          Close(f);
       End;
    {-------------------------------}
       Procedure Xem;
       Begin
           Curr :=First;
          While Curr <> Nil Do
              Begin
                 Writeln('-Ten: ',Curr^.D.Ten : 6, #32:10,
                    '-Diem : ',Curr^.D.Diem);
                Curr := Curr^.Next;
             End;
       End;
    {-------------------------------}
    BEGIN
        MoTapTin;
       Writeln;
       DocVaoList;
       Writeln;
       Xem;
       Writeln;
       Write('    Bam <Enter>... ');
       Readln;
    END.
    119/Dự đoán bóng đá:
    Code: 
    Program Du_Doan_Bong_Da;
    Type
        Doi = RECORD
           Diem,hlv,tm,hv,ct,sb : Real;
          Ten : String[24];
          Hang : Integer;
          End;
       Filedb = file Of Doi;
       Mang = Array[1..40] Of Doi;
    Var
        f : Filedb;
       i,j,n : Integer;
       a : Mang;
       t : Doi;
       q : Boolean;
    Begin
        i := 1;
       q := True;
       While q Do
           With a[i] Do
              Begin
                 Write('-Ten doi (bam <Enter> de ngung): ');
                Readln(Ten);
                If Ten = '' Then
                    q := False
                Else
                    Begin
                       Repeat
                          Write('=Diem huan luyen vien: ');
                         Readln(hlv);
                      Until hlv <=30;
                      Repeat
                          Write('=Diem thu mon: ');
                         Readln(tm);
                      Until tm <= 15;
                      Repeat
                          Write('=Diem hau ve: ');
                         Readln(hv);
                      Until hv <= 30;
                      Repeat
                          Write('=Diem cac cau thu khac: ');
                         Readln(ct);
                      Until ct <= 50;
                      Repeat
                          Write('=Diem thuan loi san bai: ');
                         Readln(sb);
                      Until sb <= 20;
                      Diem := hlv + hv + tm + ct + sb;
                      i := i + 1;
                   End;
             End;
          n := i - 1;
          For i := 1 To N - 1 Do
              For j := 1 To N - i Do
                 If a[j].Diem < a[j+1].Diem then
                    Begin
                       t :=a[j];
                      a[j] := a[j+1];
                      a[j+1] := t;
                   End;
          Assign(f,'diemdb.dat');
          Rewrite(f);
          For i := 1 to N Do
              Begin
                 If (i > 1) And (a[i].Diem = a[i-1].Diem) Then
                    a[i].Hang := a[i-1].Hang
                Else
                    a[i].Hang := i;
                Write(f,a[i]);
             End;
          Close(f);
    End.
    120/Cắt tập tin:
    Code: 
    Program Cat_Tap_tin;
    Var
        f,g1,g2 : File;
       Buf : Array[1..63000] Of Byte;
       Trungdiem : LongInt;
    {-------------------------------------}
        Procedure BaoLoi;
       Begin
           Writeln('Khong mo duoc tap tin');
          Halt;
       End;
    {-------------------------------------}
        Procedure MoTapTin;
       Var
           TenTT,TenTT1,TenTT2: String;
       Begin
           Write('-Ten tap tin nguon: ');
          Readln(TenTT);
          Write('-Ten tap tin dich 1: ');
          Readln(TenTT1);
          Write('-Ten tap tin dich 2: ');
          Readln(TenTT2);
          Assign(f,TenTT);
          Reset(f,1);
          Assign(g1,TenTT1);
          Rewrite(g1,1);
          Assign(g2,TenTT2);
          Rewrite(g2,1);
          If IOResult <> 0 Then
              BaoLoi;
       End;
    {-------------------------------------}
       Procedure TinhTrungDiem;
       Begin
           TrungDiem := (Filesize(f) Div 2);
       End;
    {-------------------------------------}
        Procedure ChepNuaDau;
       Var
           S : LongInt;
          Num,SoDoc,SoGhi : Word;
       Begin
           S :=TrungDiem;
           Repeat
               If Sizeof(Buf) <= S Then
                  Num := Sizeof(Buf)
              Else
                  Num := S;
              BlockRead(f,Buf, Num,SoDoc);
              If IOResult <> 0 Then
                  BaoLoi;
              BlockWrite(g1,Buf,SoDoc,SoGhi);
              If IOResult <> 0 Then
                  BaoLoi;
              Dec(S,Num);
           Until S = 0;
           Close(g1);
       End;
    {-------------------------------------}
        Procedure ChepNuaSau;
       Var
          SoDoc,SoGhi : Word;
       Begin
           Seek(f,TrungDiem);
          If IOResult <> 0 Then
              BaoLoi;
           Repeat
              BlockRead(f,Buf, Sizeof(Buf),SoDoc);
              If IOResult <> 0 Then
                  BaoLoi;
              BlockWrite(g2,Buf,SoDoc,SoGhi);
              If IOResult <> 0 Then
                  BaoLoi;
           Until (SoDoc = 0) Or (SoGhi <> SoDoc);
           Close(g2);
          Close(f);
       End;
    {-------------------------------------}
    BEGIN
        MoTapTin;
       TinhTrungDiem;
       ChepNuaDau;
       ChepNuaSau;
       Writeln;
       Write('Da thuc hien xong, bam <Enter>... ');
       Readln;
    END.
    121/Tạo menu:
    Code: 
    Program Menu;
    Uses Crt;
    Type
        St17 = String[17];
       St7 = String[7];
       HoSo = RECORD
           Holot : St17;
          Ten   : St7;
          ns    : Integer;
          Diem  : Real
          End;
       Mang = Array[1..100] Of HoSo;
       fhs = File Of HoSo;
    Var
        Filename : String[11];
       f : fhs;
       Tam : HoSo;
       Ch : Char;
    {----------------------------------}
        Procedure Nhap(Var f : fhs);
       Begin
           Rewrite(f);
          With Tam Do
              Repeat
                 Write('-Ho lot (0 de ket thuc): ');
                Readln(Holot);
                If Holot <> '0' Then
                    Begin
                       Write('-Ten: ');
                      Readln(Ten);
                      Write('-Nam sinh: ');
                      Readln(Ns);
                      Write('-Diem: ');
                      Readln(Diem);
                      Write(f,tam);
                   End;
             Until HoLot = '0';
             Close(f);
       End;
    {----------------------------------}
       Procedure SapXep(Var f : Fhs);
       Var
           i,j,Spt : Integer;
           ds : Mang;
       Begin
           Reset(f);
          Spt := 0;
          While Not EOF(f) Do
              Begin
                 Spt := Spt + 1;
                Read(f,ds[spt]);
             End;
          For i := 1 To spt - 1 Do
              For j := spt Downto i + 1 Do
                 If ds[j].Ten[1] < ds[j-1].Ten Then
                    Begin
                       Tam := ds[j];
                      ds[j] := ds[j-1];
                      ds[j-1] := Tam;
                   End;
          Rewrite(f);
          For i := 1 To spt Do
              Write(f,ds[i]);
          Close(f);
          Writeln;
          Write('Da sap xep xong, bam <Enter>... ');
          Readln;
       End;
    {----------------------------------}
       Procedure Xem(Var f : Fhs);
       Begin
           ClrScr;
          Writeln('       HO VA TEN              DIEM');
          Reset(f);
          While Not EOF(f) Do
              Begin
                 Read(f,Tam);
                With Tam Do
                    Writeln(Holot:17,' ',Ten:7,'      ',Diem:6:1);
             End;
          Readln;
       End;
    {----------------------------------}
       Procedure CapNhat(Var f : Fhs);
    
    
    {--------------------}
       Procedure Sua(Var f:Fhs);
       Var
           Holot1 : St17;
          Ten1 : St7;
          TimThay : Boolean;
       Begin
           Repeat
              Write('-Holot: ');
             Readln(Holot1);
             Write('-Ten  : ');
             Readln(Ten1);
             TimThay := False;
             Reset(f);
             While Not EOF(f) Do
                 With Tam Do
                     Begin
                        Read(f,Tam);
                       If (Holot = Holot1) And (Ten = Ten1) Then
                           Begin
                              Timthay := True;
                             Writeln(Holot,' ',Ten,' Diem : ',Diem : 0:1);
                             Repeat
                                 Writeln('Co sua khong ? (c/k) ');
                                Ch := Readkey;
                             Until Ch in['c','C','k','K'];
                             If Upcase(Ch) = 'C' Then
                                 Begin
                                    Write('-Ho lot: ');
                                   Readln(Holot);
                                   Write('-Ten   : ');
                                   Readln(Ten);
                                   Write('-Nam sinh : ',ns);
                                   Write('-Diem : ');
                                   Readln(Diem);
                                   Seek(f,filepos(f)-1);
                                   Write(f,Tam);
                                End;
                          End;
                    End;
                   If Not TimThay Then
                       Writeln('Khong tim thay');
                   Repeat
                       Writeln('Tim nu khong ? (c/k) ');
                      Ch := Readkey;
                   Until Ch in['c','C','k','K'];
          Until Upcase(Ch) = 'K'
       End;
    {--------------------}
       Procedure Them(Var f: Fhs);
       Begin
           Reset(f);
          Seek(f,Filesize(f));
          With Tam Do
              Repeat
                 Write('-Ho lot: ');
                Readln(Holot);
                Write('-Ten   : ');
                Readln(Ten);
                Write('-Nam sinh : ',ns);
                Write('-Diem : ');
                Readln(Diem);
                Write(f,Tam);
                Repeat
                    Writeln('Them nua khong ? (c/k) ');
                   Ch := Readkey;
                Until Ch in['c','C','k','K'];
             Until Upcase(Ch) = 'K';
       End;
    {-------------------}
       Procedure Xoa(Var f : Fhs);
       Var
           ds : Mang;
          Holot1 : St17;
          Ten1 : St7;
          i,spt,vitri : Integer;
          TimThay : Boolean;
       Begin
           Reset(f);
          spt := 0;
          While Not EOF(f) Do
              Begin
                 Read(f,Tam);
                spt := spt + 1;
                ds[spt] := Tam;
             End;
          Repeat
              Write('-Ho lot : ');
             Readln(holot1);
             Write('-Ten   : ');
             Readln(Ten1);
             TimThay := False;
             i := 0;
             Repeat
                 i := i + 1;
                If (ds[i].Holot = Holot1) And (ds[i].Ten = Ten1) Then
                    Begin
                       TimThay := True;
                      vitri := i;
                   End;
             Until TimThay Or (i > spt);
             If TimThay Then
                 Begin
                    With ds[vitri] Do
                       Writeln(Holot,' ',Ten,' Diem: ',Diem:0:1);
                      Repeat
                          Writeln('Co xoa khong ? (c/k) ');
                         Ch := Readkey;
                      Until Ch in['c','C','k','K'];
                      If Upcase(Ch) = 'C' Then
                          Begin
                             spt := spt - 1;
                            For i := vitri To spt Do
                                ds[i] := ds[i+1];
                         End;
                End
             Else
                 Writeln('Khong tim thay');
             Repeat
                 Writeln('Tim nua khong ? (c/k) ');
                Ch := Readkey;
             Until Ch in['c','C','k','K'];
          Until Upcase(Ch) = 'K';
          Rewrite(f);
          For i := 1 To spt Do
              Write(f,ds[i]);
          Close(f);
       End;
       {-----Chuong trinh chiinh cua cap nhat-------}
       Begin
           Repeat
              Repeat
                 ClrScr;
                Writeln('  MENU CAP NHAT  ');
                Writeln('1-Sua');
                Writeln('2-Them');
                Writeln('3-Xoa');
                Writeln('4-Thoat');
                Ch := Readkey;
             Until Ch in['1'..'4'];
             Case Ch Of
                 '1' : Sua(f);
                '2' : Them(f);
                '3' : Xoa(f);
             End;
          Until Ch = '4'
       End;
     {************ CHUONG TRINH CHINH ***********}
     BEGIN
         ClrScr;
       Write('-Ten tap tin : ');
       Readln(Filename);
       Assign(f,Filename);
       Repeat
           Repeat
              ClrScr;
             Writeln('      MENU CHINH');
             Writeln('   1-Nhap');
             Writeln('   2-Sap xep');
             Writeln('   3-Xem');
             Writeln('   4-Cap nhat');
             Writeln('   5-Ket thuc');
             Writeln;
             Ch := Readkey;
          Until ch in['1'..'5'];
          Case Ch Of
              '1' : Nhap(f);
             '2' : SapXep(f);
             '3' : Xem(f);
             '4' : CapNhat(f);
          End;
       Until Ch = '5'
     END.
    122/Độ dài của ḍng:
    Code: 
    Program D0_Dai_Cua_Dong;
    Var
        f : Text;
       Filename : String[12];
       St : String;
       Max,Min: Integer;
       Sodong,Tong : Integer;
    Begin
        Write('-Cho biet ten tap tin: ');
       Readln(Filename);
       Assign(f,Filename);
       Reset(f);
       Readln(f,St);
       Max := length(St);
       Min := Length(St);
       Sodong := 1;
       Tong := Length(St);
       While Not EOF(f) Do
           Begin
              Readln(f,St);
             If Max < Length(St) Then
                 Max := Length(St);
             If Min > Length(St) Then
                 Min := Length(St);
             Sodong := sodong + 1;
             Tong := Tong + Length(St);
          End;
       Writeln('-Dong dai nhat  : ',Max);
       Writeln('-Dong ngan nhat : ',Min);
       Writeln('-Trung binh     : ',Tong / Sodong : 6:1);
       Writeln;
       Write('Bam <Enter>... ');
       Readln
    End.
    123/Điểm Sản phẩm:
    Code: 
    Program Diem_San_Pham;
    Uses Crt;
    Var
        f : Text;
       Nhom : Char;
       d1,d2 : Real;
       TongA1,TongA2 : Real;
       TongB1,TongB2 : Real;
       TongC1,TongC2 : Real;
       SoA,SoB,SoC : Integer;
       i : Integer;
    Begin
        Assign(f,'sanpham.txt');
       Rewrite(f);
       Writeln(f,'Nhom nguoi',' San pham 1 ','  San pham 2  ');
       Writeln(f);
       ClrScr;
       Repeat
           Write('Nhom nguoi ($ de thoat): ');
          Readln(Nhom);
          If Nhom <> '$' Then
              Begin
                 Write('-Diem san pham 1 : ');
                Readln(d1);
                Write('-Diem san pham 2 : ');
                Readln(d2);
                Writeln(f,Upcase(Nhom):6,d1:16:1,d2:16:1);
             End;
       Until Nhom = '$';
       Close(f);
       ClrScr;
       Reset(f);
       Readln(f);
       Readln(f);
       TongA1 := 0;TongA2 := 0;SoA := 0;
       TongB1 := 0;TongB2 := 0;SoB := 0;
       TongC1 := 0;TongC2 := 0;SoC := 0;
       While Not EOF(f) Do
           Begin
              For i := 1 To 6 Do {So vong lap bang vi tri cua nhom }
                 Read(f,Nhom);
             Readln(f,d1,d2);
             Case Nhom Of
                 'A' : Begin
                          TongA1 := TongA1 + d1;
                         TongA2 := TongA2 + d2;
                         SoA := SoA + 1;
                      End;
                'B' : Begin
                          TongB1 := TongB1 + d1;
                         TongB2 := TongB2 + d2;
                         SoB := SoB + 1;
                      End;
                'C' : Begin
                          TongC1 := TongC1 + d1;
                         TongC2 := TongC2 + d2;
                         SoC := SoC + 1;
                      End;
             End;
          End;
          ClrScr;
          Writeln('NHOM NGUOI',' TB San pham 1',' TB San pham 2');
          Writeln;
          If SoA <> 0 Then
              Writeln('A':6,TongA1/SoA:16:1,TongA2/SoA:16:1);
            If SoB <> 0 Then
              Writeln('B':6,TongB1/SoB:16:1,TongB2/SoB:16:1);
          If SoC <> 0 Then
              Writeln('C':6,TongC1/SoC:16:1,TongC2/SoC:16:1);
          Readln
    End.
    124/Đếm chử:
    Code: 
    Program DemChu;
    Uses Crt;
    Type
        MangChu = Array[Char] Of Integer;
    Var
       f : Text;
        Filename : String;
       Line : String[25];
       Chu : Char;
       Letters,Lines,k : Integer;
       Dem : MangChu;
    Begin
        ClrScr;
       For Chu := Chr(0) To Chr(127) Do
           Dem[chu] := 0;
       Letters := 0;
       Write('-Cho biet ten tap tin: ');
       Readln(Filename);
       Assign(f,Filename);
       Reset(f);
       While Not EOF(f) Do
          Begin
              Readln(f,Line);
             For k := 1 To Length(line) Do
                 Begin
                    If Line[k] In ['a'..'z'] Then
                       Letters := Letters + 1;
                   Dem[Line[k]] := Dem[Line[k]] + 1;
                End;
          End;
        Lines := 1;
        Close(f);
        Writeln('Tap tin: ',Filename,' co tat ca: ',Letters,' chu khong viet hoa');
        Writeln;
        Writeln('Phan phoi tan suat cua cac chu nhu sau:');
        Writeln;
        For Chu :='a' To 'z' Do
            Begin
              Write('-Chu: ',Chu,' = ');
             Write((Dem[chu]/Letters * 100):6:2,' % ');
             If (Lines Mod 4) = 0 Then
                 Writeln;
             Lines := Lines + 1;
          End;
       Readln
    End.
    125/Tạo tập tin văn bản:
    Code: 
    Program Tao_Tap_Tin_Van_Ban;
    Var
        f : Text;
       Filename : String;
    {---------------------------------}
        Procedure Timvb(Var f: text; n : Word);
       Var
           i : Word;
       Begin
           Reset(f);
          For i :=1 To n Do
          Readln(f);
       End;
    {---------------------------------}
       Procedure MoTapTin;
       Begin
           Write('-Cho biet ten tap tin van ban: ');
          Readln(Filename);
          {$I-}
          Assign(f,Filename);
          Rewrite(f);
          If IOResult <> 0 Then
              Begin
                 Writeln('Khong the mo tap tin moi: '+Filename+' ');
                Halt;
             End;
       End;
    {---------------------------------}
        Procedure Nhap4dong;
       Var
           Tam : String;
          i : Byte;
       Begin
           Writeln;
            Writeln;
          For i := 1 to 4 Do
              Begin
                 Write('-Nhap dong thu: ',i:2,' : ');
                Readln(Tam);
                Writeln(f,Tam);
             End;
       End;
    {---------------------------------}
       Procedure Xuatdong2;
       Var
           Tam : String;
       Begin
           Timvb(f,2);
          Readln(f,Tam);
          Writeln('Dong thu 3 cua tap tin co noi dung la: ');
          Writeln;
          Writeln('     ',Tam);
       End;
    {---------------------------------}
    BEGIN
        MoTapTin;
       Nhap4dong;
       Writeln;
       Xuatdong2;
       Writeln;
       Write(' Bam <Enter>... ');
       Readln;
    END.
    126/Xóa ḍng tập tin văn bản:
    Code: 
    Program Xoa_Dong_Tap_Tin_Van_Ban;
    Var
        f : Text;
       Filename : String;
    {---------------------------------}
       Procedure MoTapTin;
       Var
           Tam : String;
          i : Byte;
       Begin
           Write('-Cho biet ten tap tin van ban: ');
          Readln(Filename);
          {$I-}
          Assign(f,Filename);
          Rewrite(f);
          {$I+}
          If IOResult <> 0 Then
              Begin
                 Writeln('Khong the mo tap tin moi: '+Filename+' ');
                Halt;
             End;
           For i := 1 to 4 Do
                 Begin
                    Write('-Nhap dong thu: ',i:2,' : ');
                 Readln(Tam);
                  Writeln(f,Tam);
              End;
          Close(f);
       End;
    {---------------------------------}
       Procedure XemTapTin(Var f : Text);
       Var
           Tam : String;
       Begin
           Reset(f);
          While Not EOF(f) Do
              Begin
                 Readln(f,Tam);
                Writeln(Tam);
             End;
       End;
    {---------------------------------}
        Procedure Xoadong(Var f : Text; n : Word);
       Var
          g : Text;
           Tam : String;
          i : Word;
       Begin
           Assign(g,Filename);
           Reset(g);
          Assign(f,'XOADONG.TXT');
           Rewrite(f);
           i := 0;
           While Not EOF(g) Do
               Begin
                  Readln(g,Tam);
                 If i <> n Then
                     Writeln(f,Tam);
                Inc(i);
              End;
           Close(f);
       End;
    {---------------------------------}
    
    
    BEGIN
        MoTapTin;
       Writeln;
       Writeln('        Noi dung tap tin da tao');
       Writeln;
       XemTaptin(f);
       Writeln;
       Xoadong(f,2);
       Writeln('      Noi dung con lai sau khi xoa dong 3');
       Writeln;
       XemTapTin(f);
       Writeln;
       Write(' Bam <Enter>... ');
       Readln;
    END.
    127/Xóa chú thích:
    Code: 
    Program Xoa_chu_thich;
    Var
        Filename : String;
       f,fn : Text;
       Ch : Char;
    Begin
        Write('-Ten tap tin Pascal: ');
       Readln(Filename);
       Assign(f,Filename);
       Assign(fn,'new.pas');
       reset(f);
       Rewrite(fn);
       While not EOF(f) Do
           Begin
              Read(f,ch);
             If Ch <> '{' Then
                 Write(fn,ch)
             Else
                 Repeat
                    Read(f,ch);
                Until (Ch = '}') Or EOF(f);
          End;
       Close(f);
       Close(fn);
       Writeln;
       Write('Da thuc hien xong, bam <Enter>... ');
       Readln;
    End.
    128/T́m chuỗi kí tự:
    Code: 
    Program Tim_Chuoi_Ky_Tu;
    Var
        Filename : String[12];
       f : Text;
       St : String;
       Ch : Char;
       Ok : Boolean;
       i,solan:Integer;
    Begin
        Write('-Ten tap tin: ');
       Readln(Filename);
       Write('-Nhap chuoi ky tu: ');
       Readln(St);
       Assign(f,Filename);
       Reset(f);
       Solan := 0;
       While NOt EOF(f) Do
           Begin
              Read(f,Ch);
             If ch = St[1] Then
                 Begin
                    Ok := True;
                   i := 1;
                   While Not OK And ( i < length(St)) Do
                       Begin
                          Read(f,Ch);
                         If (Ch <> Chr(10)) And (Ch <> Chr(13)) Then
                             If Ch = St[1] Then
                                i := 1
                            Else
                                Begin
                                   i := i + 1;
                                  If (Ch <> St[i]) Then
                                      Ok := False;
                               End;
                      End;
                   If Ok Then
                       Solan := Solan + 1;
                End;
          End;
       Write('-Chuoi: ',St,' xuat hien : ',solan,' lan trong tap tin');
       Readln;
       Close(f);
    End.
    129/Xử lí ḍng:
    Code: 
    Program Xu_ly_dong;
    Var
        f1,f2 : Text;
       Filename : String[12];
       lmax : Integer;
       Tam,st,dong : String;
    {--------------------------------------}
        Procedure Catdong(Var st,dong:String;lmax :Integer);
       Var
           i : Integer;
       Begin
           i := lmax;
          While st[i] <> ' ' Do
              i:= i-1;
             Dong := copy(st,1,i-1);
             Delete(St,1,i);
       End;
    {--------------------------------------}
       Procedure Lamday(Var dong: String;lmax : Integer);
       Var
           i,j : Integer;
       Begin
           i := lmax - length(dong);
          While  i <> 0 Do
              Begin
                 j := Length(dong);
                While (j > 1) And (i <> 0) Do
                    If (dong[j]=' ') And (dong[j-1] <> ' ') Then
                       Begin
                          Insert(' ',dong,j);
                         j :=j-1;
                         i := i-1;
                      End
                   Else
                       j := j-1;
             End;
       End;
    {--------------------------------------}
    BEGIN
        Write('-Ten tap tin: ');
       Readln(Filename);
       Write('-Chieu dai cua dong: ');
       Readln(lmax);
       Assign(f1,filename);
       Reset(f1);
       Assign(f2,'new.txt');
       Rewrite(f2);
       St:=' ';
       While NOt EOF(f1) Do
           Begin
              Readln(f1,tam);
             St := St + Tam + ' ';
             While length(St) >= lmax Do
                 Begin
                    Catdong(St,dong,lmax);
                   Lamday(dong,lmax);
                   Writeln(f2,dong);
                End;
          End;
       Writeln(f2,St);
       Writeln;
       Writeln('Da thuc hien xong, bam <Enter>... ');
       Readln;
       reset(f2);
       While Not EOF(f2) Do
           Begin
              Readln(f2,dong);
             Writeln(dong);
          End;
        Writeln;
       Write('    Xem xong bam <Enter>... ');
       Readln;
       Close(f1);
       Close(f2);
    END.
    130/Chạy chử:
    Code: 
    Program Chay_Chu;
    Uses Crt;
    Var
        St : String;
       n,i,j : Integer;
    Begin
        ClrScr;
       Write('Nhap mot chuoi ky tu: ');
       Readln(St);
       ClrScr;
       n := 40-(Length(St) Div 2);
       For j := 1 To Length(St) Do
           For i := 80 DownTo n+j Do
              Begin
                 GotoXY(i,12);
                Write(St[j]);
                ClrEoL;
                Sound(400+j*200);
                Delay(30);
                Nosound;
             End;
       Readln;
    End.
    131/Đường thẳng:
    Code: 
    Program Duong_Thang;
    Uses Graph;
    Var
        Gd,Gm,k : Integer;
    Begin
        Gd :=Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       If GraphResult <> GrOk Then
           Halt(1);
       SetBkColor(Blue);
       k := -300;
       Repeat
           SetColor(14);
           MoveTo(160,100);
          LineRel(k,100);
          LineRel(k,-100);
          MoveTo(160,100);
          LineRel(k,-100);
          LineRel(k,100);
          k := k+15;
       Until k = 0;
       Repeat
           Line(k,0,k,200);
          k := k-15;
       Until k = 0;
       Line(0,100,320,100);
       Readln;
       CloseGraph;
    End.
    132/Chùm đường thẳng đồng quy:
    Code: 
    Program Chum_duong_thang_dong_quy;
    Uses Crt,Graph;
    Var
        Palette : PaletteType;
       Gd,Gm,k,i : Integer;
       Color : Word;
       Tri : String[4];
    Begin
        Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       Str(GetColor: 2,Tri);
       OutTextXY(10,10,Tri);
       With Palette Do
           Begin
              Size := 4;
             Colors[0] := White;
             Colors[1] := Red;
             Colors[2] := Blue;
             Colors[3] := Magenta;
             SetAllPalette(Palette);
          End;
       SetBkColor(LightBlue);
       Randomize;
       k := 1;
       Repeat
           Color := Succ(GetColor);
          If Color > Palette.Size Then
              Color := 2;
          SetColor(Color);
          i := k Mod 4;
          SetLineStyle(i,0,3);
          LineTo(Random(GetMaxX),Random(GetMaxY));
          Delay(100);
          k := k+1;
       Until k =15;
       SetColor(1);
       OutTextXY(10,100,'Chao mung nam 2000');
       Delay(2000);
       CloseGraph;
    End.
    133/Đa giác:
    Code: 
    Program Da_Giac;
    Uses Graph;
    Const M : Array[0..5] Of PointType = ((x:0;y:10),(x:53;y:29),
              (x:112;y:134),(x:65;y:100),(x:34;y:100),(x:0;y:10));
    Var
        Gd,Gm : Integer;
    Begin
        Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       DrawPoly(7,M);
       Readln;
       CloseGraph;
    End.
    134/Ṿng Olympic:
    Code: 
    Program Vong_Olympic;
    Uses Graph;
    Var
        Gd,Gm:Integer;
       MaxX,MaxY:Integer;
       R : Integer;
       Y1,Y2 : Integer;
       X1,X2,X3,X4,X5 : Integer;
       Kc : Integer;
    Begin
        Write('-Ban kinh = ');
       Readln(R);
       Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       If GraphResult <> GrOK Then
           Halt(1);
       MaxX := GetMaxX;
       MaxY := GetMaxY;
       Y1 := (MaxY - 3*R) Div 2 + R;
       Y2 := Y1 + R;
       Kc := R Div 5;
       X1 := (MaxX - 6*R -2*Kc) Div 2 + R;
       X2 := X1 + Kc + 2*R;
       X3 := X2 + Kc + 2*R;
       X4 := X1 + R + (Kc Div 2);
       X5 := X2 + R + (Kc Div 2);
       SetColor(14);
       Circle(X1,Y1,R);
       Circle(X2,Y1,R);
       Circle(X3,Y1,R);
       Circle(X4,Y2,R);
       Circle(X5,Y2,R);
       Readln;
       CloseGraph;
    End.
    135/H́nh quạt:
    Code: 
    Program Hinh_Quat;
    Uses Graph;
    Var
        Gd,Gm : Integer;
       CenterX,CenterY,Radius : Word;
    Begin
        Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       If GraphResult <> GrOk Then
           Halt(1);
       SetGraphMode(0);
       SetBkColor(Blue);
       CenterX := GetMaxX Div 2;
       CenterY := GetMaxY Div 2;
       Radius := CenterY - 10;
       SetFillStyle(2,2);
       Pieslice(CenterX,CenterY,0,120,Radius);
       SetFillStyle(3,1);
       Pieslice(CenterX,CenterY,120,245,Radius);
       SetFillStyle(4,3);
       Pieslice(CenterX,CenterY,245,360,Radius);
       Readln;
       CloseGraph;
    End.
    136/Biểu đồ cột:
    Code: 
    Program Bieu_Do_Cot;
    Uses Graph;
    Const h = 60;
    Var
        Gd,Gm : Integer;
       Socot : Integer;
       a : Array[1..100] Of Integer;
       Max : Integer;
       i : Integer;
       Mx,My : Integer;
       Xstep,Ystep : Integer;
       x : Integer;
    Begin
        Write('-Tong so cot: ');
       Readln(Socot);
       For i := 1 To Socot Do
           Begin
              Write('    +Cot thu : ',i:2,' = ');
             Readln(a[i]);
          End;
       Max := a[1];
       For i := 2 To Socot Do
       If a[i] > Max Then
           Max := a[i];
       Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       If GraphResult <> GrOk Then
           Halt(1);
       Mx := GetMaxX;
       My := GetMaxY;
       Rectangle(0,0,Mx,My);
       Line(h,h,h,My-h);
       Line(h,My-h,MX-h,My-h);
       Xstep := Round((Mx-3*h)/Socot);
       Ystep := Round((My-2*h)/Max);
       x := h;
       For i := 1 To Socot Do
           Begin
              SetFillStyle(i,i);
             Bar(x,(My-h)-a[i]*Ystep,x+Xstep,My-h);
             Rectangle(x,(My-h)-a[i]*Ystep,x+Xstep,My-h);
             x := x + Xstep;
          End;
       Readln;
       CloseGraph;
    End.
    137/Biểu đồ PIE:
    Code: 
    Program Bieu_Do_PIE;
    Uses Graph;
    Var
        Gd,Gm : Integer;
       Somuc : Integer;
       a : Array[1..100] Of Real;
       Tong,Goc : Real;
       r,i : Integer;
    Begin
        Write('-Tong so muc: ');
       Readln(Somuc);
       Tong := 0;
       For i := 1 To Somuc Do
           Begin
              Write('    +Muc thu : ',i:2,' = ');
             Readln(a[i]);
             Tong := Tong + a[i];
          End;
       For i := 1 To Somuc Do
           a[i]:=(a[i]/Tong)*360;
       Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       If GraphResult <> GrOk Then
           Halt(1);
       R := GetMaxY Div 3;
       Rectangle(0,0,GetMaxX,GetMaxY);
       Goc := 0;
       For i := 1 To Somuc Do
           Begin
              SetFillStyle(i,i);
             PieSlice(GetMaxX Div 2, GetMaxY Div 2,Round(Goc),Round(Goc+a[i]),R);
             Goc := Goc + a[i];
          End;
       Readln;
       CloseGraph;
    End.
    138/Đồ thị:
    Code: 
    Program Do_Thi;
    Uses Graph;
    Var
        Gd,Gm,j,mx,my : Integer;
       i,x,y : Real;
       Xasp,Yasp,CenterX,CenterY : Word;
       Pattern : Word;
       Palette : PaletteType;
    {----------------------------------}
        Function Adjasp(Value: Integer) : Integer;
       Begin
           Adjasp := (LongInt(Value)*Xasp) Div Yasp;
       End;
    {----------------------------------}
    BEGIN
        Gd := Detect;
       InitGraph(Gd,Gm,'C:\BP\BGI');
       If GraphResult <> GrOk Then
           Halt;
       SetGraphMode(0);
       SetBkColor(Blue);
       GetPalette(Palette);
       SetAllPalette(Palette);
       GetAspectRatio(Xasp,Yasp);
       CenterX := GetMaxX Div 2;
       CenterY := GetMaxY Div 2;
       SetTextJustify(CenterText,CenterText);
       SetColor(2);
       Line(0,CenterY,GetMaxX-25,CenterY);
       Line(CenterX,20,CenterX,GetMaxY);
       OutTextXY(CenterX-10,CenterY+5,'0');
       OutTextXY(GetMaxX-16,CenterY,'>X ');
       SetTextStyle(DefaultFont,VertDir,0);
       OutTextXY(CenterX,18,'>');
       SetTextStyle(DefaultFont,HorizDir,0);
       OutTextXY(CenterX,8,'Y');
       i := 0;
       SetColor(2);
       While i <= GetMaxX Do
           Begin
              x :=(i-160)/20;
             mx := Round(i);
             y := (sin(x))*(Sin(x))*(Sin(x));
             my := CenterY - Adjasp(Round(y*20));
             If abs(my) < 200 Then
                 PutPixel(mx,my,14);
             i := i+(2/7);
          End;
       Rectangle(CenterX+10,CenterY+10,GetMaxX-10,GetMaxY-15);
       SetViewPort(CenterX+9,CenterY+9,GetMaxX-9,GetMaxY-16,ClipOn);
       SetTextStyle(2,0,4);
       OutTextXY(48,12,'He truc toa do');
       SetTextStyle(1,0,3);
       OutTextXY(60,40,'DESCARTES');
       Readln;
       CloseGraph;
    END.
    139/Cá chép miệng:
    Code: 
    Program Ca_Chep_Mieng;
    Uses Crt,Graph;
    Var
        Gd,Gm : Integer;
       Active,Visual,Temp:Word;
       Xcenter,YCenter,Radius,StAngle,EndAngle : Integer;
    {--------------------------------}
        Procedure Initialize;
       Begin
           Gd := Detect;
          InitGraph(Gd,Gm,'C:\BP\BGI');
          SetColor(Red);
          SetFillStyle(SolidFill,Blue);
          Xcenter := GetMaxX Div 2;
          YCenter := GetMaxY Div 2;
          StAngle := 15;
          Radius := GetMaxY Div 8;
          Active := 0;
          Visual := 1;
       End;
    {--------------------------------}
        Procedure Veca;
       Begin
           if StAngle = 15 Then  {ve bung ca}
              Begin
                 StAngle := 30;
                EndAngle := 330;
             End
          Else
              Begin
                 StAngle := 15;
                EndAngle := 345;
             End;
          PieSlice(Xcenter,YCenter,StAngle,EndAngle,Radius);
              {ve mat ca}
          Circle(Xcenter+Radius Div 2,YCenter - Radius Div 2,4);
              {ve duoi ca}
          Line(Xcenter-Radius,Ycenter,Xcenter-2*Radius,Ycenter-Radius);
          Line(Xcenter-Radius,Ycenter,Xcenter-2*Radius,Ycenter+Radius);
       End;
    {--------------------------------}
    BEGIN
        Initialize;
       While Not KeyPressed Do
           Begin
              SetActivePage(Active);
             SetvisualPage(Visual);
             Veca;
             Temp := Active;
             Active := Visual;
             Visual := Temp;
          End;
    END.
    140/Âm thanh:
    Code: 
    Program Am_thanh;
    Uses Crt;
    CONST
        Notdon=8*58;
       Notdoi=Notdon Div 2;
    TYPE
        Notnhac=(c,cf,d,df,e,f,ff,g,gf,a,af,b);
    Var
        Kyam:Notnhac;
       (*----------------------*)
       PROCEDURE Bannhac(Kyam:Notnhac;Caodo,Truongdo:Integer);
       Var
           Tanso:Real;
          i:Integer;
       Begin
           Tanso:=32.625;
          For i:=1 To Caodo Do
              Tanso:=Tanso * 2;
          For i:=1 To Ord(Kyam) Do
              Tanso:=Tanso * 1.05946;
          If Truongdo <> 0 Then
              Begin
                 Sound(Round(Tanso));
                Delay(Truongdo);
                NoSound
             End
          Else
              Sound(Round(Tanso))
       End;
       (*----------------------*)
    BEGIN
        Bannhac(c,4,Notdon);
       Bannhac(f,4,Notdon);
       Bannhac(g,4,Notdon);
       Bannhac(a,4,Notdon);
       Bannhac(a,4,Notdon);
    END.
    141/3 cạnh của tam giác:
    Code: 
    Program Tam_giac;
    Var
        a,b,c:Integer;
       tamgiac,deu,can:Boolean;
    Begin
        Writeln('BA CANH CUA TAM GIAC ?');
       Writeln('----------------------');
       Write('-Nhap so thu nhat= ');
       Readln(a);
       Write('-Nhap so thu hai = ');
       Readln(b);
       Write('-Nhap so thu ba  = ');
       Readln(c);
       tamgiac:=False;
       deu:=False;
       can:=False;
       If (a+b>c) And (b+c>a) And (c+a>b) Then
           Begin
              tamgiac:=True;
             If (a=b) And (b=c) Then
                 deu:=True;
             If (a=b) Or (b=c) Or (c=a) Then
                 can:=True;
          End;
        Writeln;
       Writeln(' 3 so vua nhap la:');
       Writeln('+Tam giac: ',tamgiac);
       Writeln('+Tam giac deu: ',deu);
       Writeln('+Tam giac can: ',can);
       Writeln;
       Writeln('   Bam phim <Enter> de ket thuc');
       Readln
    End.
    142/Bài toán cổ điển:
    Code: 
    Program Tram_trau;
    Var
        dung,nam,gia,co,trau:Integer;
    Begin
        Writeln('BAI TOAN CO DIEN');
       Writeln('Tram trau tram co');
       Writeln('Trau dung an 5');
       Writeln('Trau nam an 3');
       Writeln('Ba trau gia an 1');
       Writeln('----------------');
       Writeln('           Bai toan nay co cac loi giai sau');
       For dung:=0 To 20 Do
           For nam:=0 To 33-dung Do
              For gia:=0 To (100-(dung+nam)) Do
                 Begin
                    co:=5*dung+3*nam+(gia Div 3);
                   trau:=dung+nam+gia;
                   If (gia Mod 3 =0) And (trau=100) And ( co=100) Then
                       Writeln('-Trau dung ',dung,' con, -Trau nam ',nam,' con, -Trau gia ',gia,' con');
                End;
       Writeln;
       Writeln('   Bam phim <Enter> de ket thuc');
       Readln
    End.
    143/Các hàm lượng giác:
    Code: 
    Program Cac_ham_luong_giac;
    CONST
        g='|';
       ke='--------------------------------------------------';
       Ten='               CAC HAM LUONG GIAC';
       Tde='|DO | RADIAN |   SIN  | COSIN  |  TANG  | COTANG |';
    Var
        Doo:1..89;
       Rad,s,c,t,ct:Real;
    Begin
        Repeat
           Write('-Nhap do (tu 1 den 89, so 0 de ngung): ');
          Readln(Doo);
          If Doo= 0 Then
              Exit;
            Writeln(Ten);
           Writeln(ke);
           Writeln(Tde);
           Writeln(ke);
           Rad:=Doo*Pi/180;
          s:=Sin(rad);
          c:=Cos(Rad);
          t:=s/c;
          ct:=c/s;
           Writeln(g,Doo:2,#248,g,Rad:8:6,g,s:8:6,g,
                                c:8:6,g,t:8:5,g,ct:8:5,g);
          Writeln(ke);
          Writeln;
       Until Doo=0;
    End.
    144/Bài toán gà, chó:
    Code: 
    Program ga_cho;
    Var
       x,y,n:Integer;
    Begin
          n:=1;
       Writeln('* CAC LOI GIAI BAI TOAN CO DIEN GA,CHO');
       Writeln('----------------------------------');
       For x:=1 To 36 Do
          For y:=1 To (36-x) Do
             If ((x*2)+(y*4) =100) then {and ((x+y) =36) Then}
                Begin
                     Writeln('      * Loi giai thu : ',n:3);
                  Write('- Ga  = ',x:2,' con = ',(x*2):2,' chan   ');
                  Write('- Cho = ',y:2,' con = ',(y*4):2,' chan ');
                  If x+y<36 Then
                        Writeln('Ga+Cho= ',x+y:2,' con,khong dung')
                  Else If x+y=36 Then
                         Writeln('Ga+Cho= ',x+y:2,' con,loi giai dung');
                      n:=n+1;
                 End;
           Writeln('      * Tong cong co: ',(n-1):3,' loi giai');
           Writeln;
           Writeln('   Bam phim <Enter> de ket thuc');
           Readln
       End.
    145/Các nguyên âm, phụ âm trong 1 chuỗi:
    Code: 
    Program Nguyen_am_Phu_am;
    TYPE
        Kytu=Set of Char;
    Var
        a,b,Nguyen,Phu:Kytu;
       Chuoi:String;
       i:Integer;
       Ch:Char;
    Begin
        Writeln('CAC NGUYEN AM, PHU AM TRONG MOT CHUOI');
       Writeln('-------------------------------------');
       Write('-Nhap mot chuoi ky tu: ');
       Readln(Chuoi);
       a:=['a','e','i','o','u','A','E','I','O','U'];
       b:=['a'..'z','A'..'Z'] - a;
       Nguyen:=[];
       Phu:=[];
       For I:=1 To Length(Chuoi) Do
           Begin
              If Chuoi[i] In a Then
                 Nguyen:=Nguyen + [Chuoi[i]];
             If Chuoi[i] In b Then
                 Phu:=Phu +[Chuoi[i]];
          End;
       Writeln;
       Writeln('*Chuoi nay co cac nguyen am sau day:');
       Write('     ');
       For Ch:='A' To 'z' Do
           If Ch In Nguyen Then
              Write(Upcase(ch),', ');
       Writeln;
       Writeln('*Chuoi nay co cac phu am sau day:');
       Write('     ');
       For Ch:='A' To 'z' Do
           If Ch In Phu Then
              Write(Upcase(Ch),', ');
       Writeln;
       Writeln;
       Write('    Bam phim <Enter> de ket thuc ');
       Readln
    End.
    146/Các phép toán trong tập hợp:
    Code: 
    Program Cac_phep_Toan;
    TYPE
        KyTu=Set of Char;
    Var
        a,b,Cong,Nhan,tru1,tru2:KyTu;
       p:Array[1..100] Of Char;
       m,n,i:Byte;
    Begin
        Writeln('CAC PHEP TOAN TRONG TAP HOP');
       Writeln('---------------------------');
       a:=[];
       b:=[];
       Write('-So phan tu cua tap hop A= ');
       Readln(m);
       For i:=1 To M Do
           Begin
              Write('  -Phan tu A[',i,']= ');
             Readln(p[i]);
             a:=a + [p[i]];
          End;
       Write('-So phan tu cua tap hop B= ');
       Readln(n);
       For i:=1 To N Do
           Begin
              Write('  -Phan tu B[',i,']= ');
             Readln(p[i]);
             b:=b + [p[i]];
          End;
       Nhan:=a * b;
       Writeln('A * B gom cac phan tu: ');
       For i:=0 To 255 Do
           If Char(i) In Nhan Then
              Write(Char(i),#32);
       Writeln;
       Cong:=a + b;
       Writeln('A + B gom cac phan tu: ');
       For i:=0 To 255 Do
           If Char(i) In Cong Then
              Write(Char(i),#32);
       Writeln;
        Tru1:=a - b;
       Writeln('A - B gom cac phan tu: ');
       For i:=0 To 255 Do
           If Char(i) In Tru1 Then
              Write(Char(i),#32);
       Writeln;
        Tru2:=b - a;
       Writeln('B - A gom cac phan tu: ');
       For i:=0 To 255 Do
           If Char(i) In Tru2 Then
              Write(Char(i),#32);
       Writeln;
       If A <= B Then
           Writeln('-Tap hop A nho hon tap hop B');
        If B <= A Then
           Writeln('-Tap hop B nho hon tap hop A');
       Writeln;
       Write('   Bam phim <Enter> de ket thuc ');
       Readln
    End.
    147/Các phép toán:
    Code: 
    Program Cac_phep_toan;
    Var
        a,b,c,d,e,x,y,g,h,i:Integer;
    Begin
        Writeln('CAC PHEP TOAN');
       Writeln('-------------');
       Writeln;
       a:=124;
       b:=12;
       Writeln(a:3,' DIV ',b:2,' = ',a DIV b);
       Writeln(a:3,' MOD ',b:2,' = ',a MOD b);
       c:=12;
       d:=22;
       Writeln(c:2,' AND ',d:2,' = ',c AND d);
       Writeln(c:2,' OR ',d:2,' = ',c OR d);
       Writeln(c:2,' XOR ',d:2,' = ',c XOR d);
       x:=2;
       g:=x Shl 7;
       Writeln('g = ',x:2,' Shl 7 = ',g);
       x:=256;
       h:=x Shr 7;
       Writeln('h = ',x:2,' Shr 7 = ',h);
       i:=g+h;
       Writeln('i = g + h = ',i);
       Writeln('Lo(i) = ',Lo(i));
       Writeln('Hi(i) = ',Hi(i));
       Writeln('Swap(i) = ',Swap(i));
       Writeln;
       Writeln('    Bam phim <Enter> de ket thuc');
       Readln
    End.
    148/Các số nguyên tố:
    Code: 
    Program So_nguyen_to;
    Var
        NguyenTo,Sang:Set of 1..100;
       so:1..100;
       i:Integer;
    Begin
        Writeln('             CAC SO NGUYEN TO TU 1 DEN 100');
       Writeln('             -----------------------------');
       Writeln;
       NguyenTo:=[];
       Sang:=[2..100];
       So:=2;
       Repeat
           While Not (So In Sang) Do
              So:=So+1;
          NguyenTo:=NguyenTo + [So];
          Write(So,' ');
          I:=So;
          While I <= 100 Do
              Begin
                 Sang:=Sang -[I];
                I:=I + So;
             End;
       Until Sang=[];
       Writeln;
       Writeln;
       Write('             Bam phim <Enter> de ket thuc ');
       Readln
    End.
    149/Cho biết ngày hôm nay sẽ tính được ngày mai:
    Code: 
    Program Ngay_mai_la_ngay_may;
    Var
        Nam:1900..2000;
       Thang:1..12;
       Ngay:1..31;
    Begin
        Writeln('CHO BIET NGAY HOM NAY SE TINH DUOC NGAY MAI');
       Writeln('-------------------------------------------');
       Repeat
           Write('-Cho biet ngay ( so 0 de ngung): ');
          Readln(Ngay);
          If Ngay = 0 Then
              Exit;
          Write('-Cho biet thang: ');
          Readln(Thang);
          Write('-Cho biet nam: ');
          Readln(Nam);
          Case Thang Of
              1,3,5,7,8,10,12 : If Ngay < 31 Then
                                         Ngay:=Ngay+1
                                     Else
                                  If Thang = 12 Then
                                      Begin
                                         Nam:=Nam+1;
                                        Thang:=1;
                                     End
                                   Else
                                     Begin
                                         Thang:=Thang+1;
                                        Ngay:=1;
                                     End;
             4,6,9,11    :  If Ngay < 30 Then
                                 Ngay:=Ngay+1
                             Else
                             Begin
                                Thang:=Thang+1;
                               Ngay:=1;
                            End;
             2: If (Ngay < 28) Or ((Ngay=28) And (Nam Mod 4 = 0)) then
                     Ngay:=Ngay+1
                 Else
                    Begin
                       Thang:=Thang+1;
                      Ngay:=1;
                   End;
          End;
       Writeln;
       Writeln('+Ngay mai la ngay: ',Ngay:2,' / ',Thang:2,' / ',Nam:4);
       Writeln;
       Until Ngay=0;
    End.
    150/Chọn loại giải trí thích hợp:
    Code: 
    Program Giai_Tri;
    Var
        t:Byte;
    Begin
        Writeln('CHON LOAI GIAI TRI THICH HOP');
       Writeln('----------------------------');
       Write('-Cho biet nhiet do ngay hom nay: ');
       Readln(t);
       If t < 20 Then
           Writeln('Troi lanh, ban nen o nha coi TV');
       If ((t > 20) And (t < 25)) Then
           Writeln('Troi mat me, ban nen di cam trai');
       If ((t > 25) And (t < 30)) Then
           Writeln('Troi hoi nong, ban nen di tam bien Vung Tau');
       If t > 30 Then
           Writeln('Troi nong, ban nen di nghi mat o Da Lat');
        Writeln;
       Writeln('   Bam phim <Enter> de ket thuc');
       Readln
    End.


  3. #3
    Tham gia ngày
    Aug 2011
    Bài gửi
    462
    Cảm ơn
    3
    Thanked 121 Times in 78 Posts

    201/Làm tṛn số thực:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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ố:
    Code: 
     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:
    Code: 
     Program Phan_tich;
                Const
                n=15;
         Var
                a:Array[1..n, 1..n] Of Longint;
            i,j,i1,j1:Integer;
      Begin
                Writeln('PHAN TICH SO NGUYEN DUONG NHO NHAT');
         Writeln('----------------------------------');
         Writeln;
         For i:=1 To n Do
                For j:=1 To n Do
                a[i,j]:=i*i*i + j*j*j;
         Writeln;
         Writeln('IN KET QUA');
         Writeln('----------');
         For i:=1 To n Do
                For j:=1 To i Do
                Begin
                For i1:= i+1 To n Do
                         For j1:=1 To j-1 Do
                         If a[i,j]=a[i1,j1] Then
                         Writeln(a[i,j],' = ',i,' ^3 ',' + ',j,' ^3 ',' = ',
                           i1,' ^3 ',' + ',j1,' ^3');
               End;
         Writeln;
         Writeln('  Bam phim <Enter> de ket thuc ');
         Readln
      End. 
    208/Phép chia chỉ là phép trừ:
    Code: 
     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ố:
    Code: 
     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ố:
    Code: 
     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:
    Code: 
     Program So_ngau_Nhien;
      Uses Crt;
      CONST
                 N = 100;
      VAR
                Mang : Array[1..N] Of ^Word;
         HeapTop : Pointer;
      {-------------------------------}
                Procedure TaoSo;
         Var
                i : Byte;
         Begin
                Randomize;
            For i := 1 To N Do
                Begin
                New(Mang[i]);
                  Mang[i]^ := Random(999);
               End;
         End;
      {-------------------------------}
                Procedure SapXep;
         Var
                i : Byte;
            Tam : Word;
            KetThuc : Boolean;
         Begin
                Repeat
                KetThuc := True;
               For i := 1 To n-1 Do
                If Mang[i]^ > Mang[i+1]^ Then
                         Begin
                         Tam := Mang[i]^;
                        Mang[i]^ := Mang[i+1]^;
                        Mang[i+1]^ := Tam;
                        KetThuc := False;
                     End;
            Until ketThuc;
         End;
      {-------------------------------}
                Procedure InKq;
         Var
                i :Byte;
         Begin
                For i := 1 To N Do
                Write(Mang[i]^:4);
         End;
      {-------------------------------}
      BEGIN
                ClrScr;
         Writeln('           TAO VA SAP XEP THU TU 100 SO NGAU NHIEN');
         Writeln('            ---------------------------------------');
         Writeln;
                Mark(HeapTop);
         TaoSo;
         SapXep;
         Inkq;
         Writeln;
         Write('           Bam <Enter> . . . ');
         Readln;
         Release(HeapTop);
      END. 
    212/Số ngày trong tháng:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     Program Tim_PT_Mang;
                Uses Crt;
         Var
                a:Array[1..1000] Of Integer;
         {----------------------------}
         Procedure Tao;
                Var
                k:Integer;
         Begin
                Randomize;
            For k:=1 To 100 Do
                a[k]:=Random(100);
         End;
         {----------------------------}
         Procedure Tim;
                Var
                k,x:Integer;
         Begin
                Write('-Nhap gia tri X= ');
            Readln(x);
            For k:=1 To 999 Do
                Begin
                         If a[k] +a[k+1] = X Then
                         Writeln('a[',K,'] + a[',K+1,']= ',X)
                Else
                         Writeln('Khong co 2 phan tu nao bang: ',X);
                End;
         End;
      BEGIN
                Writeln('TIM 2 PHAN TU LIEN TIEP BANG GIA TRI X');
         Writeln('-------------------------------------');
         Writeln;
         Tao;
         Tim;
         Writeln;
         Writeln('  Bam phim <Enter> de ket thuc ');
         Readln;
      END. 
    216/T́m các số nguyên tố từ 2 đến N:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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ơ:
    Code: 
     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 ḱ dao động con lắc:
    Code: 
     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:
    Code: 
     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 ṿng tṛn:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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):
    Code: 
     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:
    Code: 
     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:
    Code: 
     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ẻ:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     Program Tong_Tich_Ma_tran;
                Uses Crt;
         Type
                Matran=array[1..3,1..3] Of Integer;
         Var
                a,b,c,d:Matran;
            i,j,k:Byte;
            Ch:Char;
         {*****************************}
         Procedure Nhap(Var m:Matran; Ten:Char);
         Begin
                ClrScr;
            GotoXY(26,6);
            Write('-Nhap ma tran: ',Ten);
            For i:=1 To 3 Do
                For j:=1 to 3 Do
                Begin
                         GotoXY(20*i-8,10+2*j);
                     Write(Ten,'[',i,',',j,']= ');
                     Readln(m[i,j]);
                  End;
         End;
         {*****************************}
         Procedure Xuat(m:Matran; Ten:Char);
         Begin
                ClrScr;
            GotoXY(26,6);
            Write('CAC PHAN TU CUA MA TRAN: ',Ten);
            For i:=1 To 3 Do
                For j:=1 To 3 Do
                Begin
                         GotoXY(20*i-8,10+2*j);
                     Write(Ten,'[',i,',',']= ',m[i,j]);
                  End;
         End;
         {*****************************}
      BEGIN
                Nhap(a,'A');
         Nhap(b,'B');
         For i:=1 To 3 Do
                For j:=1 To 3 Do
                c[i,j]:=a[i,j]+b[i,j];
         Writeln;
         Writeln('MA TRAN TONG');
         Writeln;
         Xuat(c,'C');
         GotoXY(10,25);
         Write('Bam phim <Esc> de xem ma tran tich');
         For i:=1 to 3 Do
                For j:=1 To 3 Do
                Begin
                d[i,j]:=0;
                  For k:=1 To 3 Do
                         d[i,j]:=a[i,k]*b[k,j]+d[i,j];
               End;
         Repeat
                Ch:=Readkey;
            If Ch=#0 then
                Ch:=Readkey;
         Until Ch=#27;
         Writeln('MA TRAN TICH= ');
         Xuat(d,'D');
         Repeat
         Until KeyPressed;
      END. 
    237/Tṛ chơi One Two Three:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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ị:
    Code: 
     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:
    Code: 
     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ự:
    Code: 
     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ỏ:
    Code: 
     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á tŕnh sử dụng biến con trỏ:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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:
    Code: 
     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 ṿng:
    Code: 
     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:
    Code: 
     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. 


  4. Thành viên dưới đây đă cám ơn bài viết này của: loveIT

    tranchung_9x (10-12-2012)