Bài tập Pascal_Phần 5

Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 5 251/Star: Program Star; Uses Points, Graph, Crt; CONST Seed = 1999; NumPoints = 2000; VAR GrDriver, GrMode, Color : Integer; i, MaxColor : Word; XMax, YMax : Integer; Vp : ViewPortType; M : Point; BEGIN GrDriver :=CGA; GrMode := CGAC0; InitGraph(GrDriver, GrMode, 'C:\BP\BGI'); SetBkColor(Blue); MaxColor := GetMaxColor; Rectangle(0,0,GetMaxX, GetMaxY); SetViewport(i,i,GetMaxX-1,GetMaxY-1,ClipOn); GetViewSettings(Vp); With Vp Do Begin Xmax := (X2 - X1); Ymax := (Y2 - Y1); End; Randomize; While Not KeyPressed Do Begin RandSeed := Seed; i := 0; While (Not KeyPressed) And ( i < NumPoints) Do Begin Inc(i); PutPixel(Random(Xmax)+1,Random(Ymax)+1,Random(MaxColor)+1); End; RandSeed := Seed; i := 0; While ( Not KeyPressed) And ( i < 2 * NumPoints) Do Begin M.Init(Random(Xmax)+1,Random(Ymax)+1); Color := GetPixel(M.X,M.Y); If Color = Random(GetMaxColor) + 1 Then M.Hide Else M.Show; Inc(i); End; End; END. 252/Phương thức trùng tên: Program Phuong_Thuc_Trung_Ten; TYPE Father = OBJECT Procedure A; Procedure B; End; Child = OBJECT( Father ) Procedure B; End; VAR F : Father; C : Child; { } Procedure Father.A; Begin Writeln('Phuong thuc A cua kieu CHA'); End; { } Procedure Father.B; Begin Writeln('Phuong thuc B cua kieu CHA'); End; { } Procedure Child.B; Begin Writeln('Phuong thuc B cua kieu CON'); End; { } BEGIN Writeln(' Goi F.B '); F.B; Writeln(' Goi C.B '); C.B; Readln; END. 253/Virtual Constructor: Program Virtual_Constructor; TYPE Father = OBJECT Constructor Init; Procedure A; Procedure B ; Virtual; End; Child = OBJECT( Father ) Procedure B; Virtual; End; VAR F : Father; C : Child; D : Child; { } Constructor Father.Init; Begin End; { } Procedure Father.A; Begin Writeln('Phuong thuc A cua kieu CHA'); End; { } Procedure Father.B; Begin Writeln('Phuong thuc B cua kieu CHA'); End; { } Procedure Child.B; Begin Writeln('Phuong thuc B cua kieu CON'); End; { } BEGIN F.Init ; {Khoi dong F va tao VMT cho kieu cha } C.Init ; {Khoi dong F va tao VMT cho kieu con } D.Init ; {Khoi dong F va tao VMT cho kieu con } Writeln(' Goi F.B '); F.B; Writeln(' Goi C.B '); C.B; Writeln(' Goi D.B '); D.B; Readln; END. 254/ND_Constructor: Program ND_Constructor; Uses Graph; TYPE Point = OBJECT X,Y : Integer; Constructor Init(InitX,InitY : Integer); Procedure Show; Virtual; Procedure MoveTo(NewX,NewY: Integer); End; Circle = OBJECT(Point) Radius : Integer; Constructor Init(InitX,InitY,InitRadius : Integer); Procedure Show;Virtual; End; Arc = OBJECT(Circle) StartAngle,EndAngle : Integer; Constructor Init(InitX,InitY,InitRadius,InitS,InitE:Integer); Procedure Show;Virtual; End; VAR M : Point; C : Circle; A : Arc; GrDriver,GrMode : Integer; { } Constructor Point.Init; Begin X := InitX; Y := InitY; End; { } Procedure Point.Show; Begin PutPixel(X,Y,1); End; { } Procedure Point.MoveTo; Begin X := NewX; Y := NewY; End; { } Constructor Circle.Init; Begin Point.Init(InitX,InitY); Radius := InitRadius; End; { } Procedure Circle.Show; Begin Graph.Circle(X,Y,Radius); End; { } Constructor Arc.Init; Begin Circle.Init(InitX,InitY,InitRadius); StartAngle := InitS; EndAngle := InitE; End; { } Procedure Arc.Show; Begin Graph.Arc(X,Y,Radius,StartAngle,EndAngle); End; { } BEGIN GrDriver := CGA; GrMode := CGAC0; InitGraph(GrDriver,GrMode,'C:\BP\BGI'); SetBkColor(Blue); M.Init(GetMaxX Div 2, GetMaxY Div 2); M.Show; C.Init(GetMaxX Div 2, GetMaxY Div 2, GetMaxY Div 2); C.Show; A.Init(GetMaxX Div 2, GetMaxY Div 2, GetMaxX Div 4,0,60); A.Show; A.MoveTo(GetMaxX Div 3,GetMaxY Div 2); A.Show; Readln; CloseGraph; END. 255/Bảng lượng giác: Program Bang_Luong_Giac; CONST g='|'; Var F : Text; k : Integer; Rad,S,C,T,CT : Real; { } Function Replicate(Chu:Char;Times:Integer):String; Var j : Integer; Tam :String[80]; Begin Tam := ' '; For j := 1 To Times Do Tam := Tam + Chu; Replicate := Tam; End; { } BEGIN Assign(f,'BLGIAC.DAT'); Rewrite(f); Writeln(f,' * BANG LUONG GIAC *'); Writeln(f); Writeln(f,Replicate(#205,58)); Writeln(f,g,' DO ',g,' RADIAN ',g,' SIN ',g,' COSIN ', g,' TAN ',g,' COTANG ',g); Writeln(f,Replicate(#205,58)); For k := 1 To 89 Do Begin Rad := k * Pi /180; S := Sin(Rad); C := Cos(Rad); T := S/C; CT := 1/t; Writeln(f,g,k:2,g,Rad:10:8,g,S:10:8,g,C:10:8,g,T:10:6,g,CT:10:6,g); End; Writeln(f,Replicate(#205,58)); Flush(f); Close(f); END. 256/Minh hoạ tập tin thiết bị KDB: Program Tap_tin_Kbd; Uses Crt,Turbo3; Var a: Array[1 20] Of String[15]; Item,Wide,i,j: Integer; Choose : String[5]; Ch : Char; Begin ClrScr; Writeln('MINH HOA TAP TIN THIET BI KBD'); Writeln(' '); Writeln; Write('-Cho biet so tieu de: '); Readln(Item); Write('-Do rong cac tieu de: '); Readln(Wide); For i := 0 To Item - 1 Do Begin Write('-Tieu de thu: ',i+1,' : '); Readln(a[i]); End; ClrScr; GotoXY(10,3); j := Wide; Ch := 'M'; For i := 0 To Item - 1 Do Write(a[i] : Wide); i := 0; While Ch < 'M' Do Begin If J < Wide Then j := j + (Item * Wide); If i = -1 Then i := Item - 1; i := i Mod Item; j := j Mod ((Item + 1) * Wide); If j = 0 Then j := Wide; GotoXY(10 - Wide + j,3); Normvideo; Write(a[i]:Wide); Read(Kbd,Ch); If KeyPressed Then Begin Read(Kbd,Ch); End; Lowvideo; GotoXY(WhereX-Wide, WhereY); Write(a[i] : Wide); GotoXY(WhereX + Wide, WhereY); Normvideo; If (Ord(Ch) = 77) Then Begin i := i + 1; j := j + Wide; End Else If (Ord(Ch) = 75) Then Begin i := i - 1; j := j - Wide; End; If(Ord(Ch) = 13) Then Begin Choose := a[i]; GotoXY(50,20); Writeln('Bam vua chon: ',Choose); Readln; Ch := 'Y'; End; End; End. 257/In bảng lượng giác: Program In_Bang_Luong_Giac; Uses Printer; CONST g='|'; Var k : Integer; Rad,S,C,T,CT : Real; { } Function Replicate(Chu:Char;Times:Integer):String; Var j : Integer; Tam :String[80]; Begin Tam := ' '; For j := 1 To Times Do Tam := Tam + Chu; Replicate := Tam; End; { } BEGIN Writeln(Lst,' '); Writeln(Lst,' '); Writeln(Lst,' * BANG LUONG GIAC *'); Writeln(Lst,' '); Writeln(Lst,Replicate(#205,58)); Writeln(Lst,g,' DO ',g,' RADIAN ',g,' SIN ',g,' COSIN ', g,' TAN ',g,' COTANG ',g); Writeln(Lst,Replicate(#205,58)); For k := 1 To 89 Do Begin Rad := k * Pi /180; S := Sin(Rad); C := Cos(Rad); T := S/C; CT := 1/t; Writeln(Lst,g,k:2,g,Rad:10:8,g,S:10:8,g,C:10:8,g,T:10:6,g,CT:10:6,g); End; Writeln(Lst,Replicate(#205,58)); END. 258/Tạo Buffer: Program Tao_Buffer; Var f : Text; Filename : String[20]; Ch : Char; Buf : Array[1 10240] Of Char; Begin Writeln('MINH HOA THU TUC SETTEXTBUF()'); Writeln(' '); Writeln; Write('-Cuo biet ten tap tin: '); Readln(Filename); Assign(f, Filename); SetTextBuf(f,Buf); Reset(f); While Not EOF(f) Do Begin Read(f,Ch); Write(Ch); End; Readln; End. 259/Ngày giờ cập nhật tập tin: Program Ngay_Gio_Cap_nhat_Tap_Tin; Uses Dos; Var f : Text; Filename : String[20]; Time : LongInt; Dt : DateTime; Begin Writeln('MINH HOA THU TUC GETFTIME()'); Writeln(' '); Writeln; Write('-Cho biet ten tap tin: '); Readln(Filename); Writeln; Assign(f,Filename); Reset(f); If DosError <> 6 Then Begin GetFTime(f,Time); UnpackTime(Time,DT); Writeln('+Tap tin: ',Filename,' duoc cap nhat lan cuoi'); Writeln(' -Ngay : ',DT.Day); Writeln(' -Thang : ',DT.Month); Writeln(' -Nam : ',DT.Year); Writeln(' -Hoi : ',DT.Hour,' gio ',DT.Min,' phut ',DT.Sec,' giay'); Close(f); End Else Writeln('-Ma loi: ',DosError); Writeln; Write(' Bam <Enter> '); Readln End. 260/Xem ngày hệ thống: Program Xem_Ngay_He_Thong; Uses Dos; Var Nam,Thang,Ngay,Thu : Word; TenThu : String[10]; Begin Writeln('MINH HOA THU TUC GETDATE()'); Writeln(' '); Writeln; Write(' Hom nay la ngay nao ? '); GetDate(Nam,Thang,Ngay,Thu); Case Thu Of 0 : TenThu := 'Chu Nhat'; 1 : TenThu := 'Thu Hai'; 2 : TenThu := 'Thu Ba'; 3 : TenThu := 'Thu Tu'; 4 : TenThu := 'Thu Nam'; 5 : TenThu := 'Thu Sau'; 6 : TenThu := 'Thu Bay'; End; Writeln; Writeln(' Hom nay la : '); Writeln(' +Thu : ',TenThu); Writeln(' +Ngay : ',Ngay); Writeln(' +Thang: ',Thang); Writeln(' +Nam : ',Nam); Writeln; Write(' Bam <Enter> '); Readln End. 261/Sửa ngày: Program Sua_Ngay; Uses Dos; Var Nam,thang,ngay,Thu: Word; Tenthu : String[3]; Begin Writeln('MINH HOA THU TUC SETDATE()'); Writeln(' '); Writeln; Write('Hom nay la: '); GetDate(Nam,Thang,Ngay,Thu); Case Thu Of 0 : TenThu := 'Sun'; 1 : Tenthu := 'Mon'; 2 : Tenthu := 'Tue'; 3 : Tenthu := 'Wed'; 4 : Tenthu := 'Thu'; 5 : Tenthu := 'Fri'; 6 : Tenthu := 'Sat'; End; Write(Thang,'-',Ngay,'-',Nam,' ',TenThu,' : '); Writeln; Write('-Sua lai thang: '); Readln(Thang); Write('-Sua lai ngay: '); Readln(Ngay); Write('-Sua lai nam: '); Readln(Nam); SetDate(Nam,Thang,Ngay); Writeln; Writeln(' Da sua xong, bam <Enter> '); Readln End. 263/Khung chử nhật nét kép: Program Khung_chu_Nhat_net_kep; Uses Crt; Var x1,y1,x2,y2 : Integer; { } Procedure VeKhung(x1,y1,x2,y2,mau1,mau2: Integer); Var i : Byte; Begin TextColor(mau1); TextBackGround(mau2); For i := X1 + 1 To x2-1 Do Begin GotoXY(i,y1); Write(#205); GotoXY(i,y2); Write(#205); End; For i := y1 + 1 To y2 - 1 Do Begin GotoXY(x1,i); Write(#186); GotoXY(x2,i); Write(#186); End; GotoXY(x1,y1); Write(#201); GotoXY(x2,y1); Write(#187); GotoXY(x1,y2); Write(#200); GotoXY(x2,y2); Write(#188) End; { } BEGIN ClrScr; Writeln('-Toa do goc tren ben trai: '); Write(' +X1 = '); Readln(x1); Write(' +Y1 = '); Readln(y1); Writeln('-Toa do goc duoi ben phai: '); Write(' +X2 = '); Readln(x2); Write(' +Y2 = '); Readln(y2); ClrScr; VeKhung(x1,y1,x2,y2,Red,black); Readln; Normvideo; END. 264/Card_Mode màn hình: Program Card_Mode_man_hinh; Uses Graph; Var Gd,Gm : Integer; kieu : Word; Cardmode : String; Begin DetectGraph(Gd,Gm); InitGraph(Gd,Gm,'C:\BP\BGI'); Cardmode := GetDriverName; Kieu := GetMaxMode; CloseGraph; Writeln('-Ten card man hinh: ',Cardmode); Writeln('-Ten mode man hinh: ',kieu); Readln End. 265/Lỗi khởi động: Program Loi_Khoi_Dong; Uses Graph; Var Gd,Gm : Integer; kieu : Word; Cardmode : String; Begin DetectGraph(Gd,Gm); InitGraph(Gd,Gm,'Path'); Cardmode := GetDriverName; Writeln(GraphErrorMsg(GraphResult)); Write('Bam <Enter> de tiep tuc '); Readln; DetectGraph(Gd,Gm); InitGraph(Gd,Gm,'C:\BP\BGI'); Kieu := GetMaxMode; CloseGraph; Writeln('-Ten card man hinh: ',Cardmode); Writeln('-Ten mode man hinh: ',kieu); Readln End. 266/Thủ tục hàm tiện nghi: Program ThuTuc_Ham_Tien_nghi; Uses Graph,Crt; Var Gd,Gm,LoMode,HiMode,MaxMode : Integer; CenterX,CenterY : Word; CardMonitor : String; Begin DetectGraph(Gd,Gm); Writeln('-Chi so card man hinh: ',Gd); Writeln('-Chi so mode man hinh: ',Gm); Initgraph(Gd,Gm,'A:'); {Co y sai de thong bao loi} Writeln(GraphErrorMsg(GraphResult)); GotoXY(5,25); Write('Bam <Enter> '); Readln; Gd := CGA; [...]... Div 2; CenterY := GetMaxY Div 2; GetAspectRatio(Xasp,Yasp); For i := 1 To 15 Do With M[k] Do Begin X := CenterX +Round(Radius*Sin(2*k*pi/ 15) ); Y := CenterY + AdjAsp(Round(Radius*Cos(2*k*pi/ 15) )); End; Circle(CenterX,CenterY,Radius); For i := 1 To 15 Do For k := 1 To 15 Do Line(M[k].X,M[k].Y,M[i].X,M[i].Y); Readln; CloseGraph; END 270/Tỷ lệ trục: Program Ty_le_Truc; Uses Graph; Const Xasp : Word = 1;... Circle(CenterX,CenterY,R); C := pi/180; SetLineStyle(Solidln,0,ThickWidth); Repeat Moveto(CenterX,CenterY); SetColor(13); LineRel(Trunc((R -5) *Cos(c*x)),Trunc((R -5) *Sin(c*x)) Div 2); Delay(1000); SetColor(0); Moveto(CenterX,CenterY); LineRel(Trunc((R -5) *Cos(c*x)),Trunc((R -5) *Sin(c*x)) Div 2); Inc(x,6); Until KeyPressed; CloseGraph; End 272/Bảng màu: Program Bang_Mau; Uses Graph,Crt; Var Gd,Gm : Integer;... CenterX,CenterY : Integer; M : Array[1 15] Of Point; i,k : Integer; Xasp,Yasp : Word; { } Function AdJasp(Value : Integer): Integer; Begin Adjasp := Longint(Value)*Xasp Div Yasp; End; { } BEGIN Gd := Detect; InitGraph(Gd,Gm,'C:\BP\BGI'); SetBkColor(Blue); CenterX := GetMaxX Div 2; CenterY := GetMaxY Div 2; GetAspectRatio(Xasp,Yasp); For i := 1 To 15 Do With M[k] Do Begin X :=... =(10,10,200, 150 ); Var Gd,Gm : Integer; Begin Gd := Detect; InitGraph(Gd,Gm,'C:\BP\BGI'); SetLineStyle(DottedLn,0,NormWidth); Rectangle(x[1],x[2],x[3],x[4]); Circle(GetMaxX Div 2,GetMaxY Div 2, 80); Readln; SetLineStyle(UserBitLn,$AA,ThickWidth); Rectangle(x[1],x[2],x[3],x[4]); Circle(GetMaxX Div 2,GetMaxY Div 2, 80); Readln; CloseGraph; End 277/Chọn Mode: Program Chon_Mode; Uses Crt, Graph; Const MaxColor = 15; ... WriteModePlay; Const DelayValue = 50 ; Var ViewInfo : ViewPortType; Color : Word; Left,top : Integer; Right,Bottom : Integer; Step : Integer; Begin Rectangle(9,9,GetMaxX-9,GetMaxY-9); SetViewPort(10,10,GetMaxX-10,GetMaxY-10,ClipOn); GetViewSettings(ViewInfo); Left := 0; Top := 0; Right := ViewInfo.x2-ViewInfo.x1; Bottom := ViewInfo.y2-ViewInfo.y1; Step := Bottom Div 50 ; SetColor(GetMaxColor); Line(Left,Top,... (x2-(x1+1)); YMax := (Y2-(Y1+1)); End; Repeat RandSeed := Seed; {Hien ngoi sao} i := 0; While (Not KeyPressed) And (i < NumPts) Do Begin Inc(i); PutPixel(Random(Xmax)+1,Random(YMax)+1,RandColor); Delay (50 ); End; RandSeed := Seed; {lam tat cac ngoi sao} i := 0; While (Not KeyPressed) And (i < NumPts) Do Begin Inc(i); X := Random(XMax)+1; Y := Random(YMax)+1; Color := GetPixel(X,Y); if Color = RandColor... do hoa: ',GraphErrorMsg(ErrorCode)); Halt; End; MaxX := GetMaxX; MaxY := GetMaxY; Repeat Plotline(Random(MaxX), Random(MaxY), Random(maxX), Random(MaxY), Magenta); Until KeyPressed; CloseGraph; END 2 75/ Vẽ đường: Program Ve_duong; Uses Crt,Graph; Type Point = RECORD x,y : Integer; End; Var Gd,Gm,k,CenterX,CenterY: Integer; M : Point; Radius,Color : ShortInt; Begin Gd := Detect; InitGraph(Gd,Gm,'C:\BP\BGI');... Detect; InitGraph(Gd,Gm,'C:\BP\BGI'); Rectangle(0,0,GetMaxX,39); SetTextJustify(CenterText,CenterText); {Chinh giua} SetTextStyle(TriplexFont,Horizdir,3); {Font va huong xuat} OutTextXY(GetMaxX Div 2, 15, 'Nha sach Minh Khai'); Rectangle(0,40,GetMaxX,GetMaxY); SetViewPort(1,41,GetMaxX-1,GetMaxY-1,ClipOn); ClearViewPort; GetViewSettings(Vp); k := (Vp.y2-Vp.Y1) Div 20; With Vp Do Repeat Circle((x2-x1) Div... InitGraph(Gd,Gm,'C:\BP\BGI'); Repeat Ch := Readkey; Val(Ch,k,Result); Setcolor(k); SetBkColor(k+3); Line(0,0,GetMaxX,GetMaxY); Until Ch = #27; End Program Bau_Troi_Day_Sao; Uses Graph,Crt; Const MaxColor = 15; { } Procedure KhoiDong(Path:String); Var Gd,Gm,Gr : Integer; Begin DetectGraph(Gd,Gm); InitGraph(Gd,Gm,Path); Gr := GraphResult; If Gr GrOk Then Begin Writeln('Loi khoi dong: ',GraphErrorMsg(Gr)); . Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 5 251 /Star: Program Star; Uses Points, Graph, Crt; CONST Seed = 1999; NumPoints. Writeln(f,Replicate(#2 05, 58)); Writeln(f,g,' DO ',g,' RADIAN ',g,' SIN ',g,' COSIN ', g,' TAN ',g,' COTANG ',g); Writeln(f,Replicate(#2 05, 58)); . Writeln(f,Replicate(#2 05, 58)); Flush(f); Close(f); END. 256 /Minh hoạ tập tin thiết bị KDB: Program Tap_tin_Kbd; Uses Crt,Turbo3; Var a: Array[1 20] Of String[ 15] ; Item,Wide,i,j: Integer;