Mozgások

Ez a program síkbeli és térbeli mozgásokat szimulál. A program fmMozgas főformjának stílusa: fsMDIForm, a sík fmSik form és a tér fmTer stílusa: fsMDIChild. Azaz ez egy MDI alkalmazás, melyben menük találhatók.

A főmenü amivel az egyes formok hívhatók:

A Sík form menüje, mellyel kiválaszthatjuk a mozgatni kívánt alakzatot, illetve visszaléphetünk a főformra:

A Tér form menüje, mellyel kiválaszthatjuk a kockát, mint mozgó testet, illetve visszaléphetünk a főformra:

A Sík form futási képe, miközben egy Hatszöget mozgat. A nyomógombok segítségével külön-külön az x és y irányba történő lépés nagyságát (a mozgás sebességét), illetve az alakzat méretét változtathatjuk. Mozgás közben az alakzat középpontja a képernyőn marad.

A Tér form futási képe, miközben rajta a kocka rögzített középponttal forog. Nyomógombokkal az egyes irányok körüli forgás sebességét változtathatjuk (szögváltozást két megjelenés között). A térbeliség létrehozását a kocka oldallapjainak megvilágítottságának változásával oldjuk meg. A fényforrás mögöttünk van, minél jobban elfordul a kocka lapja, annál sötétebb zöld színű lesz:

A főmodul listája:

unit UMozgas;

interface

uses
  Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs, Menus, USik, UTer;

type
  TfmMozgasok = class(TForm)
    MainMenu1: TMainMenu;
    Sikbeli1: TMenuItem;
    Sikbeli2: TMenuItem;
    Trbeli2: TMenuItem;
    N1: TMenuItem;
    Kilps1: TMenuItem;
procedure Kilps1Click(Sender: TObject);
procedure Sikbeli2Click(Sender: TObject);
procedure Trbeli2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmMozgasok: TfmMozgasok;

implementation

{$R *.DFM}

procedure TfmMozgasok.Kilps1Click(Sender: TObject);
begin
  Close;
end;

procedure TfmMozgasok.Sikbeli2Click(Sender: TObject);
Var fmSik:TfmSik;
begin
  fmSik:= TfmSik.Create(Self);
  fmSik.Show;
end;

procedure TfmMozgasok.Trbeli2Click(Sender: TObject);
Var fmTer: TfmTer;
begin
  fmTer:= TfmTer.Create(Self);
  fmTer.Show;
end;

end.

A síkbeli mozgások modulja:

unit USik;

interface

uses
  Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TfmSik = class(TForm)
    MainMenu1: TMainMenu;
    Sik1: TMenuItem;
    miKor: TMenuItem;
    miHaromszog: TMenuItem;
    miNegyzet: TMenuItem;
    miHatszog: TMenuItem;
    N1: TMenuItem;
    miKilepes: TMenuItem;
    pnGomb: TPanel;
    btX: TButton;
    Timer1: TTimer;
    btY: TButton;
    btR: TButton;
procedure miKilepesClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure miKorClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btXClick(Sender: TObject);
procedure btYClick(Sender: TObject);
procedure btRClick(Sender: TObject);
procedure miHaromszogClick(Sender: TObject);
procedure miNegyzetClick(Sender: TObject);
procedure miHatszogClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmSik: TfmSik;
  mx,my,mb: Integer;
  x,y,r,dx,dy,dr: Integer;
  al,dal: Integer;
  kor, haromszog, negyzet, hatszog: Boolean;
  Pontok: Array[0..6] Of TPoint;
implementation

Procedure Ki;
Begin
Kor:= False;
  Haromszog:= False;
  Negyzet:= False;
  Hatszog:= False;
End;

Procedure Allit;
Begin
  Inc(x,dx); If (x-r<0) Or (x+r>mx) Then dx:=-dx;
  Inc(y,dy); If (y-r<0) Or (y+r+r>my) Then dy:=-dy;
  Inc(r,dr); If (r<10) Or (r>100) Then dr:=-dr;
  Inc(al,dal); al:= al mod 360;
End;

Procedure Forgat;
Var px, py: Real;
    i: Byte;
Begin
For i:=0 To 6 do
Begin
    px:= (Pontok[i].x-x)*Cos(al*pi/180)
        -(Pontok[i].y-y)*Sin(al*pi/180);
    py:= (Pontok[i].x-x)*Sin(al*pi/180)
        +(Pontok[i].y-y)*Cos(al*pi/180);
    Pontok[i].x:= Round(px)+x;
    Pontok[i].y:= Round(py)+y;
End;
End;
{$R *.DFM}

procedure TfmSik.miKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmSik.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmSik.FormCreate(Sender: TObject);
begin
  mx:= GetDeviceCaps(Canvas.Handle,HorzRes);
  my:= GetDeviceCaps(Canvas.Handle,VertRes);
  mb:= GetDeviceCaps(Canvas.Handle,BitsPixel);
  x:= mx div 2;
  y:= my div 2;
  r:= 20;
  dx:= 1;
  dy:= 1;
  dr:= 0;
  al:= 0;
  dal:= 5;
  Ki;
end;

procedure TfmSik.miKorClick(Sender: TObject);
begin
  Ki; Kor:= True;
With Canvas Do
Begin
Brush.Color:=rgb(192,192,192);
    Rectangle(0,0,mx,my);
    Brush.Color:=rgb(0,0,192);
    Ellipse(x-r,y-r,x+r,y+r);
    Allit;
End;
end;

procedure TfmSik.Timer1Timer(Sender: TObject);
begin
If kor Then miKorClick(Sender);
If Haromszog Then miHaromszogClick(Sender);
If Negyzet Then miNegyzetClick(Sender);
If Hatszog Then miHatszogClick(Sender);
end;

procedure TfmSik.btXClick(Sender: TObject);
begin
  dx:= dx+1;
  btX.Caption:='DX='+IntToStr(dx);
end;

procedure TfmSik.btYClick(Sender: TObject);
begin
  dy:= dy+1;
  btY.Caption:='DY='+IntToStr(dy);
end;

procedure TfmSik.btRClick(Sender: TObject);
begin
  dr:=dr+1;
  btR.Caption:='DR='+IntToStr(dr);
end;

procedure TfmSik.miHaromszogClick(Sender: TObject);
begin
  KI; Haromszog:= True;
  Pontok[0].x:= x + r;
  Pontok[0].y:= y;

  Pontok[1].x:= x - Round(r/2);
  Pontok[1].y:= y - Round(r*sqrt(3)/2);

  Pontok[2].x:= x - Round(r/2);
  Pontok[2].y:= y + Round(r*sqrt(3)/2);

  Forgat;

With Canvas Do
Begin
    Brush.Color:=rgb(192,192,192);
    Rectangle(0,0,mx,my);
    Brush.Color:=rgb(192,0,192);
    Polygon(Slice(Pontok,3));
    Allit;
End;
end;

procedure TfmSik.miNegyzetClick(Sender: TObject);
begin
  KI; Negyzet:= True;
  Pontok[0].x:= x + r;
  Pontok[0].y:= y;

  Pontok[1].x:= x;
  Pontok[1].y:= y - r;

  Pontok[2].x:= x - r;
  Pontok[2].y:= y;

  Pontok[3].x:= x;
  Pontok[3].y:= y + r;

  Forgat;

With Canvas Do
Begin
    Brush.Color:=rgb(192,192,192);
    Rectangle(0,0,mx,my);
    Brush.Color:=rgb(192,0,192);
    Polygon(Slice(Pontok,4));
    Allit;
End;

end;

procedure TfmSik.miHatszogClick(Sender: TObject);
begin
  KI; Hatszog:= True;
  Pontok[0].x:= x + r;
  Pontok[0].y:= y;

  Pontok[1].x:= x + round(r/2);
Pontok[1].y:= y - Round(r*sqrt(3)/2);

  Pontok[2].x:= x - Round(r/2);
  Pontok[2].y:= y - Round(r*sqrt(3)/2);

  Pontok[3].x:= x - r;
  Pontok[3].y:= y;

  Pontok[4].x:= x - Round(r/2);
  Pontok[4].y:= y + Round(r*sqrt(3)/2);

  Pontok[5].x:= x + Round(r/2);
  Pontok[5].y:= y + Round(r*sqrt(3)/2);

  Forgat;

With Canvas Do
Begin
    Brush.Color:=rgb(192,192,192);
    Rectangle(0,0,mx,my);
    Brush.Color:=rgb(192,0,192);
    Polygon(Slice(Pontok,6));
    Allit;
End;

end;

end.

A térbeli mozgás modulja:

unit UTer;

interface

uses
  Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TfmTer = class(TForm)
    MainMenu1: TMainMenu;
    Tr1: TMenuItem;
    miKocka: TMenuItem;
    N1: TMenuItem;
    miKilepes: TMenuItem;
    pnGomb: TPanel;
    btPAl: TButton;
    Timer1: TTimer;
    btPBe: TButton;
    btPGa: TButton;
    btMAl: TButton;
    btMBe: TButton;
    btMGa: TButton;
procedure miKilepesClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure miKockaClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btPAlClick(Sender: TObject);
procedure btPBeClick(Sender: TObject);
procedure btPGaClick(Sender: TObject);
procedure btMAlClick(Sender: TObject);
procedure btMBeClick(Sender: TObject);
procedure btMGaClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const c  = 80; {Vetítés kp-ja a képernyőtől}
      t  = 50; {A valós tér középpontja a képernyőtől}
      a  = 2;  {A kocka fél élhossza}
      qx = 15; {Pixelsűrűség centiméterenként}
      qy = 12;
Cs =  8; {Csúcsok száma}
      Lc =  4; {Lapok csúcsszáma}
      Ls =  6; {Lapok száma}

Type Vekt   = Array[1..3] Of Real;
     Csucsok= Array[1..Cs] Of Vekt;
     Lapok  = Array[1..Ls,1..Lc] Of Byte;

Const KTest: Csucsok= (( a,-a, a), ( a,-a,-a), (-a,-a,-a), (-a,-a, a),
                      ( a, a, a), ( a, a,-a), (-a, a,-a), (-a, a, a));

      KTestL: Lapok=   ((1,4,3,2),(1,2,6,5),(2,3,7,6),
                       (3,4,8,7),(1,5,8,4),(5,6,7,8));
      Al : Integer=   1;
      Be : Integer=   2;
      Ga : Integer=   3;

var
  fmTer: TfmTer;
  mx,my,mb: Integer;
x,y,r,dx,dy,dr: Integer;
  kx, ky: Integer;
  Gomb, Kocka, Oktaeder: Boolean;

implementation

{$R *.DFM}

Procedure Ki;
Begin
  Gomb:= False;
  Kocka:= False;
  Oktaeder:= False;
End;


Procedure Forgatas;
Var i: Byte;
    Px, Py, Pz: Real;
    SinAl, CosAl, SinBe, CosBe, SinGa, CosGa: Real;
Begin
  SinAl:= Sin(Al*pi/180); CosAl:= Cos(Al*pi/180);
  SinBe:= Sin(Be*pi/180); CosBe:= Cos(Be*pi/180);
  SinGa:= Sin(Ga*pi/180); CosGa:= Cos(Ga*pi/180);
For i:= 1 To Cs Do
Begin
    Px:= KTest[i,1]*CosBe*CosGa-KTest[i,2]*CosBe*SinGa+KTest[i,3]*SinBe;

Py:= KTest[i,1]*(CosAl*SinGa+SinAl*SinBe*CosGa)+
         KTest[i,2]*(CosAl*CosGa-SinAl*SinBe*SinGa)-
         KTest[i,3]*SinAl*CosBe;

    Pz:= KTest[i,1]*(SinAl*SinGa-CosAl*SinBe*CosGa)+
         KTest[i,2]*(SinAl*CosGa+CosAl*SinBe*SinGa)+
         KTest[i,3]*CosAl*CosBe;

    KTest[i,1]:= Px;
    KTest[i,2]:= Py;
    KTest[i,3]:= Pz;
End;
End;

Procedure VektSzor(a, b: Vekt; Var s: Vekt);
Begin
  s[1]:= a[2]*b[3]-a[3]*b[2];
  s[2]:= a[3]*b[1]-a[1]*b[3];
  s[3]:= a[1]*b[2]-a[2]*b[1];
End;

Procedure VektKul(a, b: Vekt; Var k: Vekt);
Begin
  k[1]:= a[1]-b[1];
  k[2]:= a[2]-b[2];
k[3]:= a[3]-b[3];
End;

procedure TfmTer.miKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmTer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TfmTer.FormCreate(Sender: TObject);
begin
  ki;
  mx:= GetDeviceCaps(Canvas.Handle,HorzRes);
  my:= GetDeviceCaps(Canvas.Handle,VertRes);
  mb:= GetDeviceCaps(Canvas.Handle,BitsPixel);
  kx:= mx div 2;
  ky:= my div 2;

end;

procedure TfmTer.miKockaClick(Sender: TObject);
Procedure Vetites;
Var Kp: Array[1..Lc+1] Of TPoint;
      i, j: Byte;
      s, k1, k2: Vekt;
      CosDe: Real;

Begin
With Canvas Do
Begin
      Brush.Color:=rgb(192,192,192);
      Rectangle(0,0,mx,my);
For I:= 1 To Ls Do
Begin
For J:= 1 To Lc Do
Begin
If j = 1 Then
Begin
            Kp[Lc+1].x:= Round(Kx + c * KTest[KTestL[i,j],1] * qx/
                              (c - t - KTest[KTestL[i,j],3]));
            Kp[Lc+1].y:= Round(Ky - c * KTest[KTestL[i,j],2] * qy/
                            (c - t - KTest[KTestL[i,j],3]));
End;
         Kp[j].x:= Round(Kx + c * KTest[KTestL[i,j],1] * qx/
(c - t - KTest[KTestL[i,j],3]));
         Kp[j].y:= Round(Ky - c * KTest[KTestL[i,j],2] * qy/
                         (c - t - KTest[KTestL[i,j],3]));
End;
If Kp[1].x*(Kp[2].y-Kp[3].y)+
          Kp[2].x*(Kp[3].y-Kp[1].y)+
          Kp[3].x*(Kp[1].y-Kp[2].y)<0 Then
Begin
         VektKul(KTest[KTestL[i,2]],KTest[KTestL[i,1]],K1);
         VektKul(KTest[KTestL[i,3]],KTest[KTestL[i,2]],K2);
         VektSzor(K1, K2, S);
         CosDe:= s[3] / Sqrt(s[1]*s[1]+s[2]*s[2]+s[3]*s[3]);
         Brush.Color:=rgb(0,
                          Round(255*CosDe),
Round(255*CosDe));
         Polygon(Slice(Kp,Lc));
End;
End;
End;
End;

begin
  Ki; Kocka:= True;
  Vetites;
  Forgatas;
end;

procedure TfmTer.Timer1Timer(Sender: TObject);
begin
If Kocka Then miKockaClick(Sender);
end;

procedure TfmTer.btPAlClick(Sender: TObject);
begin
  Inc(Al);
  btPAl.Caption:='+Al='+IntToStr(Al);
  btMAl.Caption:='-Al='+IntToStr(Al);
end;

procedure TfmTer.btPBeClick(Sender: TObject);
begin
  Inc(Be);
  btPBe.Caption:='+Be='+IntToStr(Be);
  btMBe.Caption:='-Be='+IntToStr(Be);
end;

procedure TfmTer.btPGaClick(Sender: TObject);
begin
  Inc(Ga);
btPGa.Caption:='+Ga='+IntToStr(Ga);
  btMGa.Caption:='-Ga='+IntToStr(Ga);
end;

procedure TfmTer.btMAlClick(Sender: TObject);
begin
  Dec(Al);
  btPAl.Caption:='+Al='+IntToStr(Al);
  btMAl.Caption:='-Al='+IntToStr(Al);
end;

procedure TfmTer.btMBeClick(Sender: TObject);
begin
  Dec(Be);
  btPBe.Caption:='+Be='+IntToStr(Be);
  btMBe.Caption:='-Be='+IntToStr(Be);
end;

procedure TfmTer.btMGaClick(Sender: TObject);
begin
 Dec(GA);
  btPGa.Caption:='+Ga='+IntToStr(Ga);
  btMGa.Caption:='-Ga='+IntToStr(Ga);
end;

end.