Bai tap pascal lop 8

TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG BÀI TẬP CHƯƠNG 1:CÂU LỆNH IF ….THEN… * Bài : Nhập số a , b , c Hãy kiểm tra xem ba số độ dài ba cạnh tam giác hay không ? Thông báo lên hình ‘ Thỏa mãn ‘, ‘ Không thỏa mãn trường hợp tương ứng GIẢI Var a , b , c : Real ; BEGIN Writeln (' Nhap dai canh cua tam giac : ') ; Write (' a = ') ; Readln ( a ) ; Write (' b = ') ; Readln ( b ) ; Write (' c = ') ; Readln ( c ) ; If ( a + b > c ) and ( b + c > a ) and ( c + a > b ) and ( a > ) and ( b > ) and ( c > ) Then Writeln (' Thoa man : Day la canh cua mot tam giac ') Else Writeln (' Khong thoa man ! ') ; Readln ; END * Bài : Nhập N số Đếm số lớn 10 nhỏ 20 tính tổng chúng Sau , đưa hình :So cac so >10 10 ) and ( So < 20 ) Then Begin Tong := Tong + So ; Dem := Dem + ; End ; End ; Writeln (' So cac so >10 va 0 Begin Case s[1] of ' ': While (s[1]=' ')and(length(s)>0) Delete(s,1,1); Else BÀI TẬP PASCAL 48 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG Begin inc(dem); While (s[1]' ')and(length(s)>0) Delete(s,1,1); End; End; End; End; Close(f); Write(' So tu co file hoten.txt la: ',dem); Readln; END Bài : Cho file text Viết chương trình loại bỏ khoảng trống thừa bên file text (* Cat khoang thua *) Uses Crt; Const fi = 'file.inp'; fo = 'C:\file.out'; Var inp,out: text; s: string; BEGIN Assign(inp,fi); Reset(inp); Assign(out,fo); Rewrite(out); While not Eof(inp) Begin Readln(inp,s); While (s[1]=' ')and(Length(s)>0) Delete(s,1,1); While (s[Length(s)]=' ')and(Length(s)>0) Delete(s,Length(s),1); While (Length(s)>0)and(pos(' ',s)0) Delete(s,pos(' ',s),1); Writeln(out,s); End; Close(out); Close(inp); END BÀI TẬP CHƯƠNG 9: CON TRỎ Bài : Bạn lập chương trình cho phép ta nhập từ bàn phím danh sách ghép nối Sau gỡ bỏ record khỏi danh sách (* Gỡ bỏ ghi khỏi danh sách *) Uses Crt; Type ptr=^rec; rec=record name: string[20]; next: ptr; End; Var k : integer; p,l : ptr; BÀI TẬP PASCAL 49 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG Procedure Nhap; Begin ClrScr; New(p); l:=p; Write('Ten: '); Readln(p^.name); Repeat New(p^.next); p:=p^.next; Write('Ten: '); Readln(p^.name); Until p^.name=''; p^.next:=nil; Write('Vi tri ban ghi can go bo: '); Readln(k); End; Procedure Gobo; Var i: integer; q: Ptr; Begin p:=l; For i:=1 to k p:=p^.next; q:=p; p:=l; For i:=3 to k p:=p^.next; If k=1 then l:=q Else p^.next:=q; End; (* Tìm vò trí cuối *) (* Tìm vò trí đầu *) Procedure In_kq; Begin While (l^.nextnil) Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Gobo; In_kq; END Bài : Bạn lập chương trình cho phép nhập danh sách ghép nối Sau chèn thêm record vào danh sách (* Chèn thêm ghi vào danh sách *) Uses Crt; Const inp='C9_2.inp'; Type ptr=^rec; rec=record name: string[20]; next: ptr; End; BÀI TẬP PASCAL 50 TRƯỜNG THCS ÂN HẢO Var f: text; k: integer; p,s,l: ptr; GV:CAO VĂN QUANG Procedure Nhap; Begin Assign(f,inp); Reset(f); New(p); l:=p; While not EoF(f) Begin Readln(f,p^.name); New(p^.next); p:=p^.next; End; p^.next:=nil; Close(f); New(s); Clrscr; Writeln('Nhap ban ghi can chen: '); Write('Ten: '); Readln(s^.name); Write('Vi tri can chen: '); Readln(k); End; Procedure Chen_rec; Var i: integer; Procedure Cat(Var L: ptr); Begin s^.next:=l; l:=s; End; Begin p:=l; For i:=3 to k p:=p^.next; (* Tim vi tri *) If k>1 then Cat(p^.next) Else Cat(l); {Cat - Noi} End; Procedure In_kq; Begin While (l^.nextnil) Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Chen_rec; BÀI TẬP PASCAL 51 TRƯỜNG THCS ÂN HẢO In_kq; END GV:CAO VĂN QUANG Bài : Bạn lập chương trình cho phép nhập danh sách ghép nối Sau đổi chỗ hai record danh sách (* Đổi chỗ ghi danh sách *) Uses Crt; Const inp='C9_3.txt'; Type ptr=^rec; rec=record name: string[20]; next: ptr; End; Var f: text; j,k: integer; p,l: ptr; tenj,tenk: string; Procedure Nhap; Begin Assign(f,inp); Reset(f); New(p); l:=p; While not EoF(f) Begin Readln(f,p^.name); New(p^.next); p:=p^.next; End; p^.next:=nil; Close(f); Clrscr; Write('Nhap vi tri ban ghi can doi cho: '); Readln(j,k); End; Procedure Doicho; Var i: integer; Begin p:=l; For i:=2 to k p:=p^.next; tenk:=p^.name; p:=l; For i:=2 to j p:=p^.next; tenj:=p^.name; p:=l; For i:=2 to k p:=p^.next; p^.name:=tenj; p:=l; For i:=2 to j p:=p^.next; p^.name:=tenk; End; Procedure In_kq; Begin While (l^.nextnil) Begin Writeln(l^.name); l:=l^.next; BÀI TẬP PASCAL 52 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG End; Readln; End; BEGIN Nhap; Doicho; In_kq; END BÀI TẬP CHƯƠNG 10: ĐỒ HỌA Bài : Vẽ hình chữ nhật có tâm trùng với tâm hình , cạnh song song tỉ lê với cạnh hình , kích thước lớn dần theo thời gian (* Hình chữ nhật thay đổi kích thước *) Uses Crt,Graph; Var Gd,Gm,x,y: Integer; tl: real; BEGIN Gd:=Detect; InitGraph(Gd,Gm,''); If GraphResult GrOk Then Halt ; tl:=GetMaxY/GetMaxX; SetFillStyle(1,4); For x:=1 to GetMaxX Begin y:=round(x*tl); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); Delay(10); End; CloseGraph; END Bài : Vẽ hình chữ nhật , kích thước điều khiển Nếu gõ phím + hình lớn lên , gõ phím – nhỏ , gõ Enter dừng chương trình (* Hình chữ nhật kích thước điều khiển *) Uses Crt, Graph; Var Gd,Gm,x,y: Integer; tl: real; c: char; BEGIN BÀI TẬP PASCAL 53 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG Gd:=Detect; InitGraph(Gd,Gm,''); tl:=GetMaxY/GetMaxX; x:=GetMaxX div 2; y:=round(x*tl); SetFillStyle(1,4); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); Repeat OutTextXY(0,0,'Press Esc to Exit '); Repeat c:=ReadKey; Until c in [#27,'+','-']; SetFillStyle(1,0); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); If (c='+')and(x0) then Dec(x); y:=round(x*tl); SetFillStyle(1,4); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); Until c=#27; CloseGraph; END Bài : Một bàn cờ vua hiển thò hình Nếu đặt hậu ( hình tròn màu đỏ ) vào ô cách nhập tên ô , chẳng hạn a5 , ô bò hâu khống chế tô màu xanh Bạn lập chương trình thực yêu cầu (* Phạm vi kiểm soát Con hậu *) Uses Crt,Graph; Const N=8; W=40; X=150; Y=400; Var Gd,Gm,i,Hi: Integer; j,Hj,H: char; S: String; Pattern : FillPatternType; BEGIN Gd:=Detect; InitGraph(Gd,Gm,''); OutTextXY(270,430,'Ban co vua'); For i:=1 to N For j:='a' to chr(Ord('a')+N-1) Begin If Odd(i+Ord(j)) then SetFillStyle(SolidFill,14) BÀI TẬP PASCAL 54 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG Else SetFillStyle(SolidFill,15); Bar(X+(i-1)*W,Y-(Ord(j)-Ord('a'))*W,X+i*W,Y-(Ord(j)-Ord('a')+1)*W); End; OutTextXY(200,20,'Nhap vi tri hau:'); Hj:=ReadKey; OutTextXY(370,20,Hj); H:=ReadKey; Hi:=Ord(H)-Ord('0'); OutTextXY(380,20,H); SetColor(4); Circle(X+(Hi-1)*W+W div 2,Y-(Ord(Hj)-Ord('a'))*W-W div 2,W div 2-5); GetFillPattern(Pattern); SetFillPattern(Pattern,4); FloodFill(X+(Hi-1)*W+W div 2,Y-(Ord(Hj)-Ord('a'))*W-W div 2,4); SetFillStyle(SolidFill,13); For i:=1 to N For j:='a' to chr(Ord('a')+N-1) If ((iHi)or(jHj)) and((Abs(i-Hi)=Abs(Ord(j)-Ord(Hj)))or(i=Hi)or(j=Hj)) then Bar(X+(i-1)*W,Y-(Ord(j)-Ord('a'))*W,X+i*W,Y-(Ord(j)-Ord('a')+1)*W); Readln; CloseGraph; END Bài : Vẽ đồng hồ điện tử hoạt động hình (* Đồng hồ điện tử *) Uses Crt,Dos,Graph; Var h,m,s,hund: Word; GD,GM: Integer; St: String; Function LeadingZero(w: Word): String; Var s: String; Begin Str(w:0,s); if Length(s)=1 then s:='0'+s; LeadingZero:=s; End; BEGIN GD:=Detect; InitGraph(GD,GM,' '); SetTextStyle(DefaultFont,HorizDir,5); Repeat GetTime(h,m,s,hund); St:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s); SetColor(15); BÀI TẬP PASCAL 55 TRƯỜNG THCS ÂN HẢO OutTextXY(150,200,St); Delay(1000); SetColor(0); OutTextXY(150,200,St); Until KeyPressed; CloseGraph; END GV:CAO VĂN QUANG Bài : Hiển thò điểm chuyển động theo chiều kim đồng hồ quỹ đạo tròn , tâm tâm hình , bán kính r = 150 (* Điểm chuyển động tròn *) Uses Crt, Graph; Const r=150; v=5; Var Gd,Gm,x0,y0,x,y: Integer; a: real; (* góc *) BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); x0:=GetMaxX div 2; y0:=GetMaxY div 2; PutPixel(x0,y0,4); a:=0; Repeat x:=x0+Round(r*cos(a)); y:=y0+Round(r*sin(a)); PutPixel(x,y,15); Delay(v); PutPixel(x,y,0); a:=a+0.01; Until KeyPressed; CloseGraph; END Bài : Hiển thò hình chữ nhật hình , vò trí điều khiển bàn phím Gõ phím mũi tên để dòch chuyển hình theo hướng tương ứng (* dieu khien vi tri cua hinh vuong *) Uses Crt, Graph; Var Gd,Gm,x,y,v: Integer; Pa,Pb: Pointer; Size: Word; c: char; BÀI TẬP PASCAL 56 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); Size:=ImageSize(0,0,20,20); GetMem(Pb,Size); GetImage(0,0,20,20,Pb^); GetMem(Pa,Size); Bar(0,0,20,20); GetImage(0,0,20,20,Pa^); ClearDevice; x:=300; y:=200; v:=10; c:=#77; Repeat PutImage(x,y,Pa^,NormalPut); Repeat Until KeyPressed; c:=ReadKey; If c=#0 then c:=ReadKey; PutImage(x,y,Pb^,NormalPut); Case c of #72: Dec(y); #75: Dec(x); #77: Inc(x); #80: Inc(y); End; If x>600 then x:=0; If x440 then y:=0; If y[...]... Var tap: set of char; ch: char; BEGIN tap: =[]; Writeln('Nhap cac phan tu cho mot tap hop cac ki tu: '); Repeat ch:=ReadKey; tap: =tap+ [ch]; Writeln(ch); Until not(ch in ['a' 'z']); Writeln('Cac phan tu cua tap hop la:'); For ch:='a' to 'z' do If ch in tap then Write(ch,' '); Writeln; Writeln('Ban muon bo cac phan tu nao khoi tap hop:'); Repeat ch:=ReadKey; tap: =tap- [ch]; Writeln(ch); Until not(ch in... trinh vo nghiem.') Else If Delta=0 then Begin Write('Phuong trinh co nghiem kep : '); Write('x1,2=',-b/(2*a) :8: 2); End Else Begin x1:=(-b+sqrt(Delta))/(2*a); x2:=(-b-sqrt(Delta))/(2*a); Writeln('Phuong trinh co 2 nghiem phan biet la :'); Writeln('X1=',x1 :8: 2, 'X2=',x2 :8: 2); End; BÀI TẬP PASCAL 8 12 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG End; (*================================*) BEGIN (* CT chính *) Clrscr;... array[1 3, 1 3] of integer ; i, j: byte ; BEGIN Clrscr; Writeln('Nhap mot bang so nguyen kich thuoc 3x3:'); Gotoxy(10, 4); Write(1); Gotoxy(19, 4); Write(2); Gotoxy( 28, 4); Write(3); Gotoxy(5, 6); Write(1); Gotoxy(5, 8) ; Write(2); BÀI TẬP PASCAL 8 23 TRƯỜNG THCS ÂN HẢO Gotoxy(5,10); Write(3); For i:=1 to 3 do For j:=1 to 3 do Begin Gotoxy(9*j-1, 2*i+4); Read(a[i, j]); Gotoxy(9*j-1, 2*i+4); ClrEol; Write(a[i,... Uses Crt; Type Tap= set of 0 99; Const inp='Number.dat'; Var S : Tap; i : byte; Procedure Nhap; Var a: byte; f: text; Begin S:=[]; Assign(f,inp); Reset(f); While not SeekEoF(f) do begin Readln(f,a); If (a>=0)and(a1 then for k:=1 to j-1 do if a[i,k]=ba then d:=true; if i>1 then for k:=1 to i-1 do if a[k,j]=ba then d:=true; ba:=ba+1; until not d; a[i,j]:=ba-1; end; for i:=1 to n do for j:=1 to n do write(a[i,j] :8) ; readln; END Bài 8 : Viết chương trình nhập một bảng số 3 x 3 với... tap: =tap- [ch]; Writeln(ch); Until not(ch in ['a' 'z']); Writeln('Cac phan tu con lai cua tap hop la:'); For ch:='a' to 'z' do If ch in tap then Write(ch,' '); Readln; END BÀI TẬP CHƯƠNG 7: KIỂU RECORD Bài 1 : Thông tin về mỗi học sinh gồm : •  Họ đệm : một xâu 25 kí tự •  Tên : một xâu 10 kí tự BÀI TẬP PASCAL 8 35 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG •  Tuổi : một số nguyên hai chữ số •  Lớp :... Readln(xau2); Compare(xau1, xau2, xau); If xau'' then Writeln('Xau chung la: ',xau) Else Writeln('Khong co ki tu nao trong ca hai xau '); Write('Nhan ENTER de ket thuc '); Readln; END BÀI TẬP PASCAL 8 16 TRƯỜNG THCS ÂN HẢO Bài 8 : GV:CAO VĂN QUANG Viết hàm tính D (St1 , St2) , với U, V là hai xâu kí tự bất kì , là tổng số các kí tự không giống nhau trong hai xâu trên , mỗi loại kí tự chỉ được nhớ một lần Ví... Write( 'Tap S co ',Card(S),' phan tu.'); Readln; END BÀI TẬP PASCAL 8 31 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG Bài 2 : Bạn hãy lập chương trình tạo một tập hợp các số nguyên chẵn kiểu Byte và loại khỏi nó các số chia hết cho 3 Kết quả thể hiện trên màn hình Uses Crt; Const n=5; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0 99; lop: string[3]; End ; Var ds: array [1 20] of Danhsach; i,j:... (ds[i].ten=ds[j].ten)and(ds[i].holot>ds[j].holot) then Doi(i,j); end; Writeln('Danh sach hoc sinh:'); For i:=1 to n do With ds[i] do Writeln(holot:20,ten:11,tuoi:4 ,lop: 5); Writeln; Write('Bam Enter de ket thuc '); Readln; END Bài 3 : Xét chương trình sau : Program B4 ; Var Thoat : Set Of Char = [‘e’ , ’E’] ; BÀI TẬP PASCAL 8 32 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG BEGIN Write (‘ Hay go E de ket thuc : ‘) ; Repeat Ch := Readkey ; Until Ch in thoat ... bo cac phan tu khoi tap hop *) Uses Crt; Var tap: set of char; ch: char; BEGIN tap: =[]; Writeln('Nhap cac phan tu cho mot tap hop cac ki tu: '); Repeat ch:=ReadKey; tap: =tap+ [ch]; Writeln(ch);... Writeln('Cac phan tu cua tap hop la:'); For ch:='a' to 'z' If ch in tap then Write(ch,' '); Writeln; Writeln('Ban muon bo cac phan tu nao khoi tap hop:'); Repeat ch:=ReadKey; tap: =tap- [ch]; Writeln(ch);... ds1 Begin ds2.hoten:=holot+ten; val(copy (lop, 1,2),ds2.khoi,c); ds2.tuoi:=tuoi; BÀI TẬP PASCAL 38 TRƯỜNG THCS ÂN HẢO GV:CAO VĂN QUANG ds2 .lop: =UpCase (lop[ 3]); Write(f2,ds2); End; End; Close(f1);