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.