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.

Rezgések

Ha kifeszített húrt, vagy egyik végén rögzített pálcát megpendítünk, akkor rajtuk állóhullámok jönnek létre, és hangot adnak.

Ha húrt pendítünk meg, akkor az állóhullámoknak a húr mindkét végén csomópontja van, ugyanis ezek rögzítve vannak, nem tudnak elmozdulni. A kialakuló állóhullámok hullámhossza csak olyan lehet, hogy a húr hossza a fél-hullámhossznak egész számú többszöröse. Ha egyik végén rögzített pálcát pendítünk meg, akkor a húr hossza a kialakuló állóhullámok negyed-hullámhosszának páratlanszám többszöröse (a rögzített végen csomópont, a szabad végnél duzzadási hely van).

Ez a program a most leírt jelenségeket demonstrálja. A húrt illetve a rudat kis átmérőjű fillezett körök alkotják, melyek mint objektumok önálló, de egymással összehangolt, rögzített amplitúdójú rezgőmozgást végeznek, ezzel együttes hatásukban, a húr illetve a rúd rezgését szimulálják. Nyomógombok segítségével a frekvenciát növelhetjük, illetve csökkenthetjük, valamint egy radiogroup segítségével a jobb oldalon, a rögzített, illetve szabad vég között választhatunk.

Egy húr rezgésének a maximális kitéréshez közeli állapota, amikor a fél-hullámhossznak az ötszöröse a húr hossza:

Egy rúd rezgésének a maximális kitéréshez közeli állapota, amikor a negyed-hullámhossznak a tizenegyszerese a húr hossza:

A program listája:

unit URezgesek;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

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

type
  TfmRezgesek = class(TForm)
    lbRezgesek: TLabel;
    tiIdozito: TTimer;
    btKilepes: TButton;
    btFrekiInc: TButton;
    btFrekiDec: TButton;
    rgVeg: TRadioGroup;
Procedure AtomInit;
procedure FormCreate(Sender: TObject);
procedure tiIdozitoTimer(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure btFrekiIncClick(Sender: TObject);
procedure btFrekiDecClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

  TAtom = Class
    Fc, Fh: TColor;
    Fa, Fx, Fy: Integer;
    Fw, Fsz: Real;
Procedure Init(Ic,Ih: TColor; Ia,Ix,Iy: Integer; Iw,Isz: Real);
Procedure Show;
Procedure Hide;
Procedure Move;
Private
       Ft: LongInt;
End;

Const Max=600;
      Am=160;
      R=3;

var
  fmRezgesek: TfmRezgesek;
  Xk,Yk: Integer;
  AT: Array[1..Max] Of TAtom;
  Fr, Sz: Word;

implementation

{$R *.dfm}

Procedure TAtom.Init(Ic,Ih: TColor; Ia,Ix,Iy: Integer; Iw,Isz: Real);
Begin
  Fc:= Ic; Fh:= Ih;
  Fa:= Ia; Fx:= Ix; Fy:= Iy;
  Fw:= Iw; Fsz:= Isz;
  Ft:= 0;
End;

Procedure TAtom.Show;
Begin
With fmRezgesek.Canvas Do
Begin
    Brush.Color:= Fc;
    Pen.Color:= Fc;
If R>0 Then
    Ellipse(Fx-R,Fy-R,Fx+R,Fy+R) Else
    Pixels[Fx,Fy]:= Fc;
End;
End;

Procedure TAtom.Hide;
Begin
With fmRezgesek.Canvas Do
Begin
    Brush.Color:= Fh;
    Pen.Color:= Fh;
If R>0 Then
    Ellipse(Fx-R,Fy-R,Fx+R,Fy+R) Else
    Pixels[Fx,Fy]:= Fh;
End;
End;

Procedure TAtom.Move;
Begin
  Hide;
  Inc(Ft);
  Fy:= Yk+Round(Fa*Sin(Fw*Ft));
  Show;
End;

Procedure TfmRezgesek.AtomInit;
Var I: Word;
Begin
With Canvas Do
Begin
    Brush.Color:= clBtnFace;
    Pen.Color:= clBtnFace;
    Rectangle(Xk-Max Div 2-10,0, Xk+Max Div 2+10,Yk+Am+10);
With Font Do
Begin
      Color:= clBlue;
      Size:= 20;
End;
    TextOut(Xk,20,FloatToStr(Fr*0.5));
End;
  Sz:= 1+rgVeg.ItemIndex;
For I:= 1 To Max Do
  AT[I].Init(clBlue,clBtnFace,
           Round(Am*Sin(I*Pi/(Sz*600/Fr))),
           Xk-(Max Div 2)+I,Yk,
           0.04,I);
End;

procedure TfmRezgesek.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmRezgesek.FormPaint(Sender: TObject);
begin
With Canvas Do
Begin
With Font Do
Begin
      Color:= clBlue;
      Size:= 20;
End;
    TextOut(Xk,20,FloatToStr(Fr*0.5))
End;
end;

procedure TfmRezgesek.FormCreate(Sender: TObject);
Var I: Word;
begin
  rgVeg.ItemIndex:= 0;
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
For I:= 1 To Max Do AT[I]:= TAtom.Create;
  Fr:= 1;
  AtomInit;
end;

procedure TfmRezgesek.btFrekiIncClick(Sender: TObject);
begin
  Inc(Fr);
If (rgVeg.ItemIndex=1) And Not Odd(Fr) Then Inc(Fr); AtomInit;
end;

procedure TfmRezgesek.btFrekiDecClick(Sender: TObject);
begin
If Fr>1 Then
Begin
    Dec(Fr);
    AtomInit;
If (rgVeg.ItemIndex=1) And Odd(Fr) Then Dec(Fr);
End;
end;

procedure TfmRezgesek.tiIdozitoTimer(Sender: TObject);
Var I: Word;
begin
For I:= 1 To Max Do AT[I].Move;
end;

end.

Lissajous görbék

Ha két egymásra merőleges tengelyű, transzverzális sinusos rezgés interferál, az eredő a két rezgőmozgás relatív fázisának és frekvenciájának megfelelően változik. Ha például a két rezgés frekvenciája azonos és fáziskülönbségük nulla vagy 180 fok, akkor az eredő rengés lineáris, ha a fáziskülönbség ettől eltérő, akkor ellipszis, egyenlő amplitúdó és 90 fok eltérés esetén kör mentén játszódik le a rezgés. Ha a két frekvencia nem azonos, akkor a rezgés a két frekvencia arányától függő, bonyolultabb ábrákat, Lissayou görbéket kapunk. Ha a fáziskülönbségeket kis mértékben folyamatosan változtatjuk, akkor a keletkezett rezgés is folyamatosan változik.

Ez a program az utóbb leírt, folyamatosan átalakuló Lissayou görbéket szemlélteti. A listába belejavítva, a paraméterek változtatható (amplitúdó, fázisugrás). Futás közben az alap frekvenciaarányok négy nyomógomb segítségével, egyesével változtathatók. A folyamatos megjelenést időzítőre bíztam, melynek a kapcsolási intervalluma 1 ezred. A program 30000 ponttal rajzolja a görbéket, mely szám lassúbb gépeknél csökkenthető.

A következő két futási képen a két frekvenciának az aránya 6:5. Az első képen a fáziskülönbség 90 foknak egész számú többszöröse, a második egy ettől kicsit eltérő (röviddel az előző után létrejövő) fáziskülönbségű állapotot mutat.

A program listája:

unit ULissayou;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

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

type
  TfmLissayou = class(TForm)
    lbLissayou: TLabel;
    btKilepes: TButton;
    tiIdozito: TTimer;
    btIncM: TButton;
    btDecM: TButton;
    btIncN: TButton;
    btDecN: TButton;
Procedure KiirMN;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure tiIdozitoTimer(Sender: TObject);
procedure btIncMClick(Sender: TObject);
procedure btDecMClick(Sender: TObject);
procedure btIncNClick(Sender: TObject);
procedure btDecNClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Type TPont= Class
       Fc, Fh: TColor;
       Fa, Fx, Fy: Integer;
       Fw, Fsz: Real;
Procedure Init(Ic,Ih: TColor; Ia,Ix,Iy: Integer; Iw,Isz: Real);
Procedure Show;
Procedure Hide;
Procedure Move;
Private
         Ft: Real;
End;

Const Max=30000;
      Am=240;
      D=0.55;

var
  fmLissayou: TfmLissayou;
  Xk,Yk: Integer;
  PT: Array[1..Max] Of TPont;
  M, N: Word;

implementation

{$R *.dfm}

Procedure TPont.Init(Ic,Ih: TColor; Ia,Ix,Iy: Integer; Iw,Isz: Real);
Begin
  Fc:= Ic; Fh:= Ih;
  Fa:= Ia; Fx:= Ix; Fy:= Iy;
  Fw:= Iw; Fsz:= Isz;
  Ft:= 0;
End;

Procedure TPont.Show;
Begin
  fmLissayou.Canvas.Pixels[Fx,Fy]:= Fc;
End;

Procedure TPont.Hide;
Begin
  fmLissayou.Canvas.Pixels[Fx,Fy]:= Fh;
End;

Procedure TPont.Move;
Begin
  Hide;
  Ft:= Ft+0.05;
  Fx:= Xk+Round(Fa*Sin(Fw*Ft+M*Fsz));
  Fy:= Yk+Round(Fa*Cos(Fw*Ft+N*Fsz+D*Ft));
  Show;
End;

Procedure TfmLissayou.KiirMN;
Begin
With Canvas Do
Begin
    Brush.Color:= clBtnFace;
    Pen.Color:= clBtnFace;
    Rectangle(Xk-20,10,Xk+80,40);
    Rectangle(Xk+280,Yk,Xk+380,Yk+30);
With Font Do
Begin
      Size:= 20;
      Color:= clBlue;
End;
    TextOut(Xk-20,10,'N: '+IntToStr(N));
    TextOut(Xk+280,Yk,'M: '+IntToStr(M));
End;
End;

procedure TfmLissayou.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmLissayou.FormCreate(Sender: TObject);
Var I: Word;
begin
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
  M:= 1; N:= 2;
For I:= 1 To Max Do
Begin
    PT[I]:= TPont.Create;
    PT[I].Init(clBlue,clBtnFace, Am, Xk,Yk, 1, 0.04*I);
End;
end;

procedure TfmLissayou.tiIdozitoTimer(Sender: TObject);
Var I: Word;
begin
  KiirMN;
For I:= 1 To Max Do PT[I].Move;
end;

procedure TfmLissayou.btIncMClick(Sender: TObject);
begin
  Inc(M);
end;

procedure TfmLissayou.btDecMClick(Sender: TObject);
begin
If M>0 Then Dec(M);
end;

procedure TfmLissayou.btIncNClick(Sender: TObject);
begin
  Inc(N);
end;

procedure TfmLissayou.btDecNClick(Sender: TObject);
begin
If N>0 Then Dec(N);
end;

end.

Atomi mozgások

Az anyag atomjai, molekulái termikus mozgást végeznek. Szilárd testekben egy hely közelében térbeli rezgőmozgás, folyadékokban és gázokban helyváltoztató mozgás figyelhető meg. Folyadékban és gázokban a részecskék mozgására a Brown mozgás létéből következtethetünk, ahol a részecskék az anyagban lebegő makroszkopikus részecskéknek ütközve, azokat rendszertelen, zegzugos mozgásra kényszerítik. Ez a jelenség annál intenzívebb, minél magasabb az anyag hőmérséklete. A helyváltoztató mozgás közben egymással is ütköznek, a mozgás kaotikus lesz.

Ez a program az ütközés mellett, néhány, a termikus mozgás következtében létrejövő makroszkopikus jelenséget modellez úgy, hogy az anyag alkotó elemeit látható mértékig növeli, számát viszont kezelhető számosságra csökkenti. A program futási képe animáció nélkül:

Az animációk a nyomógombokkal indíthatók. Az elindított animációt az újabb animáció leállítja, de csak leállítást elérhetünk a Stop nyomógombbal is.

Két egymástól különböző tömegű részecske ütközésekor az egymásnak okozott lendületváltozások a részecskék tömegével arányos. Az animáció automatikusan akkor is leáll, ha a részecskék elhagyják a képernyőt.

Kiterjedés: a kezdetben nagyon kis helyre lokalizált részecske a hő-mozgás következtében egyre nagyobb teret foglal el, végső soron mintegy gázfelhő, egyenletesen kitölti a rendelkezésre álló teret.

Keveredés: helyezkedjen el egymáshoz közel két nagyszámú, de különböző részecskékből (kék és piros) álló anyaghalmaz. Ha megengedett a hő-mozgás miatti kapcsolatuk (nincs elválasztó fal köztük), akkor egy bizonyos idő elteltével a részecskék teljesen összekeverednek. A kezdet:

Rövid idő múlva:

A párolgás: az edényben, kezdetben 820 részecske található. A hő-mozgás következtében a folyadék felszínén részecskék távoznak. Mindig az, amelyik elég közel kerül a felülethez, és a mozgás következtében az új helye a folyadékfelszín fölött lenne. A folyamatot lényegesen gyorsíthatjuk a hőmérséklet növelésével, melyet a T+ feliratú nyomógomb segítségével érhetünk el (a T- nyomógomb a hőmérsékletet csökkenti). A kezdet:

Melegítéssel gyorsítva a folyamatot:

Az ozmózis: az ozmózis jelenségét egy féligáteresztő hártya két oldalán elhelyezkedő folyadék keveredésével mutatjuk be. A féligáteresztő hártya például a kék színű részecskéket nem engedi át, a pirosakat pedig igen. Ennek hatására a baloldali tartályba a jobboldaliból piros részecskék diffundálnak át, és ennek következtében a kezdetben egyenlő nyomásérték megváltozik, a baloldaliban növekszik, a jobboldaliban csökken. A nyomáskülönbséget ozmózisnyomásnak nevezzük. Például, ha egy meggyet, vagy szilvát vízbe helyezünk, akkor a víz molekulái áthatolnak a gyümölcs féligáteresztő héján, és végül az ozmózisnyomás a gyümölcsöket szétrepeszti. Az állapot a folyamat elején:

Majd a melegítés hatására, egy bizonyos idő múlva, a következőt láthatjuk:

Áramlás: az utolsó animáció egy csőben történő áramlást szemlélteti. A futási kép, amikor a gázfelhő a cső közepén jár:

A program listája:

unit UAtomok;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

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

type
  TfmAtomok = class(TForm)
    btUtkozes: TButton;
    btKilepes: TButton;
    tiIdozito: TTimer;
    btStop: TButton;
    btKiterjedes: TButton;
    btKeveredes: TButton;
    btParolgas: TButton;
    btTP: TButton;
    btTM: TButton;
    btOzmozis: TButton;
    btAramlas: TButton;
    lbAtom: TLabel;
procedure btUtkozesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure tiIdozitoTimer(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure btKiterjedesClick(Sender: TObject);
procedure btKeveredesClick(Sender: TObject);
procedure btParolgasClick(Sender: TObject);
procedure btTPClick(Sender: TObject);
procedure btTMClick(Sender: TObject);
procedure btOzmozisClick(Sender: TObject);
procedure btAramlasClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

  TAtom= Object
    Fr: Byte;
    Fc: TColor;
Procedure Init(Ir: Byte; Ic: TColor);
Procedure SetXY(X, Y: Integer);
Procedure SetV(Vx, Vy: Integer);
Procedure Show;
Procedure Hide;
Procedure MozogXY(X, Y: Integer);
Procedure MozogRel(Dx, Dy: Integer);
Procedure MozogBent(Bx, By, Jx, Jy, Dx, Dy, Tip: Integer);
Procedure MozogSeb;
Function GetX: Integer;
Function GetY: Integer;
Function GetVx: Integer;
Function GetVy: Integer;
Private Fx, Fy, FVx, FVy: Integer;
End;

Const M= 1000;

var
  fmAtomok: TfmAtomok;
  Xk, Yk, Xm, Ym: Integer;
  Tip: Byte;
  A, B: TAtom;
  Ra, Rb: Integer;
  Sx, Sy: Integer;
  At, Bt: Array[1..M] Of TAtom;
  Bx, By, Jx, Jy: Integer;
  K, L, P, Q, Dx, Dy, T, D: Longint;

implementation

{$R *.dfm}

procedure TfmAtomok.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmAtomok.FormCreate(Sender: TObject);
begin
  Xm:= ClientWidth; Xk:= Xm Div 2;
  Ym:= ClientHeight; Yk:= Ym Div 2;
  Tip:= 0;
  Randomize;
end;

Procedure TAtom.Init(Ir: Byte; Ic: TColor);
Begin
  Fr:= Ir; Fc:= Ic; Fx:= -Fr; Fy:= -Fr;
End;

Procedure TAtom.SetXY(X, Y: Integer);
Begin
  Fx:= X; Fy:= Y;
End;

Procedure TAtom.SetV(Vx, Vy: Integer);
Begin
  FVx:= Vx; FVy:= Vy;
End;

Procedure TAtom.Show;
Begin
With fmAtomok.Canvas Do
Begin
    Pen.Color:= Fc;
    Brush.Color:= Fc;
    Ellipse(Fx-Fr,Fy-Fr, Fx+Fr,Fy+Fr);
End;
End;

Procedure TAtom.Hide;
Begin
With fmAtomok.Canvas Do
Begin
    Pen.Color:= clBtnFace;
    Brush.Color:= clBtnFace;
    Ellipse(Fx-Fr,Fy-Fr, Fx+Fr,Fy+Fr);
End;
End;

Procedure TAtom.MozogXY(X, Y: Integer);
Begin
  Hide; SetXY(X, Y); Show;
End;

Procedure TAtom.MozogRel(Dx, Dy: Integer);
Begin
  Hide; SetXY(GetX + Dx, GetY + Dy); Show;
End;

Procedure TAtom.MozogBent(Bx, By, Jx, Jy, Dx, Dy, Tip: Integer);
Begin
  Hide;
Case Tip Of
    1: Begin {fent}
If (GetX+Dx<=Bx+1) Or (GetX+Dx>=Jx-1) Then Dx:= -Dx;
If (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
    2: Begin {jobbra}
If (GetX+Dx<=Bx+1) Then Dx:= -Dx;
If (GetY+DY<=BY+1) Or (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
    3: Begin {le}
If (GetX+Dx<=Bx+1) Or (GetX+Dx>=Jx-1) Then Dx:= -Dx;
If (GetY+DY<=BY+1) Then Dy:= -Dy;
End;
    4: Begin {balra}
If (GetX+Dx>=Jx-1) Then Dx:= -Dx;
If (GetY+DY<=BY+1) Or (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
    5: Begin {fel-le}
If (GetX+Dx<=Bx+1) Or (GetX+Dx>=Jx-1) Then Dx:= -Dx;
End;
    6: Begin {jobbra-balra}
If (GetY+DY<=BY+1) Or (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
    7: Begin {fel-jobbra}
If (GetX+Dx<=Bx+1) Then Dx:= -Dx;
If (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
    8: Begin {le-balra}
If (GetX+Dx>=Jx-1) Then Dx:= -Dx;
If (GetY+DY<=BY+1) Then Dy:= -Dy;
End;
    9: Begin {fel-balra}
If (GetX+Dx<=Bx+1) Then Dx:= -Dx;
If (GetY+DY<=BY+1) Then Dy:= -Dy;
End;
    10: Begin {le-jobbra}
If (GetX+Dx>=Jx-1) Then Dx:= -Dx;
If (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
    11: Begin {z rt}
If (GetX+Dx<=Bx+1) Or (GetX+Dx>=Jx-1) Then Dx:= -Dx;
If (GetY+DY<=BY+1) Or (GetY+Dy>=Jy-1) Then Dy:= -Dy;
End;
End;
  MozogRel(Dx, Dy);
  Show;
End;

Procedure TAtom.MozogSeb;
Begin
  Hide; SetXY(GetX + FVx, GetY + FVy); Show;
End;

Function TAtom.GetX: Integer;
Begin
  GetX:= Fx;
End;

Function TAtom.GetY: Integer;
Begin
  GetY:= Fy;
End;

Function TAtom.GetVx: Integer;
Begin
  GetVx:= FVx;
End;

Function TAtom.GetVy: Integer;
Begin
  GetVy:= FVy;
End;

procedure TfmAtomok.btUtkozesClick(Sender: TObject);
begin
  btStopClick(Sender);
  Ra:= 25; Rb:= 10;
With A Do Begin Init(Ra, clBlue); SetXY( 0,0); SetV( 3,2); Show End;
With B Do Begin Init(Rb, ClRed); SetXY(Xk,0); SetV(-2,2); Show End;
  Tip:= 1;
end;

procedure TfmAtomok.btKiterjedesClick(Sender: TObject);
Var I: Word;
begin
  btStopClick(Sender);
For I:= 1 To M Do With At[I] Do
Begin Init(1,clRed); SetXY(Xk,Yk); Show End;
  Tip:= 2;
end;

procedure TfmAtomok.btKeveredesClick(Sender: TObject);
Var I: Word;
begin
  btStopClick(Sender);
For I:= 1 To M Do With At[I] Do
Begin Init(1,clBlue); SetXY(Xk-20,Yk); Show End;
For I:= 1 To M Do With Bt[I] Do
Begin Init(1,clRed); SetXY(Xk+20,Yk); Show End;
  Tip:= 3;
end;

procedure TfmAtomok.btParolgasClick(Sender: TObject);
Var I, J: Word;
begin
  btStopClick(Sender);
  Bx:= Round(0.3*Xm); By:= Yk;
  Jx:= Round(0.7*Xm); Jy:= Round(0.8*Ym);
With Canvas Do
Begin
With Pen Do
Begin
      Color:= clWhite;
      Width:= 3;
End;
    MoveTo(Bx, Round(0.4*Ym)); LineTo(Bx, Jy);
    LineTo(Jx, Jy); LineTo(Jx, Round(0.4*Ym));
    Pen.Color:= clBlue;
    MoveTo(Bx+1, By); LineTo(Jx-1, By);
End;
  K:= Jx - Bx - 2; L:= Jy - By - 2;
  P:= Round(Sqrt(K*M/L))-3; Q:= Round(Sqrt(L*M/K))-3;
  Dx:= Round(K/P); Dy:= Round(L/Q);
For J:= 1 To Q Do For I:= 1 To P Do With At[(J-1)*P+I] Do
Begin Init(1,clBlue); SetXY(Bx+(I-1)*Dx+4, By+(J-1)*Dy+4); Show End;
  T:= 3;
  Tip:= 4;
end;

procedure TfmAtomok.btOzmozisClick(Sender: TObject);
Var I, J: Word;
begin
  btStopClick(Sender);
  Bx:= Round(0.2*Xm); By:= Round(0.25*Ym);
  Jx:= Round(0.8*Xm); Jy:= Round(0.75*Ym);
With Canvas Do
Begin
With Pen Do
Begin
      Color:= clWhite;
      Width:= 3;
End;
    Brush.Color:= clBtnFace;
    Rectangle(Bx,By, Jx,Jy);
    MoveTo(Xk, By+1); LineTo(Xk, Jy-1);
End;
  K:= (Jx - Bx) Div 2 - 2; L:= Jy - By - 2;
  P:= Round(Sqrt(K*M/L))-2; Q:= Round(Sqrt(L*M/K))-2;
  Dx:= Round(K/P); Dy:= Round(L/Q);
For J:= 1 To Q Do For I:= 1 To P Do With At[(J-1)*P+I] Do
Begin Init(1,clBlue); SetXY(Bx+(I-1)*Dx+6, By+(J-1)*Dy+6); Show End;
For J:= 1 To Q Do For I:= 1 To P Do With Bt[(J-1)*P+I] Do
Begin Init(1,clRed); SetXY(Xk+(I-1)*Dx+6, By+(J-1)*Dy+6); Show End;
  T:= 3;
  Tip:= 5;
end;

procedure TfmAtomok.btAramlasClick(Sender: TObject);
Var I: Word;
begin
  btStopClick(Sender);
  D:= 20;
With Canvas Do
Begin
With Pen Do
Begin
      Color:= clBlack;
      Width:= 1;
End;
    MoveTo(0,Yk-D); LineTo(Xm,Yk-D); MoveTo(0,Yk+D); LineTo(Xm,Yk+D);
End;
For I:= 1 To M Do With At[I] Do
Begin Init(1,clBlue); SetXY(0,Yk); Show End;
  T:= 3;
  Tip:= 6;
end;

procedure TfmAtomok.btTPClick(Sender: TObject);
begin
  Inc(T,2);
end;

procedure TfmAtomok.btTMClick(Sender: TObject);
begin
If T>4 Then Dec(T,2);
end;

procedure TfmAtomok.tiIdozitoTimer(Sender: TObject);
Var I, S, Sa, Sb: Word;
begin
Case Tip Of
    1: Begin
If B.GetX-A.GetX<= Ra+Rb Then
Begin
           Sx:= Round(2*(Ra*Ra*A.GetVx+Rb*Rb*B.GetVx)/(Ra*Ra+Rb*Rb));
           Sy:= Round(2*(Ra*Ra*A.GetVy+Rb*Rb*B.GetVy)/(Ra*Ra+Rb*Rb));
           A.SetV(Sx-A.GetVx, Sy-A.GetVy);
           B.SetV(Sx-B.GetVx, Sy-B.GetVy)
End;
         A.MozogSeb; B.MozogSeb;
If (A.GetX>2*Xk) And (A.GetY>2*Yk) And
            (B.GetX>2*Xk) And (B.GetY>2*Yk) Then btStopClick(Sender);
End;
    2: For I:= 1 To M Do At[I].MozogRel(Random(5)-2, Random(5)-2);
    3: For I:= 1 To M Do
Begin
           At[I].MozogRel(Random(5)-2, Random(5)-2);
           Bt[I].MozogRel(Random(5)-2, Random(5)-2);
End;
    4: Begin
         S:= 0;
For I:= 1 To Q*P Do With AT[I] Do
Begin
If GetY>By Then
Begin
             Inc(S);
             MozogBent(Bx+2, By+2, Jx-2, Jy-2,
                       Random(T)-(T Div 2),Random(T)-(T Div 2),1);
End Else Hide;
With Canvas Do
Begin
             Pen.Color:= clBlue;
             MoveTo(Bx+1, By); LineTo(Jx-1, By);
End;
End;
With Canvas Do
Begin
           Pen.Color:= clBlue;
           Brush.Color:= clBtnFace;
           Font.Size:= 24;
           TextOut(Xk-20,50,IntToStr(S)+'/'+IntToStr(T)+'     ');
End;
End;
    5: Begin
         Sa:= 0; Sb:= 0;
For I:= 1 To Q*P Do With AT[I] Do
Begin
           Inc(Sa);
           MozogBent(Bx+2, By+2, Xk-2, Jy-2,
                     Random(T)-(T Div 2), Random(T)-(T Div 2),11);
End;
For I:= 1 To Q*P Do With BT[I] Do
Begin
If GetX<Xk Then Inc(Sa) Else Inc(Sb);
           MozogBent(Bx+2, By+2, Jx-2, Jy-2,
                     Random(T)-(T Div 2), Random(T)-(T Div 2),11);
End;
With Canvas Do
Begin
           Pen.Color:= clBlue;
           MoveTo(Xk,By+1); LineTo(Xk,Jy-1);
           Font.Size:= 24;
           Brush.Color:= clBtnFace;
           TextOut(Xk Div 2-20,50,IntToStr(Sa)+'    ');
           TextOut(Xk, 50, IntToStr(T)+'    ');
           TextOut(Xk+Xk Div 2-20,50,IntToStr(Sb)+'    ');
End;
End;
    6: For I:= 1 To M Do
       At[I].MozogBent(0,Yk-D, Xm,Yk+D,
                       Random(T)-(T Div 2)+1, Random(T)-(T Div 2),6);
End;
end;

procedure TfmAtomok.btStopClick(Sender: TObject);
Var I: Word;
begin
  A.Hide; B.Hide;
For I:= 1 To M Do Begin At[I].Hide; Bt[I].Hide End;
  Canvas.Rectangle(0,0,Xm,Ym);
  Tip:= 0;
  lbAtom.Repaint;
end;

end.