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, Lissajous 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ó Lissajous 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 harmadiknál az arány 10:7.

A program listája:

unit ULissajous;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

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

type
TfmLissajous = class(TForm)
lbLissajous: 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
fmLissajous: TfmLissajous;
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
fmLissajous.Canvas.Pixels[Fx,Fy]:= Fc;
End;

Procedure TPont.Hide;
Begin
fmLissajous.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 TfmLissajous.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 TfmLissajous.btKilepesClick(Sender: TObject);
begin
Close;
end;

procedure TfmLissajous.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 TfmLissajous.tiIdozitoTimer(Sender: TObject);
Var I: Word;
begin
KiirMN;
For I:= 1 To Max Do PT[I].Move;
end;

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

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

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

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

end.