リサジュー図形

　リサジュー図形は、図形のｘ軸ｙ軸に、それぞれ単振動の値を入力して得られる図形です。

ｘ＝Ａｃｏｓ（αｔ），ｙ＝Ｂｓｉｎ（βｔ＋δ)

　プログラムは、正弦波と三角波になっていますが、他の波形でも、それなりの図形が得られます。
プログラム上のＸ係数、Ｙ係数は単振動ｘ＝Ａｃｏｓ（αｔ），ｙ＝Ｂｓｉｎ（βｔ＋δ)のαとβの値を表しています、又、ｃｏｓ、ｓｉｎの関係は単に位相が９０度に成っているだけなので、δの値により同じ図形が得られます。
Ａ及びＢの値は１に固定です、δの値は、動画として表示している間に少しずつ　0～2π　の間で変化します。
αとβの入力(X,Y)は、整数入力になっており、作図される図形は最小公倍数の値として表示されるので、４，６は２，３と同じです。

プログラム

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Button2: TButton;
    Timer1: TTimer;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    procedure ImgeClear;
    procedure xyPlot_Line(xd, yd : double; MF: boolean);
    function input(var bcos, bsin: integer) : boolean;
    function triangle_wave(t, qt, ft: integer): double;
    procedure Lissajous_curve(bcos, bsin, Q: integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// イメージクリア
procedure TForm1.ImgeClear;
var
  Rect : TRect;
begin
  Rect.Top := 0;
  Rect.Left := 0;
  Rect.Right := image1.Width;
  Rect.Bottom := image1.Height;
  image1.Canvas.Brush.Color := clWhite;
  image1.Canvas.Brush.Style := bsSolid;
  Image1.Canvas.FillRect(Rect);
end;

// xd, yd  x, y座標
// MF  true Lineto false  moveto
procedure TForm1.xyPlot_Line(xd, yd : double; MF: boolean);
var
  x, y: integer;
  xc, yc: integer;
  ps: double;
begin
  xc := image1.Width div 2;
  yc := image1.Height div 2;
  if xc < yc then ps := xc / 1.5 else ps := yc / 1.5;
  x := round(xd * ps) + xc;
  y := yc - round(yd * ps);
  if MF then image1.Canvas.LineTo(x, y)
        else image1.Canvas.MoveTo(x, y);
end;

// 三角波発生
// t 位置
// qt  ピーク位置
// ft  一周期長さ
// result  -1～+1
function TForm1.triangle_wave(t, qt, ft: integer): double;
var
  n : integer;
begin
  result := 0;
  t := t mod ft;
  n := t div qt;
  case n of
    0 : result := t / qt;
    1 : result := (qt + qt - t) / qt;
    2 : result := - (t - qt - qt) / qt;
    3 : result := - (qt + qt + qt + qt - t) / qt
  end;
end;

const
  Period = 720;            // 周期

var
  bcos, bsin, Q: integer;  // bcos x軸波形数  bsin y軸波形数
                           // Q 周期に対する位相

// bcos, bsin  角度倍数(作図時サイクル数)
// Q  sin側位相角
procedure TForm1.Lissajous_curve(bcos, bsin, Q: integer);
var
  i, qt : integer;
  x, y, t, dt, sq :double;
begin
  ImgeClear;
  qt := Period div 4;
  dt := pi / Period * 2;
  sq := pi / 180 * Q;      // 位相角 rad
  x := 0;
  y := 0;
  // 始点移動
  case radiogroup1.ItemIndex of
    0: x := cos(0);
    1: x := triangle_wave(0, qt, Period);
  end;
  case radiogroup2.ItemIndex of
    0: y := sin(sq);
    1: y := triangle_wave(Q, qt, Period);
  end;
  xyPlot_Line(x, y, false);
  // 一周期作図
  for i := 1 to Period do begin
    t := dt * i;
    case radiogroup1.ItemIndex of
      0: x := cos(bcos * t);
      1: x := triangle_wave(bcos * i, qt, Period);
    end;
    case radiogroup2.ItemIndex of
      0: y := sin(bsin * t + sq);
      1: y := triangle_wave(bsin * i + Q, qt, Period);
    end;
    xyPlot_Line(x, y, true);
  end;
end;

// タイマーループ
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Lissajous_curve(bcos, bsin, Q);
  inc(Q);
  if Q >= Period then Q := 0;
end;

// 入力処理
function TForm1.input(var bcos, bsin: integer) : boolean;
var
  ch : integer;
begin
  result := false;
  val(labelededit1.Text, bcos, ch);
  if ch <> 0 then begin
    application.MessageBox('cos係数に間違いがあります。','注意',0);
    exit;
  end;
  val(labelededit2.Text, bsin, ch);
  if ch <> 0 then begin
    application.MessageBox('sin係数に間違いがあります。','注意',0);
    exit;
  end;
  result := true;
end;

// 動画 strat
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not input(bcos, bsin) then exit;
  timer1.Enabled := true;
end;

// 動画停止
procedure TForm1.Button2Click(Sender: TObject);
begin
  timer1.Enabled := false;
end;

// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
begin
  timer1.Enabled := false;
  timer1.Interval := 30;
  Q := 0;
  ImgeClear;
  image1.Canvas.Pen.Color := clRed;
  image1.Canvas.Pen.Width := 2;
end;

end.

Lissajous_figure.zip

　　画像処理プログラム　作図　に戻る