Animasi Ban Muter : FREE PASCAL

buka Free Pascal anda, kalo belom ada silahkan download disini. Isikan kode-kode berikut

uses graph,crt,math;

type TTitik = record
x : integer;
y : integer;
end;

procedure init();
var gd, gm : integer;
begin
gm:=detect; gd:=0;
InitGraph(gd,gm,'');
if GraphResult <> grOk then
begin
Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
Halt(1);
end;
end;

procedure destroy();
begin
closegraph;
end;

procedure drawLine(xstart,ystart,xend,yend,c:integer);
var
step,k:integer;
dx,dy:real;
x_inc,y_inc,x,y:real;
begin
if(xstart <> xend) or (ystart <> yend) then
begin
dx:=xend-xstart;
dy:=yend-ystart;
x:=xstart;
y:=ystart;
if abs(dx) > abs(dy) then
step:=round(abs(dx))
else
step:=round(abs(dy));
x_inc:=dx/step;
y_inc:=dy/step;
putPixel(round(x),round(y),c);
for k:=1 to step do
begin
x:=x+x_inc;
y:=y+y_inc;
putPixel(round(x),round(y),c);
end;
end;
end;

procedure circlePlotPoints(xCenter,yCenter,x,y,c:integer);
begin
putPixel(xCenter+x, yCenter+y,c);
putPixel(xCenter-x, yCenter+y,c);
putPixel(xCenter+x, yCenter-y,c);
putPixel(xCenter-x, yCenter-y,c);
putPixel(xCenter+y, yCenter+x,c);
putPixel(xCenter-y, yCenter+x,c);
putPixel(xCenter+y, yCenter-x,c);
putPixel(xCenter-y, yCenter-x,c);
end;

procedure CircleMidPoint(xCenter,yCenter,radius,c:integer);
var
x,y,p:integer;
begin
x:=0;
y:=radius;
p:=1-radius;
circlePlotpoints(xCenter,yCenter,x,y,c);
while x<y do
begin
x:=x+1;;
if p<0 then
p:=p+(2*x+1)
else
begin
y:=y-1;
p:=p+(2*(x-y)+1);
end;
circlePlotPoints(xCenter,yCenter,x,y,c);
end;
end;

procedure elipsPlotPoints(xCenter,yCenter,x,y,c:integer);
begin
putPixel(xCenter+x, yCenter+y,c);
putPixel(xCenter-x, yCenter+y,c);
putPixel(xCenter+x, yCenter-y,c);
putPixel(xCenter-x, yCenter-y,c);
end;
procedure elip(xCenter,yCenter,Rx, Ry,c:integer);
var
Rx2,Ry2,x,y,twoRx2,twoRy2,py,px,p:longint;
begin
Rx2:=Rx*Rx;
Ry2:=Ry*Ry;
x:=0;
y:=Ry;
twoRx2:=2*Rx2;
twoRy2:=2*Ry2;
px:=0;
py:=twoRx2*y;
elipsPlotPoints(xCenter,yCenter,x,y,c);
//bagian1
p:=round(Ry2-(Rx2*Ry)+(0.25*Rx2));
while px<py do
begin
x:=x+1;
px:=px+twoRy2;
if p<0 then
p:= p+(Ry2+px)
else
begin
y:=y-1;
py:=py-twoRx2;
p:=p+(Ry2+px-py);
end;
elipsPlotPoints(xCenter,yCenter,x,y,c);
end;
//bagian 2
p:=round(Ry2*(x+0.5) *(x+0.5)+Rx2*(y-1) *(y-1)-Rx2*Ry2);
while y>0 do
begin
y:=y-1;
py:=py-twoRx2;
if p>0 then
p:=p+(Rx2-py)
else
begin
x:=x+1;
px:=px+twoRy2;
p:=p+Ry2+px-py;
end;
elipsPlotPoints(xCenter,yCenter,x,y,c);
end;
end;

procedure polygon(t : array of TTitik;c:integer);
var i : integer;
begin
{ sambungkan semua titik yang ada }
for i:= Low(t) to High(t)-1 do
begin
drawLine(t[i].x,t[i].y,t[i+1].x,t[i+1].y,c);
end;
{ sambungkan titik paling terakhir ke titik paling pertama }
drawLine(t[High(t)].x,t[High(t)].y,t[Low(t)].x,t[Low(t)].y,c);
end;

procedure polyline(t : array of TTitik;c:integer);
var i : integer;
begin
{ sambungkan semua titik yang ada }
for i:= Low(t) to High(t)-1 do
begin
drawLine(t[i].x,t[i].y,t[i+1].x,t[i+1].y,c);
end;
end;

procedure transPolygon(ttkIn : array of TTitik; var ttkOut : array of TTitik;
xtrans,ytrans:integer);
var i:integer;
begin
for i:= Low(ttkIn) to High(ttkIn) do
begin
ttkOut[i].x := ttkIn[i].x + xtrans;
ttkOut[i].y := ttkIn[i].y + ytrans;
end;
end;

procedure scalePolygon(ttkIn : array of TTitik; var ttkOut:array of TTitik;
scale:real; xf,yf : integer);
var i:integer;
begin
for i:= Low(ttkIn) to High(ttkIn) do
begin
ttkOut[i].x := xf + round((ttkIn[i].x-xf) * scale);
ttkOut[i].y := yf + round((ttkIn[i].y-yf) * scale);
end;
end;

procedure rotatePolygon(ttkIn : array of TTitik; var ttkOut:array of TTitik;
xc,yc:integer; a:real);
var i,xt,yt:integer;
begin
for i:= Low(ttkIn) to High(ttkIn) do
begin
xt := round((xc + ((ttkIn[i].x - xc) * cos(a))) -
((ttkIn[i].y - yc) * sin(a)));
yt := round((yc + ((ttkIn[i].x - xc) * sin(a))) +
((ttkIn[i].y - yc) * cos(a)));
ttkOut[i].x := xt;
ttkOut[i].y := yt;
end;
end;

var r_dalam, r_luar, transX, transY, xp, yp, i,a : integer;
kll, alpha : real;
velg,tmp_velg : array[1..2] of tTitik;

begin
clrscr;
init;
{ inisialisasi vektor translasi }
transX := 5;
transY := 0;
{ inisialisasi jejari dan titik pusat roda awal }
r_luar := 50;
r_dalam := 40;
xp := r_luar;
yp := 200 - r_luar;
kll := 2*pi*r_luar;
alpha := 360*5/kll;
{ inisialisasi velg }
velg[1].x := xp; velg[1].y := yp;
velg[2].x := xp; velg[2].y := yp-r_dalam;
{ lakukan animasi selama roda belum menyentuh sisi kanan layar}
{ fungsi GetMaxX digunakan untuk mencari nilai pixel x terbesar }

while (xp < 220) do
begin
clearDevice;
{ buat landasan roda }
drawLine(0,200,200,200,white);
drawLine(200,200,400,400,white);
drawLine(400,400,600,400,white);
drawLine(600,400,700,300,white);
drawLine(700,300,GetMaxX,300,white);
//drawLine(0,602,GetMaxX,602,white);
{ translasikan titik pusat roda }
xp := xp + transX;
yp := yp + transY;
{ gambar roda bagian dalam dan luar }
circleMidPoint(xp,yp,r_luar,white);
circleMidPoint(xp,yp,r_dalam,white);
{ translasikan velg }
transPolygon(velg,velg,transX,transY);
{ rotasikan velg }
rotatePolygon(velg,velg,xp,yp,degtorad(alpha));
{ gambar velg }
for i:=0 to 4 do { velg bintang }
begin
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72-10));
polyline(tmp_velg,white);
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72+10));
polyline(tmp_velg,white);
end;
delay(50);
end;

while (xp < 420) do
begin
clearDevice;
{ buat landasan roda }
drawLine(0,200,200,200,white);
drawLine(200,200,400,400,white);
drawLine(400,400,600,400,white);
drawLine(600,400,700,300,white);
drawLine(700,300,GetMaxX,300,white);

//drawLine(0,210,200,200,white);
//drawLine(0,602,GetMaxX,602,white);
{ translasikan titik pusat roda }
xp := xp + transX;
yp := yp + transY+5;
{ gambar roda bagian dalam dan luar }
circleMidPoint(xp,yp,r_luar,white);
circleMidPoint(xp,yp,r_dalam,white);
{ translasikan velg }
transPolygon(velg,velg,transX,transY+5);
{ rotasikan velg }
rotatePolygon(velg,velg,xp,yp,degtorad(alpha));
{ gambar velg }
for i:=0 to 4 do { velg bintang }
begin
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72-10));
polyline(tmp_velg,white);
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72+10));
polyline(tmp_velg,white);
end;
delay(10);
end;

while (xp < 580) do
begin
clearDevice;
{ buat landasan roda }
drawLine(0,200,200,200,white);
drawLine(200,200,400,400,white);
drawLine(400,400,600,400,white);
drawLine(600,400,700,300,white);
drawLine(700,300,GetMaxX,300,white);
//drawLine(0,602,GetMaxX,602,white);
{ translasikan titik pusat roda }
xp := xp + transX;
yp := yp + transY;
{ gambar roda bagian dalam dan luar }
circleMidPoint(xp,yp,r_luar,white);
circleMidPoint(xp,yp,r_dalam,white);
{ translasikan velg }
transPolygon(velg,velg,transX,transY);
{ rotasikan velg }
rotatePolygon(velg,velg,xp,yp,degtorad(alpha));
{ gambar velg }
for i:=0 to 4 do { velg bintang }
begin
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72-10));
polyline(tmp_velg,white);
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72+10));
polyline(tmp_velg,white);
end;
delay(10);
end;

while (xp < 640) do
begin
clearDevice;
{ buat landasan roda }
drawLine(0,200,200,200,white);
drawLine(200,200,400,400,white);
drawLine(400,400,600,400,white);
drawLine(600,400,700,300,white);
drawLine(700,300,GetMaxX,300,white);
//drawLine(0,602,GetMaxX,602,white);
{ translasikan titik pusat roda }
xp := xp + transX;
yp := yp + transY-5;
{ gambar roda bagian dalam dan luar }
circleMidPoint(xp,yp,r_luar,white);
circleMidPoint(xp,yp,r_dalam,white);
{ translasikan velg }
transPolygon(velg,velg,transX,transY-5);
{ rotasikan velg }
rotatePolygon(velg,velg,xp,yp,degtorad(alpha));
{ gambar velg }
for i:=0 to 4 do { velg bintang }
begin
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72-10));
polyline(tmp_velg,white);
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72+10));
polyline(tmp_velg,white);
end;
delay(10);
end;

while (xp < GetMaxX - r_luar) do
begin
clearDevice;
{ buat landasan roda }
drawLine(0,200,200,200,white);
drawLine(200,200,400,400,white);
drawLine(400,400,600,400,white);
drawLine(600,400,700,300,white);
drawLine(700,300,GetMaxX,300,white);
//drawLine(0,602,GetMaxX,602,white);
{ translasikan titik pusat roda }
xp := xp + transX;
yp := yp + transY;
{ gambar roda bagian dalam dan luar }
circleMidPoint(xp,yp,r_luar,white);
circleMidPoint(xp,yp,r_dalam,white);
{ translasikan velg }
transPolygon(velg,velg,transX,transY);
{ rotasikan velg }
rotatePolygon(velg,velg,xp,yp,degtorad(alpha));
{ gambar velg }
for i:=0 to 4 do { velg bintang }
begin
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72-10));
polyline(tmp_velg,white);
rotatePolygon(velg,tmp_velg,xp,yp,degtorad(i*72+10));
polyline(tmp_velg,white);
end;
delay(10);
end;

readkey;
destroy;

end.

SELAMAT MENCOBA :)