GRAFIKA TURBO PASCALA (RYSOWANIE FIGUR WYPEŁNIENIA)
program rysunki;
uses crt,graph;
procedure grafika;
var ster,tryb:integer;
begin
ster:=detect;
initgraph
(ster,tryb,'d:\tp\bgi');
end;
procedure ramka;
var x1,y1,x2,y2:integer;
begin
x1:=0;
y1:=0;
x2:=getmaxx;
y2:=getmaxy;
rectangle (x1,y1,x2,y2);
end;
procedure kratka ;
var a,b,c,d,e,f:integer;
begin
a:=getmaxx;
b:=getmaxy;
e:=round (a div 3);
f:=round (2*a div 3);
c:=round (b div 3);
d:=round (2*b div 3);
line (e,0,e,b);
line (f,0,f,b);
line (0,c,a,c);
line (0,d,a,d);
end;
procedure wypelnienie1;
begin
rectangle (0,0,639 div 3,479
div 3);
setfillstyle (10,white);
floodfill (1,1,white);
end;
procedure wypelnienie2;
var czworokat:array [1..5] of pointtype;
begin
czworokat[1].x:=245;
czworokat[1].y:=15;
czworokat[2].x:=420;
czworokat[2].y:=70;
czworokat[3].x:=410;
czworokat[3].y:=145;
czworokat[4].x:=290;
czworokat[4].y:=115;
czworokat[5].x:=245;
czworokat[5].y:=15;
drawpoly (5,czworokat);
end;
procedure wypelnienie3;
begin
circle (530,80,40);
end;
procedure wypelnienie4;
begin
setfillstyle (1,yellow);
pieslice (80,238,45,150,60);
floodfill (80,238,white);
end;
procedure wypelnienie5;
begin
rectangle (299,188,349,288);
setfillstyle (8,white);
floodfill (300,200,white);
end;
procedure wypelnienie6;
begin
setfillstyle (7,white);
bar3d
(480,199,530,299,12,true);
floodfill (481,200,white);
end;
procedure wypelnienie7;
begin
ellipse (106,396,0,360,80,50);
end;
begin {pr.glowny}
grafika;
ramka;
kratka{ (80,25)};
wypelnienie1;
wypelnienie2;
wypelnienie3;
wypelnienie4;
wypelnienie5;
wypelnienie6;
wypelnienie7;
repeat until keypressed;
closegraph;
end.
program animacja_kulki;
uses crt,graph;
var r:pointer;
dx,dy:integer;
ster,tryb,x,y,rozmiar,m,i:integer;
begin
clrscr;
ster:=vga; tryb:=2;
initgraph
(ster,tryb,'d:\tp\bgi');
circle (320,30,30);
rozmiar:=imagesize
(290,0,350,60);
getmem (r,rozmiar);
getimage (290,0,350,60,r^);
m:=50;
x:=290;
y:=0;
dx:=0;
dy:=round (450/m);
for i:=1 to m do
begin
putimage (x,y,r^,copyput);
delay (200);
clearviewport;
x:=x+dx;
y:=y+dy;
end;
closegraph;
repeat until keypressed;
end.
program rysunek;
uses crt,graph;
var ster,tryb:integer;
procedure kot(a:integer);
begin
linerel (0,-a);
linerel (2*a,0);
linerel (0,-3*a);
linerel (-a,-a);
linerel (0,-2*a);
linerel (a,a);
linerel (a,-a);
linerel (0,2*a);
linerel (2*a,2*a);
linerel (0,3*a);
linerel (-5*a,0);
end;
begin
ster:=detect;
initgraph
(ster,tryb,'d:\tp\bgi');
moveto (100,100);
kot (3);
moveto (400,300);
kot (30);
repeat until keypressed;
closegraph;
end.
program odcinek;
uses graph,crt;
var ster,tryb:integer;
begin
clrscr;
ster:=detect;
initgraph(ster,tryb,'d:\tp\bgi');
line(100,50,100,350);
line(200,50,100,200);
line(100,200,200,350);
line(250,350,300,50);
line(300,50,350,350);
line(275,200,325,200);
repeat until keypressed;
closegraph;
end.
program plotek;
uses crt,graph;
var n,a,h,i:integer;
procedure grafika;
var ster,tryb:integer;
begin
ster:=detect;
initgraph
(ster,tryb,'d:\tp\bgi');
end;
procedure sztacheta (a,h:integer);
var b,c:integer;
begin
b:=round(a/2);
c:=round(a*sqrt(3)/2);
linerel (a,0);
linerel (0,-h);
linerel (-b,-c);
linerel (-b,c);
linerel (0,h);
end;
begin
clrscr;
write ('Podaj liczbe
sztachet ');
readln (n);
write ('Podaj szerokosc sztachety ');
readln (a);
write ('Podaj wysokosc plotka
');
readln (h);
grafika;
moveto (200,200);
for i:=1 to n do
begin
sztacheta (a,h);
moverel (a,0);
end;
readln;
end.
program wykres_slupkowy;
uses crt,graph;
var y:array [1..4] of real;
i,ster,tryb:integer;
ymax,s:real;
yzl:string[6];
begin
clrscr;
writeln
('Podaj wartosc sprzedazy w tys.zlotych w poszczegolnych kwartalach');
writeln;
for i:=1 to 4 do
begin
case i of
1:write ('Kwartal I ');
2:write ('Kwartal II ');
3:write ('Kwartal III ');
4:write ('Kwartal IV ');
end;
readln (y[i]);
end;
ymax:=y[1];
for i:=2 to 4 do if
y[i]>ymax then ymax:=y[i];
ster:=detect;
initgraph
(ster,tryb,'d:\tp\bgi');
setcolor (red);
rectangle
(0,0,getmaxx,getmaxy);
settextstyle
(triplexfont,horizdir,4);
settextjustify
(centertext,centertext);
setcolor (yellow);
outtextxy (344,15,'Wartosc
sprzedazy');
settextstyle
(defaultfont,horizdir,1);
line (59,45,59,454);
line (54,45,58,45);
line (54,147,58,147);
line (54,249,58,249);
line (54,351,58,351);
outtextxy (30,30,'tys.zl');
str (ymax:6:2,yzl);
outtextxy (30,45,yzl);
str (3*ymax/4:6:2,yzl);
outtextxy (30,147,yzl);
str (ymax/2:6:2,yzl);
outtextxy (30,249,yzl);
str (ymax/4:6:2,yzl);
outtextxy (30,351,yzl);
line (59,455,612,455);
outtextxy (40,465,'Kwartal:');
outtextxy (109,465,'I');
outtextxy (209,465,'II');
outtextxy (309,465,'III');
outtextxy (409,465,'IV');
setfillstyle (1,white);
s:=409/ymax;
bar
(60,454,160,45+round(s*(ymax-y[1])));
setfillstyle (2,white);
bar (160,454,260,45+round(s*(ymax-y[2])));
setfillstyle (3,white);
bar
(260,454,360,45+round(s*(ymax-y[3])));
setfillstyle (4,white);
bar
(360,454,460,45+round(s*(ymax-y[4])));
repeat until keypressed;
closegraph;
end.
program rysunek_piesek;
uses crt,graph;
var a,n,i:integer;
procedure tryb_graficzny;
var tryb,ster:integer;
begin
ster:=detect;
InitGraph(ster,tryb,'d:\tp\bgi');
end;
procedure czytaj_dane(var a,n:integer);
begin
write('podaj liczbe pieskow n=');
readln(n);
write('podaj bok a=');
readln(a);
end;
procedure piesek (a:integer);
begin
LineRel(3*a,0);
LineRel(0,-3*a);
LineRel(3*a,3*a);
LineRel(0,6*a);
LineRel(9*a,0);
LineRel(-3*a,3*a);
LineRel(0,3*a);
LineRel(-3*a,0);
LineRel(0,-3*a);
LineRel(-3*a,0);
LineRel(0,3*a);
LineRel(-3*a,0);
LineRel(0,-10*a);
LineRel(-3*a,0);
LineRel(0,-2*a);
end;
begin
clrscr;
czytaj_dane (a,n);
tryb_graficzny;
moveto (100,100);
for i:=1 to n do
begin
piesek (a);
moverel (16*a,0);
end;
repeat until keypressed;
CloseGraph;
end.