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;
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);
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;
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