bai tap phan 8

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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
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.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)