1

Instrukcja 12 

Cel ćwiczenia : Napisanie aplikacji umożliwiającej wyświetlania linii 
przenikania powierzchni stożka kołowego i kuli. 

 

 

 

Rys. 1 Widok formularza z umieszczonymi komponentami 

 

1.  Uruchomić Delphi. 
 
2.  Przejść do widoku kodu źródłowego przyciskiem F12. 

 

3.  W sekcji Interface (pod uses) umieścić następujący kod: 

 

const Nmax = 10000; 
type 
  wym = 1..Nmax; 
  TablWsp = Array[wym] of Real; 
 
var 
  i,j,k,N,M,L,q,X0,Y0,ZX,ZY: Integer; 
  b,c,r,al,be,gam,del,eps,p,s,t, 
  u,v,w,ksi,dksi,xp,yp,zp: Real; 
  xw,yw,zw,Mg: Tabl1; 
  yy,zz,X,Y: TablWsp; 
  Bd,Dd: Tabl2; 

 
 
 

 

2

4.  W części private klasy TForm1 umieścić nagłówki funkcji: 
 

procedure Obrazek; 
procedure Normalizacja(N,A,B: Integer; xx,yy: TablWsp; 
                       var X,Y: TablWsp); 
procedure Osie(X0,Y0,A,B: Integer; x,y: String;T: TCanvas); 
 

5.  Zapisać projekt za pomocą opcji: File->Save Project As w wybranym katalogu. 
 
6.  Skopiować do katalogu projektu moduły Obroty, Rzuty, Spline2. 

 

7.  Dodać skopiowane moduły do projektu za pomocą opcji Project->Add to Project. 

 

 

 
8.  Umieścić nazwy skopiowanych modułów w sekcji uses. 

 

 

 

 
9.  W części implementation napisać definicje funkcji: 
 

procedure TForm1.Normalizacja; 
const 
  ppX=25; 
  ppY=25; 
var 
  i: Integer; 
  dX,dY,G,Kx,Ky,xmin,xmax,ymin,ymax,Sx,Sy: Real; 
begin 
  A:=A-2*ppx;    B:=B-2*ppY; 
  xmin:=xx[1];   xmax:=xx[1]; 
  ymin:=yy[1];   ymax:=yy[1]; 
  for i:=2 to N do begin 
     if xx[i] < xmin then xmin:=xx[i]; 
     if xx[i] > xmax then xmax:=xx[i]; 

 

3

     if yy[i] < ymin then ymin:=yy[i]; 
     if yy[i] > ymax then ymax:=yy[i]; 
  end; 
  Sx:=xmax-xmin; 
  Sy:=ymax-ymin; 
  for i:=1 to N do begin 
     X[i]:=xx[i]-xmin; 
     Y[i]:=Abs(yy[i]-ymin-Sy); 
  end; 
  G:=1; 
  dX:=A-Sx; 
  dY:=B-Sy; 
  if dX/A <= dY/B then begin 
     Kx:=A/Sx; 
     Ky:=G*Kx; 
  end 
  else begin 
     Ky:=B/Sy; 
     Kx:=Ky/G 
  end; 
  for i:=1 to N do begin 
     X[i]:=Kx*X[i]+ppX; 
     Y[i]:=Ky*Y[i]+ppY; 
  end; 
end; 
 
procedure TForm1.Osie; 
begin 
  with T do begin 
    MoveTo(0,Y0); 
    LineTo(A,Y0); 
    LineTo(A-8,Y0-3); 
    LineTo(A,Y0); 
    LineTo(A-8,Y0+3); 
    TexTout(A-15,Y0+6,x); 
    MoveTo(X0,B); 
    LineTo(X0,0); 
    LineTo(X0-3,8); 
    MoveTo(X0,0); 
    LineTo(X0+3,8); 
    TextOut(X0-11,9,y); 
  end; 
end; 
 
procedure TForm1.Obrazek; 
begin 
  with Form1.Image1.Canvas do begin 
   p:=al*Pi/180; 
   p:=Sin(p)/Cos(p); 
   w:=(1+p*p)*r*r; 

 

4

   u:=p*b-c;   v:=p*b+c; 
   u:=w-u*u;   v:=w-v*v; 
   if N/2 <> N div 2 then N:=N-1; 
   q:=N div 2;        w:=Sqrt(u); 
   u:=b+p*c;          v:=1+p*p; 
   xw[0]:=0;          xw[q]:=0; 
   yw[0]:=(u+w)/v;    zw[0]:=p*yw[0]; 
   yw[q]:=(u-w)/v;    zw[q]:=p*yw[q]; 
   u:=(zw[0]-zw[q])/q; 
   s:=p*p;    s:=0.5*(1+1/s)/b; 
   t:=-c/b;   v:=0.5*(c*c+b*b-r*r)/b; 
   for k:=1 to q-1 do begin 
       w:=zw[0]-k*u; 
       zw[k]:=w; 
       zw[N-k]:=w; 
       yw[k]:=s*w*w+t*w+v; 
       yw[N-k]:=yw[k]; 
       yp:=yw[k]; 
       zp:=w/p; 
       xw[k]:=Sqrt(-yp*yp+zp*zp); 
       xw[N-k]:=-xw[k]; 
   end; 
   for k:=0 to N-1 do begin 
       Obrot(xw[k],yw[k],gam,xp,yp); 
       xw[k]:=xp;   yw[k]:=yp 
   end; 
   for k:=0 to N-1 do begin 
       Obrot(zw[k],xw[k],be,zp,xp); 
       zw[k]:=zp;   xw[k]:=xp 
   end; 
   for k:=0 to N-1 do begin 
       RzutAkson(yp,zp,xw[k],yw[k],zw[k],del,eps); 
       yw[k]:=yp;   zw[k]:=zp 
   end; 
   L:=2; 
   yy[1]:=0; 
   zz[1]:=0; 
   yw[N]:=yw[0]; 
   zw[N]:=zw[0]; 
   FunSklej2(N,yw,zw,Mg,Bd,Dd); 
   yy[2]:=yw[0];    zz[2]:=zw[0]; 
   for i:=1 to N do begin 
       dksi:=Dd[i]/M; 
       for j:=1 to M do begin 
           L:=L+1; 
           ksi:=j*dksi; 
           FunSklej3(N,i,ksi,yy[L],zz[L],yw,zw,Mg,Bd,Dd); 
       end; 
   end; 
   ZX:=Image1.Width;      ZY:=Image1.Height; 

 

5

   Normalizacja(L,ZX,ZY,yy,zz,X,Y); 
   X0:=Round(X[1]);   Y0:=Round(Y[1]); 
   Osie(X0,Y0,ZX,ZY,'y','z',Image1.Canvas); 
   MoveTo(Round(X[2]),Round(Y[2])); 
   for i:=3 to L do 
       LineTo(Round(X[i]),Round(Y[i])); 
  end; 
end; 

 

 

10. Umieścić na formularzu komponent Image i ustawić następujące parametry: 
 

•  Width : 400 
•  Height : 400 

 

11. Umieścić na formatce komponent Button i ustawić własność Caption na Rysuj. 
 
12. Umieścić na formatce komponent GroupBox z palety Standard i zmienić własność 

Caption na Dane. 

 

13. Umieścić na komponencie GroupBox1 10 komponentów LabeledEdit z palety 

Additional i ustawić parametry według następujących wskazówek: 

 

Domyslna 

nazwa: 

Zmienić 

własność 
name na: 

Zmienić 

własność tekst 

na: 

Zmienić własność  

EditLabel->Caption na: 

LabeledEdit1 

LEr 

4 

Promień kuli - r: 

LabeledEdit2 

LEb 

10 

Środek kuli - b 

LabeledEdit3 

LEc 

15 

Środek kuli - c 

LabeledEdit4 

LEalfa 

60 

Nachylenie tworzącej stożka - alfa: 

LabeledEdit5 

LEbeta 

90 

Kąt obrotu wokół osi y - beta: 

LabeledEdit6 

LEgamma 

0 

Kąt obrotu wokół osi z - gamma: 

LabeledEdit7 

LEdelta 

0 

Kąt rzutowania ukośnego - delta: 

LabeledEdit8 

LEepsilon 

0 

Kąt rzutowania ukośnego - epsilon: 

LabeledEdit9 

LEN 

20 

Liczba punktów interpolacji - N: 

LabeledEdit10 

LEM 

5 

Liczba punktów dodatkowych - M: 

 
 

14. Wygenerować zdarzenie OnClick dla komponentu Buton i wpisać następujący kod: 

 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Form1.Image1.Canvas.Brush.Color:=clWhite; 
  Form1.Image1.Canvas.Brush.Style:=bsSolid; 
  Form1.Image1.Canvas.FillRect(Rect(0,0,Image1.Width,Image1.Height)); 
  r:=StrToFloat(LEr.Text); 
  b:=StrToFloat(LEb.Text); 
  c:=StrToFloat(LEc.Text); 
  al:=StrToFloat(LEalfa.Text); 
  be:=StrToFloat(LEbeta.Text); 

 

6

  gam:=StrToFloat(LEgamma.Text); 
  del:=StrToFloat(LEdelta.Text); 
  eps:=StrToFloat(LEepsilon.Text); 
  N:=StrToInt(LEN.Text); 
  M:=StrToInt(LeM.Text); 
  Obrazek; 
end; 

 

14. Skompilować i uruchomić program przyciskiem F9 na klawiaturze komputera. 

 

 

 

Rys. 2 Uruchomiony program