Instrukcja 11

Cel ćwiczenia : Napisanie aplikacji wyświetlającej proste obiekty przestrzenne.

Rys. 1 Widok formularza z umieszczonymi komponentami 1. Uruchomić Delphi.

2. Umieścić na formularzu komponent Image i ustawić w Inspektorze obiektów następujące parametry:

• Width : 400

• Height : 400

3. Obok komponentu Image1 umieścić komponent GroupBox. Własność Caption ustawić na: Kąty obrotów wokół osi:. Na GroupBox1 umieścić 3 obiekty TrackBar i ustawić następujące własności zgodnie z tabelą:

Domyślma nazwa: Name:

Min: Max: Position:

TrackBar1

TBosX

-90

90

0

TrackBar2

TBosY

-90

90

0

TrackBar3

TBosZ

-90

90

0

4. Obok komponentów typu TrackBar umieścić komponenty Label zmieniając własność Caption zgodnie z rysunkiem 1.

5. Umieścić 2 komponenty RadioButton i ustawić następujące własności zgodnie z tabelą:

Domyślma nazwa:

Name:

Caption:

Checked:

RadioButton1

RBobiekt1

Obiekt szkieletowy 1 True

RadioButton2

RBobiekt2

Obiekt szkieletowy 2 False

6. Umieścić komponent Button i ustawić własność Caption na Rysuj.

7. Klawiszem F12 przejść do kodu źródłowego programu.

8. W części private klasy TForm1 umieścić deklaracje następujących zmiennych oraz nagłówki funkcji:

obrx,obry,obrz,h1,h2,xp,yp,zp: Real;

i,X0,Y0,ZX,ZY,n: Integer;

xx,yy,zz: Array [1..8] of Real;

X,Y: Array [1..8] of Integer;

procedure Obrot(x,y,alfa: Real; var x1,y1: Real);

procedure Obrazek(Czyrys: Boolean);

procedure ObrazekObr;

procedure ObrotXYZ;

procedure Czysc;

9. W części Implementation umieścić definicje następujących procedur: procedure TForm1.Obrot;

var

t,c,s: Real;

begin

t:=Pi*alfa/180;

s:=Sin(t);

c:=Cos(t);

x1:=x*c-y*s;

y1:=x*s+y*c;

end;

procedure TForm1.Obrazek;

var

i : integer;

label et1,et2;

begin

with Form1.Image1.Canvas do begin

if RBobiekt1.Checked then begin

n:=4;

h1:=150*Sqrt(3);

h2:=300*Sqrt(2/3);

xx[1]:= 2*h1/3; yy[1]:= 0; zz[1]:=-h2/3;

xx[2]:=-h1/3; yy[2]:= 150; zz[2]:=-h2/3; xx[3]:=-h1/3; yy[3]:=-150; zz[3]:=-h2/3;

xx[4]:= 0; yy[4]:= 0; zz[4]:= 2*h2/3;

end;

if RBobiekt2.Checked then begin

n:=8;

xx[1]:= 100; yy[1]:= 100; zz[1]:= 100;

xx[2]:= 100; yy[2]:=-100; zz[2]:= 100;

xx[3]:= 100; yy[3]:=-100; zz[3]:=-100;

xx[4]:= 100; yy[4]:= 100; zz[4]:=-100;

xx[5]:=-100; yy[5]:= 100; zz[5]:= 100;

xx[6]:=-100; yy[6]:=-100; zz[6]:= 100;

xx[7]:=-100; yy[7]:=-100; zz[7]:=-100;

xx[8]:=-100; yy[8]:= 100; zz[8]:=-100;

end;

ZX:=Image1.Width; ZY:=Image1.Height;

X0:=ZX div 2; Y0:=Zy div 2;

if Czyrys then begin

for i:=1 to n do begin

X[i]:=X0+Round(yy[i]);

Y[i]:=Y0-Round(zz[i]);

end;

if RBobiekt1.Checked then begin

MoveTo(x[1],y[1]);

LineTo(x[2],y[2]);

LineTo(x[3],y[3]);

LineTo(x[1],y[1]);

LineTo(x[4],y[4]);

LineTo(x[2],y[2]);

MoveTo(x[4],y[4]);

LineTo(x[3],y[3]);

end;

if RBobiekt2.Checked then begin

MoveTo(x[1],y[1]);

LineTo(x[2],y[2]);

LineTo(x[3],y[3]);

LineTo(x[4],y[4]);

LineTo(x[1],y[1]);

LineTo(x[5],y[5]);

LineTo(x[8],y[8]);

LineTo(x[7],y[7]);

LineTo(x[6],y[6]);

LineTo(x[5],y[5]);

MoveTo(x[8],y[8]);

LineTo(x[4],y[4]);

MoveTo(x[3],y[3]);

LineTo(x[7],y[7]);

MoveTo(x[6],y[6]);

LineTo(x[2],y[2]);

end;

end;

end;

end;

procedure TForm1.ObrazekObr;

var

i : integer;

begin

with Image1.Canvas do begin

for i:=1 to n do begin

X[i]:=X0+Round(yy[i]);

Y[i]:=Y0-Round(zz[i]);

end;

if RBobiekt1.Checked then begin

MoveTo(x[1],y[1]);

LineTo(x[2],y[2]);

LineTo(x[3],y[3]);

LineTo(x[1],y[1]);

LineTo(x[4],y[4]);

LineTo(x[2],y[2]);

MoveTo(x[4],y[4]);

LineTo(x[3],y[3]);

end;

if RBobiekt2.Checked then begin

MoveTo(x[1],y[1]);

LineTo(x[2],y[2]);

LineTo(x[3],y[3]);

LineTo(x[4],y[4]);

LineTo(x[1],y[1]);

LineTo(x[5],y[5]);

LineTo(x[8],y[8]);

LineTo(x[7],y[7]);

LineTo(x[6],y[6]);

LineTo(x[5],y[5]);

MoveTo(x[8],y[8]);

LineTo(x[4],y[4]);

MoveTo(x[3],y[3]);

LineTo(x[7],y[7]);

MoveTo(x[6],y[6]);

LineTo(x[2],y[2]);

end;

end;

end;

procedure TForm1.ObrotXYZ;

var

i : integer;

begin

for i:=1 to n do begin

Obrot(yy[i],zz[i],obrx,yp,zp);

yy[i]:=yp; zz[i]:=zp;

end;

for i:=1 to n do begin

Obrot(zz[i],xx[i],obry,zp,xp);

zz[i]:=zp; xx[i]:=xp;

end;

for i:=1 to n do begin

Obrot(xx[i],yy[i],obrz,xp,yp);

xx[i]:=xp; yy[i]:=yp;

end;

end;

procedure TForm1.Czysc;

begin

Image1.Canvas.Brush.Color:=clWhite;

Image1.Canvas.Brush.Style:=bsSolid;

Image1.Canvas.FillRect(Rect(0,0,Image1.Width,Image1.Height)); end;

10. Utworzyć zdarzenie OnClick dla Button1 i zmodyfikować według wskazówki: procedure TForm1.Button1Click(Sender: TObject);

begin

Czysc;

Obrazek(False);

obrx:=TBosx.Position;

obry:=TBosy.Position;

obrz:=TBosz.Position;

ObrotXYZ;

ObrazekObr;

end;

11. Utworzyć zdarzenie OnChange dla TbosX:

procedure TForm1.TBosxChange(Sender: TObject);

begin

Czysc;

Obrazek(False);

obrx:=TBosx.Position;

obry:=TBosy.Position;

obrz:=TBosz.Position;

ObrotXYZ;

ObrazekObr;

end;

12. Utworzyć zdarzenie OnChange dla TbosY:

procedure TForm1.TBosyChange(Sender: TObject);

begin

Czysc;

Obrazek(False);

obrx:=TBosx.Position;

obry:=TBosy.Position;

obrz:=TBosz.Position;

ObrotXYZ;

ObrazekObr;

end;

13. Utworzyć zdarzenie OnChange dla TbosZ:

procedure TForm1.TBoszChange(Sender: TObject);

begin

Czysc;

Obrazek(False);

obrx:=TBosx.Position;

obry:=TBosy.Position;

obrz:=TBosz.Position;

ObrotXYZ;

ObrazekObr;

end;

14. Utworzyć zdarzenie OnClick dla RBobiekt1:

procedure TForm1.RBobiekt1Click(Sender: TObject);

begin

Czysc;

Obrazek(False);

obrx:=TBosx.Position;

obry:=TBosy.Position;

obrz:=TBosz.Position;

ObrotXYZ;

ObrazekObr;

end;

15. Utworzyć zdarzenie OnClick dla RBobiekt2:

procedure TForm1.RBobiekt2Click(Sender: TObject);

begin

Czysc;

Obrazek(False);

obrx:=TBosx.Position;

obry:=TBosy.Position;

obrz:=TBosz.Position;

ObrotXYZ;

ObrazekObr;

end;

16. Skompilować i uruchomić program przyciskiem F9.

Rys. 2 Uruchomiony program