//www.algorytm.org
//krzywe cykliczne by Tomasz Lubinski (C)2002
unit kc;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, ToolWin, ComCtrls, ActnList, StdActns,
  ExtDlgs;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button2: TButton;
    Button3: TButton;
    Shape1: TShape;
    Timer1: TTimer;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ScrollBar3: TScrollBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SaveDialog1: TSaveDialog;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    procedure Edit1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ScrollBar3Change(Sender: TObject);
    procedure ScrollBar2Change(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  watek = class(TThread)
  private
  protected
    procedure Execute; override;
    procedure Rysowanie;
  end;

var
  Form1: TForm1;
  r, r_toru, m, predkosc, gestosc, x, y, x1, y1, wsp, znak: Integer;
  i: Real;
  okrag1,okrag2,odcinek: TColor;
  rys, tmp: TBitMap;
  w: TThread;

implementation

uses opcje;

{$R *.DFM}

//początkowe ustawienie wszystkich wartosci
procedure TForm1.FormCreate(Sender: TObject);
begin
okrag1:=clRed; okrag2:=clBlue;
odcinek:=clGreen;
gestosc:=50;  predkosc:=100;
rys:=TBitMap.Create;
rys.Height:=400; rys.Width:=400;
tmp:=TBitMap.Create;
tmp.Height:=400; tmp.Width:=400;
wsp:=60; znak:=+1;
tmp.Canvas.Brush.Style:= bsClear; //bez wypelnienia
Timer1.Enabled:=True;
end;

//funkcja wywolywana podczas zmiany danych w paramtetrach podstawowych
procedure TForm1.Edit1Change(Sender: TObject);
begin
i:=0;
Timer1Timer(Form1);
end;

//rysowanie podstawowe (dwa okręgi i odcinek wodzacy i dotychczasowa krzywa)
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Edit1.Text<>'' then r:=StrToInt(Edit1.text);
if Edit2.Text<>'' then r_toru:=StrToInt(Edit2.text);
if Edit2.Text<>'' then m:=StrToInt(Edit3.text);
if RadioButton1.checked then
        begin               //hipotrochoida
        wsp:=r_toru-r;
        znak:=+1;
        end
else
        begin               //epitrochoida
        wsp:=r_toru+r;
        znak:=-1;
        end;
x:=trunc(wsp*cos(i)+znak*m*cos(wsp*(i/r)));    //oblicz wspolrzedne
y:=trunc(wsp*sin(i)-m*sin(wsp*(i/r)));
x1:=trunc(wsp*cos(i));
y1:=trunc(wsp*sin(i));
tmp.Canvas.Draw(0,0,rys);         //dotychczasowa krzywa
tmp.Canvas.Pen.Color:=okrag2;
tmp.Canvas.Ellipse(x1+200-r,y1+r+200,x1+r+200,y1-r+200);
tmp.Canvas.Pen.Color:=okrag1;
tmp.Canvas.Ellipse(200-r_toru,200+r_toru,200+r_toru,200-r_toru);
tmp.Canvas.Pen.Color:= odcinek;
tmp.Canvas.MoveTo(x1+200,y1+200);
tmp.Canvas.LineTo(x+200,y+200);
Form1.Canvas.Draw(175,10,tmp);    //narysuj calosc
Timer1.Enabled:=False;
end;

//watek do rysowania
procedure watek.Rysowanie;
begin
        rys.Canvas.Pen.Color:= odcinek;
        rys.Canvas.MoveTo(x+200,y+200);
        rys.Canvas.LineTo(x+201,y+201);
        tmp.Canvas.Draw(0,0,rys);         //dotychczasowa krzywa
        tmp.Canvas.Pen.Color:=okrag2;
        tmp.Canvas.Ellipse(x1+200-r,y1+r+200,x1+r+200,y1-r+200);
        tmp.Canvas.Pen.Color:=okrag1;
        tmp.Canvas.Ellipse(200-r_toru,200+r_toru,200+r_toru,200-r_toru);
        tmp.Canvas.Pen.Color:= odcinek;
        tmp.Canvas.MoveTo(x1+200,y1+200);
        tmp.Canvas.LineTo(x+200,y+200);
        Form1.Canvas.Draw(175,10,tmp);    //narysuj calosc
end;

//watek do animacji
procedure watek.Execute;
begin
while (true) do
        begin
        i:=i+1/gestosc;
        sleep(Trunc(100/predkosc)); //odczekaj chwile okreslona przez predkosc
        x:=trunc(wsp*cos(i)+znak*m*cos(wsp*(i/r)));  //oblicz wspolrzedne
        y:=trunc(wsp*sin(i)-m*sin(wsp*(i/r)));
        x1:=trunc(wsp*cos(i));
        y1:=trunc(wsp*sin(i));
        Synchronize(Rysowanie);
        end;
end;

//obsluga paskow przewijania
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
Edit1.Text:=IntToStr(ScrollBar1.Position);
end;
procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
Edit2.Text:=IntToStr(ScrollBar2.Position);
end;
procedure TForm1.ScrollBar3Change(Sender: TObject);
begin
Edit3.Text:=IntToStr(ScrollBar3.Position);
end;

//wymazanie obrazu krzywych
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
rys.FreeImage;
rys:=TBitMap.Create;
rys.Height:=400; rys.Width:=400;
Timer1.Enabled:=True;
end;

//zapisanie obrazu krzywych
procedure TForm1.SpeedButton2Click(Sender: TObject);
var f:String;
begin
SaveDialog1.Execute;
f:=SaveDialog1.FileName;
rys.SaveToFile(f);
Timer1.Enabled:=True;
end;

//wywolanie opcji zaawansowanych
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Form2.Visible:=True;
end;

//uruchomienie watku
procedure TForm1.Button2Click(Sender: TObject);
begin
if w=nil then
        begin
        w:=watek.Create(false);
        w.Priority:=tpNormal;
        end;
if w<>nil then if w.Suspended then w:=watek.Create(false);
end;

//odrysowywanie rysunku tylko wowczas gdy watek jest wylaczony
procedure TForm1.FormPaint(Sender: TObject);
begin
if w<>nil then if w.Suspended then Timer1.Enabled:=True;
if w=nil then Timer1.Enabled:=True;
end;

//zatrzymanie watku
procedure TForm1.Button3Click(Sender: TObject);
begin
if w<>nil then w.Suspend;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if w<>nil then w.Suspend;
end;

end.