Bài tập đồ họa máy tính trên Pascal

Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal

BÀI 1. VẼ BẦU TRỜI ĐẦY SAO
uses crt,graph;
var gd, gm, i : integer;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
for i := 1 to 1000 do
putpixel(random(640),random(480),random(15)+1);
readkey;
END.

BÀI 2. VẼ LÁ CỜ ĐỎ SAO VÀNG
uses crt,graph;
var gd, gm, i, goc, r : integer;
p : array[1..5,1..2] of integer; { lưu toạ độ các đỉnh ngôi sao }
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
goc := 18; r := 100;
for i := 1 to 5 do begin
p[i,1] := round(r*cos(goc*pi/180));
p[i,2] :=-round(r*sin(goc*pi/180)); {dùng dấu – vì trục y của màn hình ngược}
goc := goc + 2*72;
end;
SetFillStyle(1,red);
{vẽ lá cờ là hình chữ nhật tô màu đỏ}
Bar(100,100,540,380);
SetViewPort(320,240,600,400,false); {chuyển gốc toạ độ ra giữa màn hình}
SetColor(yellow);
SetFillStyle(1,yellow);
FillPoly(5,p);

{tô đa giác hình sao, phần giữa không được tô}
FloodFill(0,0,yellow); {nên phải tô phần giữa bằng FloodFill}
readkey;
END.

BÀI 3. VẼ BÓNG CHUYỂN ĐỘNG KIỂU BẬT TƯỜNG
uses crt,graph;
var gd,gm,x,y,dx,dy,r : integer;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
x := 100; y := 100; dx := 6; dy := 5; r := 30;
repeat
setcolor(yellow);
circle(x,y,r); {vẽ đường tròn màu vàng}
delay(20);
setcolor(0);
circle(x,y,r); {vẽ đường tròn màu trùng màu nền <=> xoá }
if (x>=640-r) or (xif (y>=480-r) or (yx := x + dx; y := y + dy;
{cập nhật toạ độ}
until keypressed; {có phím nhấn thì dừng}
END.

1


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
BÀI 4. VẼ BÁNH XE LĂN KHÔNG TRƯỢT
uses crt,graph;

var gd,gm,x,y,dx,da,r,a : integer;
procedure banhxe(x,y,r,c,n,a : integer);
{vẽ bánh xe có n nan hoa với màu c}
var goc,dx,dy,i : integer;
{a là góc của nan hoa đầu tiên}
begin
SetColor(c); goc := a;
circle(x,y,r);
for i := 1 to n do begin
dx := round(r* cos(goc * pi/180)); {dx, dy là toạ độ tương đối của đầu nan hoa}
dy :=-round(r* sin(goc * pi/180)); {so với tâm bánh xe}
Line(x,y,x+dx,y+dy);
{toạ độ tâm bánh xe ở (x,y) }
goc := goc + 360 div n; {360 div n là góc giữa 2 nan hoa kề nhau}
end;
end;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
x := 30; y := 200; dx := 3; a := 30; r := 30;
da:=round(dx/r*180/pi);{công thức tính da theo dx để đảm bảo lăn không trượt: dx=R*da}
repeat
banhxe(x,y,r,yellow,12,a); {vẽ bánh xe}
delay(40);
banhxe(x,y,r,black,12,a); {vẽ bánh xe với màu nền => xoá}
if (x>=640-r) then x := r; {nếu sang cạnh bên phải thì quay lại bên trái}
x := x + dx;
if a < 0 then a := a + 360;
a := a - da;
{quay ngược chiều dương nên phải trừ}
until keypressed;

END.

BÀI 5. VẼ CHUYỂN ĐỘNG CỦA TRÁI ĐẤT VÀ MẶT TRĂNG
uses crt,graph;
var gd,gm,x,y,x1,y1,da,da1,r,r1,goc,goc1 : integer;
procedure hinhtron(x,y,r,c : integer); {vẽ hình tròn có màu c}
var goc,dx,dy,i : integer;
begin
SetColor(c);
circle(x,y,r);
SetFillStyle(1,c);
FloodFill(x,y,c);
end;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
SetViewPort(320,240,600,400,false);
{chuyển gốc toạ độ ra góc}
goc := 0; goc1 := 0; {goc là góc chuyển động của Trái đất, goc1 là của Mặt trăng}
da :=360 div 360;da1 := 360 div 30; {Trái đất quay 1o 1 lần, tương ứng 1 năm 360 ngày }
hinhtron(0,0,50,lightred); {vẽ Mặt trời}
repeat
x := round(240*cos(goc*pi/180)); {toạ độ tương đối của Trái đất với Mặt trời}
y :=-round(200*sin(goc*pi/180)); {chú ý quỹ đạo hình elip}
hinhtron(x,y,20,lightblue);
{vẽ Trái đất}
x1 := round(60*cos(goc1*pi/180));{toạ độ tương đối của Mặt trăng so với Trái đất}
y1 :=-round(50*sin(goc1*pi/180));

2

Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
hinhtron(x+x1,y+y1,8,yellow);
delay(60);

{vẽ Mặt trăng}

hinhtron(x,y,20,0);
{xoá bằng cách vẽ bằng màu nền}
hinhtron(x+x1,y+y1,8,0);
if goc < 0 then goc := goc + 360; {cập nhật góc chuyển động}
goc := goc - da;
if goc1 < 0 then goc1 := goc1 + 360;
goc1 := goc1 - da1;
until keypressed;
END.

BÀI 6. VẼ CÁC ĐƯỜNG CONG TRONG MẶT PHẲNG 2D
uses crt,graph;
var gd, gm, xo, yo, w, h : integer;
x1,y1,x2,y2, xtl, ytl : real;
(* Khởi tạo các tham số của cửa sổ và khung nhìn *)
procedure khoitao_cuaso;
begin
xo := 20; yo := 40; w := 600; h := 400;
xtl := 50; ytl := 50;
{chọn trước tỉ lệ ngang và dọc, cho bằng nhau}
x2 := w/xtl/2; x1 := -x2; {căn cửa sổ để tâm là gốc toạ độ}
y2 := h/ytl/2; y1 := -y2;
end;

{Các hàm chuyển toạ độ thực thành toạ độ màn hình}
function tox(x : real): integer;
begin
tox := xo + round((x-x1)*xtl);
end;
function toy(y : real): integer;
begin
toy := yo + round((y2-y)*ytl);
end;
{Thủ tục vẽ đoạn thẳng trong mặt phẳng thực 2D}
procedure Line2D(x1,y1,x2,y2: real);
begin
Line(tox(x1),toy(y1),tox(x2),toy(y2));
end;
{Thủ tục vẽ trục toạ độ}
procedure vetruc;
var i : integer;
x : string;
begin
Line2D(x1,0,x2,0);
{vẽ trục x}
Line2D(x2-0.2,+0.1,x2,0); {vẽ hình mũi tên trên trục x}
Line2D(x2-0.2,-0.1,x2,0);
Line2D(0,y1,0,y2);
{vẽ trục y}
Line2D(+0.1,y2-0.2,0,y2); {vẽ hình mũi tên trên trục y}
Line2D(-0.1,y2-0.2,0,y2);
SetColor(lightgreen);
SetTextJustify(1,1);
for i := round(x1) + 1 to round(x2) - 1 do {vạch và ghi toạ độ trên trục x}

if i <> 0 then begin
str(i,x);
{vạch i nguyên, chuyển số thành chữ}
outtextxy(tox(i),toy(-0.4),x); {để vẽ chữ lên màn hình}
Line2D(i,-0.1,i,0.1); {vẽ 1 đoạn thẳng làm vạch}
end;

3


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
for i := round(y1) + 1 to round(y2) - 1 do
if i <> 0 then begin
str(i,x);
outtextxy(tox(-0.4),toy(i),x);
Line2D(-0.1,i,0.1,i);
end;
end;
{Vẽ đường cong hàm số y = sinx, x = x1 -> x2}
procedure duongsin;
var x,y,a,b,dx : real;
i,n : integer;
begin
setcolor(yellow);
a := x1; b := x2; n := 100; dx := (b-a)/n;
x := a; y := sin(x);
moveto(tox(x),toy(y)); {dùng 2 hàm toX, toY để chuyển toạ độ thực thành toạ độ màn hình}
for i := 1 to n do begin
x := x + dx; y := sin(x);
lineto(tox(x),toy(y));

end;
end;
{Vẽ đường cong tham số y = cos3t, y = sin5t, t= 0.. 2pi}
procedure thamso;
var t,x,y,a,b,dt : real;
i,n : integer;
begin
setcolor(lightred);
a := 0; b := 2*pi; n := 100; dt := (b-a)/n;
t := a; x := cos(3*t) ; y := sin(5*t);
moveto(tox(x),toy(y));
for i := 1 to n do begin
t := t + dt; x := cos(3*t) ; y := sin(5*t);
lineto(tox(x),toy(y));
end;
end;
{Vẽ đường cong toạ độ cực r = 3cos3p, p= 0 .. 2pi}
procedure tdcuc;
var r,p,x,y,a,b,dp : real;
i,n : integer;
begin
setcolor(13);
a := 0; b := 2*pi; n := 100; dp := (b-a)/n;
p := a; r := 3*cos(3*p);
x := r*cos(p) ; y := r*sin(p); {công thức đổi toạ độ cực sang toạ độ Đề các 2D}
moveto(tox(x),toy(y));
for i := 1 to n do begin
p := p + dp; r := 3*cos(3*p); x := r*cos(p) ; y := r*sin(p);
lineto(tox(x),toy(y));
end;

end;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
khoitao_cuaso;
vetruc;
duongsin;
thamso;
tdcuc;
readkey;
END.

4


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
BÀI 7. MINH HOẠ CÁC PHÉP BIẾN ĐỔI 2D
uses crt,graph;
var gd, gm, xo, yo, w, h, n : integer;
x1,y1,x2,y2, xtl, ytl : real;
x,y : array[1..4] of real;
procedure khoitao_cuaso;
begin
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
xo := 20; yo := 40; w := 600; h := 400;
xtl := 30; ytl := 30;
x2 := w/xtl/2; x1 := -x2;
y2 := h/ytl/2; y1 := -y2;
end;
function tox(x : real): integer;
begin

tox := xo + round((x-x1)*xtl);
end;
function toy(y : real): integer;
begin
toy := yo + round((y2-y)*ytl);
end;
procedure Line2D(x1,y1,x2,y2: real);
begin
Line(tox(x1),toy(y1),tox(x2),toy(y2));
end;
procedure vetruc;
var i : integer;
x : string;
begin
Line2D(x1,0,x2,0);
Line2D(x2-0.2,+0.1,x2,0);
Line2D(x2-0.2,-0.1,x2,0);
Line2D(0,y1,0,y2);
Line2D(+0.1,y2-0.2,0,y2);
Line2D(-0.1,y2-0.2,0,y2);
SetColor(lightgreen);
SetTextJustify(1,1);
for i := round(x1) + 1 to round(x2) - 1 do
if i <> 0 then begin
str(i,x);
outtextxy(tox(i),toy(-0.4),x);
Line2D(i,-0.1,i,0.1);
end;
for i := round(y1) + 1 to round(y2) - 1 do
if i <> 0 then begin

str(i,x);
outtextxy(tox(-0.4),toy(i),x);
Line2D(-0.1,i,0.1,i);
end;
end;
(* Khởi tạo toạ độ các đỉnh hình chữ nhật*)
procedure khoitao_hcn;
begin
n := 4;

5


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
x[1] := 1; y[1] := 1;
x[2] := 1; y[2] := 3;
x[3] := 5; y[3] := 3;
x[4] := 5; y[4] := 1;
end;
(*Thủ tục vẽ hình chữ nhật*)
procedure VeHCN(c : integer);
begin
SetColor(c);
MoveTo(tox(x[1]), toy(y[1]));
LineTo(tox(x[2]), toy(y[2]));
LineTo(tox(x[3]), toy(y[3]));
LineTo(tox(x[4]), toy(y[4]));
LineTo(tox(x[1]), toy(y[1]));
end;
(* Tịnh tiến HCN theo vector (a,b) *)

procedure tinhtien(a,b : real);
var i : integer;
begin
for i := 1 to n do begin
x[i] := x[i] + a;
y[i] := y[i] + b;
end;
end;
(* Tịnh tiến HCN theo tỉ lệ (Sx,Sy) *)
procedure codan(Sx,Sy : real);
var i : integer;
begin
for i := 1 to n do begin
x[i] := Sx*x[i];
y[i] := Sy*y[i];
end;
end;
(* Tịnh tiến HCN theo góc a, đo bằng radian *)
procedure Quay(a : real);
var i : integer;
cosa,sina,tx,ty : real;
begin
cosa := cos(a); sina := sin(a);
for i := 1 to n do begin
tx := x[i] * cosa - y[i] * sina;
ty := x[i] * sina + y[i] * cosa;
x[i] := tx; y[i] := ty;
end;
end;
BEGIN

khoitao_cuaso;
khoitao_hcn;
vetruc;
VeHCN(14);
readkey;
tinhtien(-3,-2); {tịnh tiến HCN để tâm HCN là gốc toạ độ}
VeHCN(13);
readkey;
codan(1.2,2.4); {co dãn để HCN trở thành hình vuông :D}
VeHCN(12);
readkey;
quay(pi/4);
{Quay HCN góc pi/4}
VeHCN(11);
readkey;

6


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
END.

BÀI 8. VẼ CÁC ĐƯỜNG SIN QUAY QUANH GỐC TOẠ ĐỘ
uses crt,graph;
var gd, gm, xo, yo, w, h : integer;
x1,y1,x2,y2, xtl, ytl : real;
(* CÁC THỦ TỤC HỆ ĐỒ HOẠ 2D *)
procedure khoitao_cuaso;
begin
xo := 20; yo := 40; w := 600; h := 400;

xtl := 30; ytl := 30;
x2 := w/xtl/2; x1 := -x2;
y2 := h/ytl/2; y1 := -y2;
end;
function tox(x : real): integer;
begin
tox := xo + round((x-x1)*xtl);
end;
function toy(y : real): integer;
begin
toy := yo + round((y2-y)*ytl);
end;
procedure Line2D(x1,y1,x2,y2: real);
begin
Line(tox(x1),toy(y1),tox(x2),toy(y2));
end;
procedure vetruc;
var i : integer;
x : string;
begin
SetColor(14);
Line2D(x1,0,x2,0);
Line2D(x2-0.2,+0.1,x2,0);
Line2D(x2-0.2,-0.1,x2,0);
Line2D(0,y1,0,y2);
Line2D(+0.1,y2-0.2,0,y2);
Line2D(-0.1,y2-0.2,0,y2);
SetColor(lightgreen);
SetTextJustify(1,1);
for i := round(x1) + 1 to round(x2) - 1 do

if i <> 0 then begin
str(i,x);
outtextxy(tox(i),toy(-0.4),x);
Line2D(i,-0.1,i,0.1);
end;
for i := round(y1) + 1 to round(y2) - 1 do
if i <> 0 then begin
str(i,x);
outtextxy(tox(-0.4),toy(i),x);
Line2D(-0.1,i,0.1,i);
end;
end;
{Vẽ đường sin y = sinx, x = -pi -> pi, quay 1 góc}
procedure quay(x,y,a:real; var tx,ty : real);
begin
tx := x * cos(a) - y * sin(a);
ty := x * sin(a) + y * cos(a);
end;
procedure duongsin(goc : real);

7


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
var x,y,a,b,dx,tx,ty : real;
i,n : integer;
begin
setcolor(15);
a := -2*pi; b := 2*pi; n := 50; dx := (b-a)/n;
x := a; y := sin(x); quay(x,y,goc,tx,ty);

moveto(tox(tx),toy(ty));
for i := 1 to n do begin
x := x + dx; y := sin(x); quay(x,y,goc,tx,ty);
lineto(tox(tx),toy(ty));
end;
end;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
khoitao_cuaso;
vetruc;
duongsin(0);
duongsin(pi/4);
duongsin(pi/2);
duongsin(3*pi/4);
readkey;
END.

BÀI 9. VẼ CHONG CHÓNG QUAY BẰNG ĐỒ HOẠ RÙA
uses crt,graph;
var
ra,rx,ry, gd,gm, i : integer;
{CÁC THỦ TỤC CỦA HỆ ĐỒ HOẠ RÙA}
procedure right(a: integer);
begin
ra := ra - a;
if ra < 0 then ra := ra + 360;
end;
procedure RmoveTo(x,y : integer);
begin
rx := x; ry := y;

end;
procedure RLineTo(x,y : integer);
begin
Line(rx,ry,x,y);
rx := x; ry := y;
end;
procedure Rmove(d : integer);
var dx,dy : integer;
begin
dx := round(d*cos(ra*pi/180));
dy :=-round(d*sin(ra*pi/180));
rx := rx + dx; ry := ry + dy;
end;
procedure RLine(d : integer);
var dx,dy : integer;
begin
dx := round(d*cos(ra*pi/180));
dy :=-round(d*sin(ra*pi/180));
RLineTo(rx+dx,ry+dy);
end;
{Vẽ ngôi nhà kích thước cạnh là s}
procedure RHouse(s : integer);
begin

8


Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
Rline(s); Right(30);
Rline(s); Right(120);

Rline(s); Right(30);
Rline(s); Right(90);
Rline(s); Right(90);
end;
{Vẽ chong chóng là 6 ngôi nhà}
procedure Chongchong;
begin
for i := 1 to 6 do begin
RHouse(50);
Right(60);
end;
end;
{Cho chong chóng quay}
procedure Quay;
begin
repeat
setcolor(14);
chongchong;
delay(50);
setcolor(0);
chongchong;
right(10);
until keypressed;
end;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
RMoveTo(320,240); {chuyển rùa ra giữa màn hình}
quay;
readkey;
END.

BÀI 10. VẼ CÁC ĐƯỜNG XOẮN ỐC BẰNG ĐỒ HOẠ RÙA
uses crt,graph;
var
ra,rx,ry, gd,gm : integer;
{CAC THU TUC CUA HE DO HOA RUA}
procedure right(a: integer);
begin
ra := ra - a;
if ra < 0 then ra := ra + 360;
end;
procedure RmoveTo(x,y : integer);
begin
rx := x; ry := y;
end;
procedure RLineTo(x,y : integer);
begin
Line(rx,ry,x,y);
rx := x; ry := y;
end;
procedure Rmove(d : integer);
var dx,dy : integer;
begin
dx := round(d*cos(ra*pi/180));
dy :=-round(d*sin(ra*pi/180));
rx := rx + dx; ry := ry + dy;
end;

9

Một số chương trình đồ hoạ minh hoạ trên Turbo Pascal
procedure RLine(d : integer);
var dx,dy : integer;
begin
dx := round(d*cos(ra*pi/180));
dy :=-round(d*sin(ra*pi/180));
RLineTo(rx+dx,ry+dy);
end;
{Vẽ ngôi sao bằng hệ đồ họa rùa}
procedure Ngoisao;
var i : integer;
begin
SetColor(14);
ra := 0;
Rmoveto(50,100);
for i := 1 to 5 do begin
RLine(100); Right(144);
end;
end;
{Vẽ đa giác đều n cạnh}
procedure Dagiac;
var i,n : integer;
begin
SetColor(11);
ra := 0; Rmoveto(500,70);
n := 10;
for i := 1 to n do begin
RLine(30); Right(360 div n);
end;

end;
{Vẽ đường xoắn ốc polysprial}
procedure polysprial(d, dd, da, n : integer);
var i : integer;
begin
for i := 1 to n do begin
RLine(d);
Right(da);
d := d + dd;
end;
end;
procedure xoanoc;
begin
SetColor(12);
ra := 0; Rmoveto(100,340);
polysprial(5, 2, 90, 50); {xoắn ốc vuông, góc xoắn 90 độ}
SetColor(10);
ra := 0; Rmoveto(300,240);
polysprial(20, 5, 170, 70); {xoắn ốc hình sao, góc xoắn 170 độ}
SetColor(13);
ra := -50; Rmoveto(520,340);
polysprial(5, 2, 89, 50); {xoắn ốc hình nghiêng, góc xoắn 89 độ}
end;
BEGIN
gd := 0; initgraph(gd,gm,'C:\TP\BGI');
ngoisao;
dagiac;
xoanoc;
readkey;
END.

10