Bài tập Pascal_Phần 2

Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 2 101/Nhập số liệu cho 1 tập tin số nguyên: 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: 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(' '); 1 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: Program So_tay_Dien_Tu; Uses Crt; 2 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: Program CheDau_TapTin; Uses Dos,Crt; Var f : File; {hoac f : Text } 3 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: 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'); 4 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: 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ử: 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; 5 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: 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: Program Lambada; Uses Crt; 6 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: 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 7 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: 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); 8 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: 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: 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; 9 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ơ: 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: '); 10 [...]... 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;... 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; 32 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: Program Hinh_Quat; Uses... 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);... Array[1 20 0] Of HocSinh; Sohs 12, Solop 12, Sohslop : Integer; Stt : Integer; i,j,k : Integer; Coroi : Boolean; 13 Begin Reset(f); Sohs 12 := 0; Solop 12 := 0; While Not EOF(f) Do Begin Read(f,tam); If (Tam.Lop[1]='1') And (Tam.Lop [2] = '2' ) Then Begin Sohs 12 := Sohs 12 + 1; a[Sohs 12] := Tam; Coroi := False; For i := 1 To Solop 12 Do If Tenlop[i] = Tam.Lop Then Coroi := True; If Not coroi Then Begin Solop 12 :=Solop 12+ 1;... Write(f3,so1); ok1 := layso1(so1); End Else 12 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 '); Readln END 116/Đội tuyển: Program Doi_Tuyen; Uses Crt; Type HocSinh = RECORD HoTen : String [24 ]; Lop : String[4]; Dtb : Real;... 115/Trộn tập tin: 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);... 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 24 '); End 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' :... 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 ,24 5,Radius); SetFillStyle(4,3); Pieslice(CenterX,CenterY ,24 5,360,Radius); Readln; CloseGraph; End 136/Biểu đồ cột: Program Bieu_Do_Cot; Uses Graph; Const... 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 '); Readln; reset(f2); While Not EOF(f2) Do Begin Readln(f2,dong); Writeln(dong); End; Writeln;... LaySo2 := True; End 11 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'); . 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); . layso1 := False; End; { } Function Layso2(Var So2 : Integer): Boolean; Begin If Not EOF(f2) Then Begin Read(f2,So2); LaySo2 := True; End 11 Else layso2 := False; End; { } BEGIN Assign(f1,'so1.dat'); . ok2 := Layso2(so2); End; End Else If ok1 Then {chi con tap tin so1.dat} Begin Write(f3,so1); ok1 := layso1(so1); End Else 12 If ok2 Then {chi con tap tin so2.dat} Begin Write(f3,so2);