Tải bản đầy đủ (.doc) (117 trang)

Bài tập kiểu bản ghi

Bạn đang xem bản rút gọn của tài liệu. Xem và tải ngay bản đầy đủ của tài liệu tại đây (511.66 KB, 117 trang )

KIỂU BẢN GHI (RECORD)
I. KHAI BÁO DŨ LIỆU KIỂU RECORD
TYPE TênKiểu = RECORD
Field1 : Kiểu1;
Field2 : Kiểu2;

FieldN: KiểuN;
END;
VAR Biến : TênKiểu;
Ví dụ:
TYPE HocSinh = Record
Hoten : String[20];
Tuoi : Integer;
DiemTB : real;
End;
VAR HS : HocSinh;
II. XUẤT NHẬP DỮ LIỆU KIỂU RECORD
Không thể dùng các thủ tục xuất/nhập, các phép toán so sánh đối với các biến kiểu record
mà chỉ có thể sử dụng thông qua từng truờng của biến record đó.
2.1. Truy nhập trực tiếp: TênbiếnRecord.Field
2.2. Sử dụng câu lệnh WITH
WITH TênbiếnRecord DO
BEGIN
Xử lý Field1;
Xử lý Field2;

Xử lý FieldN;
END;
2.3. Gán biến Record: Ta có thể gán 2 biến Record cùng kiểu với nhau.
BÀI TẬP MẪU
Bài tập 7.1: Viết chương trình thực hiện phép cộng 2 số phức.


Uses Crt;
Type Complex = Record
a,b:Real;
End;
Var c1,c2,c3:Complex;
dau:string;
Begin
Writeln(‘Nhap so phuc c1:’);
Write(‘Phan thuc a = ‘); Readln(c1.a);
Write(‘Phan ao b = ‘); Readln(c1.b);
Writeln(‘Nhap so phuc c2:’);
Write(‘Phan thuc a = ‘); Readln(c2.a);
Write(‘Phan ao b = ‘); Readln(c2.b);
{Tính tổng 2 số phức}
c3.a := c1.a + c2.a;
c3.b := c1.b + c2.b;
{In kết quả ra màn hình}
Writeln(‘Tong cua 2 so phuc:’);
If c1.b>=0 Then dau:=’+i’ else dau:=’-i’;
Writeln(‘c1 = ‘, c1.a:0:2, dau, abs(c1.b):0:2); {Số phức c1}
If c2.b>=0 Then dau:=’+i’ else dau:=’-i’;
Writeln(‘c2 = ‘, c2.a:0:2, dau, abs(c2.b):0:2); {Số phức c2}
Writeln(‘La so phuc:’);
If c3.b>=0 Then dau:=’+i’ else dau:=’-i’;
Writeln(‘c3 = ‘, c3.a:0:2, dau, abs(c3.b):0:2); {Số phức c3}
Readln;
End.
Bài tập 7.2: Viết chương trình quản lý điểm thi Tốt nghiệp của sinh viên với 2 môn thi: Cơ sở
và chuyên ngành. Nội dung công việc quản lý bao gồm:
• Nhập điểm cho từng sinh viên.

• In danh sách sinh viên ra màn hình.
• Thống kê số lượng sinh viên thi đậu.
• In ra màn hình hình danh sách những sinh viên bị thi lại.
Uses Crt;
Const Max=200;
Type SinhVien=Record
Hoten:string[30];
DiemCS,DiemCN:Byte;
End;
Var SV:ARRAY[1 Max] Of SinhVien;
n:Byte;
c:Char;
Procedure NhapDanhSach;
Var ch:Char;
Begin
Clrscr;
Writeln('NHAP DANH SACH SINH VIEN');
n:=0;
Repeat
n:=n+1;
With SV[n] Do
Begin
Write('Ho ten: '); Readln(Hoten);
Write('Diem co so: '); Readln(DiemCS);
Write('Diem chuyen nganh: '); Readln(DiemCN);
End;
Writeln('Nhan phim bat ky de nhap tiep/Nhan <ESC> de ket thuc!');
ch:=Readkey;
Until ch=#27;
End;

Procedure InDanhSach;
Var ch:Char;
i:Byte;
Begin
Clrscr;
Writeln('DIEM THI TOT NGHIEP SINH VIEN');
Writeln;
WRITELN('STT Ho ten Diem Co so Diem Chuyen nganh');
For i:=1 To n do
With SV[i] Do
Begin
Writeln(i:3,'.',Hoten:20,DiemCS:5,DiemCN:20);
End;
ch:=ReadKey;
End;
Procedure DanhSachSVThilai;
Var ch:Char;
i:Byte;
Begin
Clrscr;
Writeln('DANH SACH SINH VIEN THI LAI');
Writeln;
WRITELN('STT Ho ten Diem Co so Diem Chuyen nganh');
For i:=1 To n do
With SV[i] Do
Begin
If (DiemCS<5)OR(DiemCN<5) Then
Writeln(i:3,'.',Hoten:20,DiemCS:5,DiemCN:20);
End;
ch:=ReadKey;

End;
Procedure ThongKeSVThiDau;
Var S,i:Byte;
ch:Char;
Begin
S:=0;
For i:=1 To n Do
If (SV[i].DiemCS>=5)AND(SV[i].DiemCN>=5) Then S:=S+1;
Writeln('So sinh vien thi dau la: ',s);
ch:=Readkey;
End;
Begin
Repeat
Clrscr;
Writeln('CHUONG TRINH QUAN LY DIEM THI TOT NGHIEP SINH VIEN');
Writeln('1. Nhap danh sach sinh vien');
Writeln('2. In danh sach sinh vien');
Writeln('3. Thong ke so sinh vien thi dau');
Writeln('4. danh sach sinh vien thi lai');
Writeln('<ESC>: Thoat');
c:=Readkey;
Case c Of
'1': NhapDanhSach;
'2': InDanhSach;
'3': ThongKeSVThiDau;
'4': DanhSachSVThilai;
End;
Until c=#27;
End.
Bài tập 7.3: Viết chương trình nhập vào n đỉnh của một đa giác lồi S.

a/ Tính diện tích của S biết:
dt(S)=

=
++

n
i
iiii
yxyx
1
11
|)(|
2
1
trong đó: (x
i
,y
i
) là tọa độ đỉnh thứ i của đa giác S.
b/ Nhập vào thêm một điểm P(x,y). Hãy kiểm tra xem P nằm trong hay ngoài đa giác S.
Ý tưởng:
Nối P với các đỉnh của đa giác S thì ta được n tam giác: S
i
= PP
i
P
i+1
, với P
n+1

=P
1.
Nếu

=
n
1
i
)dt(S
i
= dt(S) thì P ∈ S.
Uses Crt;
Type Toado=Record
x,y:integer;
end;
Mang=array[0 30] of Toado;
Var n:Byte;
A:Mang;
P:ToaDo;
Procedure NhapDinh(var n:Byte; Var P:Mang);
Var i:Byte;
Begin
Write('Nhap so dinh cua da giac n = '); readln(n);
For i:=1 to n do
Begin
Write('P[',i,'].x = ');readln(P[i].x);
Write('P[',i,'].y = ');readln(P[i].y);
End;
End;
Function DienTichDaGiac(n:Byte;P:Mang):real;

Var i,j:integer;
s:real;
Begin
s:=0;
for i:= 1 to n do
begin
if i=n then j:=1 else j:=i+1;
s:=s+((P[i].x*P[j].y-P[j].x*P[i].y));
end;
DienTichDaGiac:=abs(s)/2;
end;
Function DienTichTamGiac(A,B,C:ToaDo):real;
Begin
DienTichTamGiac:=abs(A.x*B.y-B.x*A.y+B.x*C.y-C.x*B.y+C.x*A.y-A.x*C.y)/2;
End;
Function KiemTra(PP:ToaDo;n:Byte;P:Mang):Boolean;
Var i,j:integer;
s:real;
begin
s:=0;
For i:=1 to n do
begin
if i=n then j:=1 else j:=i+1;
s:=s+DienTichTamGiac(PP,P[i],P[j]);
end;
If round(s)=round(DienTichDaGiac(n,P)) then KiemTra:=true
else KiemTra:=false;
end;
Begin
NhapDinh(n,A);

Writeln('S=',DienTichDaGiac(n,A):0:2);
Readln;
Writeln('Nhap diem P:');
Write('P.x = ');readln(P.x);
Write('P.y = ');readln(P.y);
If KiemTra(P,n,A) Then Writeln('Diem P nam trong da giac S.')
Else Writeln('Diem P nam ngoai da giac S.');
Readln;
End.
BÀI TẬP TỰ GIẢI
Bài tập 7.4: Viết chương trình nhân hai số phức c1, c2.
Bài tập 7.5: Viết chương trình quản lý điểm thi học phần của sinh viên bao gồm các trường sau: Họ
tên, Điểm Tin, Điểm ngoại ngữ, Điểm trung bình, Xếp loại. Thực hiện các công việc sau:
a/ Nhập vào danh sách sinh viên của một lớp (không quá 30 người), bao gồm: Họ tên, Điểm
Tin, Điểm Ngoại ngữ. Tính Điểm trung bình và Xếp loại cho từng sinh viên.
b/ In ra màn hình danh sách sinh viên của lớp đó theo dạng sau:
Họ tên Điểm Tin Điểm Ngoại ngữ Điểm T.Bình Xếp loại
Trần Văn An 8 9 8.5 Giỏi
Lê Thị Béo 7 5 6.0 T.Bình

c/ In ra màn hình danh sách những sinh viên phải thi lại (nợ một trong hai môn).
d/ In ra danh sách những sinh viên xếp loại Giỏi.
e/ Tìm và in ra màn hình những sinh viên có điểm trung bình cao nhất lớp.
f/ Sắp xếp lại danh sách sinh viên theo thứ tự Alphabet.
g/ Sắp xếp lại danh sách sinh viên theo thứ tự giảm dần của điểm trung bình.
h/ Viết chức năng tra cứu theo tên không đầy đủ của sinh viên. Ví dụ: Khi nhập vào tên
Phuong thì chương trình sẽ tìm và in ra màn hình thông tin đầy đủ của những sinh viên có tên Phuong
(chẳng hạn như: Pham Anh Phuong, Do Ngoc Phuong, Nguyen Nam Phuong ).
Bài tập 7.6: Viết chương trình quản lý sách ở thư viện gồm các trường sau: Mã số sách, Nhan đề, Tên
Tác giả, Nhà Xuất bản, Năm xuất bản.

a/ Nhập vào kho sách của thư viện (gồm tất cả các trường).
b/ In ra màn hình tất cả các cuốn sách có trong thư viện.
c/ Tìm một cuốn sách có mã số được nhập vào từ bàn phím. Nếu tìm thấy thì in ra màn hình
thông tin đầy đủ của cuốn sách đó, ngược lại thì thông báo không tìm thấy.
c/ Tìm và in ra màn hình tất cả các cuốn sách có cùng tác giả được nhập vào từ bàn phím.
d/ Lọc ra các cuốn sách được xuất bản trong cùng một năm nào đó.
e/ Tìm và in ra màn hình các cuốn sách mà nhan đề có chứa từ bất kỳ được nhập vào từ bàn
phím.
Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1
1/Sắp Xếp Theo Tên:
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:
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:
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:
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:
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:
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:
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ẻ:
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:
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:
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):

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:
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ự:
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:
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:
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:
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ẻ:
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:
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:
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:
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:
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;

Tài liệu bạn tìm kiếm đã sẵn sàng tải về

Tải bản đầy đủ ngay
×