// verzia 240902

unit KorUnit;

interface

uses
  Classes, Windows, Graphics, ExtCtrls, Messages, SysUtils, Forms;

type
  TKor = class
  private
    FX,FY,FSmer:real;
    FDole:boolean;
    FFP:TColor;
    FHP:integer;
  public
    constructor Create; overload;
    constructor Create(nx,ny:real; uhol:real = 0); overload;
    destructor Destroy; override;

    procedure Dopredu(dlzka:real); virtual;
    procedure Vpravo(uhol:real); virtual;
    procedure Vlavo(uhol:real); virtual;
    procedure ZmenSmer(uhol:real); virtual;
    procedure ZmenXY(nx,ny:real); virtual;
    procedure PresunXY(nx,ny:real); virtual;
    procedure PH; virtual;
    procedure PD; virtual;
    procedure ZmenPero(ndole:boolean); virtual;
    procedure ZmenFP(farba:TColor); virtual;
    procedure ZmenHP(hrubka:integer); virtual;

    procedure Pis(text:string); virtual;
    function  Smerom(nx,ny:real):real; virtual;
    procedure Vypln(farba:TColor); virtual;
    function  Vzd(nx,ny:real):real; virtual;
    function  Blizko(nx,ny:real):boolean; virtual;

    property  X:real read FX;
    property  Y:real read FY;
    property  Smer:real read FSmer write ZmenSmer;
    property  Dole:boolean read FDole write ZmenPero;
    property  FP:TColor read FFP write ZmenFP;
    property  HP:integer read FHP write ZmenHP;
  end;

//////////////////////////////////////////////////////////////////////////////////////////

const
  rad = pi/180;
  deg = 180/pi;

var
  sirka,vyska:integer;

procedure Zmaz(fpoz:TColor = clWhite);
procedure Cakaj(MilliSec:Longint);

procedure ZrusKory;
procedure NastavPlochu(p:TImage);

//////////////////////////////////////////////////////////////////////////////////////////

implementation

uses
  Dialogs;

procedure Inicializuj; forward;

var
  g:TCanvas = nil;
  kory:array of TKor;
  maxkor:integer = -1;

//////////////////////////////////////////////////////////////////////////////////////////

constructor TKor.Create;
begin
  Inicializuj;
  Create(sirka/2,vyska/2);
end;

constructor TKor.Create(nx,ny,uhol:real);
var
  i:integer;
begin
  Inicializuj;
  FX:=nx; FY:=ny; FSmer:=uhol;
  FFP:=clBlack; FHP:=1;
  FDole:=true;
  i:=0; while (i<=maxkor) and (kory[i]<>nil) do inc(i);
  if i>high(kory) then SetLength(kory, Length(kory)+10);
  kory[i]:=self; if i>maxkor then maxkor:=i;
end;

destructor TKor.Destroy;
var
  i:integer;
begin
  i:=0; while (i<=maxkor) and (kory[i]<>self) do inc(i);
  if i<=maxkor then kory[i]:=nil;
  inherited;
end;

procedure TKor.Vpravo(uhol:real);
begin
  ZmenSmer(FSmer+uhol);
end;

procedure TKor.Vlavo(uhol:real);
begin
  ZmenSmer(FSmer-uhol);
end;

procedure TKor.ZmenSmer(uhol:real);
begin
  FSmer:=uhol;
  while FSmer<0 do FSmer:=FSmer+360;
  while FSmer>=360 do FSmer:=FSmer-360;
end;

procedure TKor.Dopredu(dlzka:real);
begin
  ZmenXY(FX+sin(FSmer*rad)*dlzka,FY-cos(FSmer*rad)*dlzka);
end;

procedure TKor.ZmenXY(nx,ny:real);
begin
  if not FDole then PresunXY(nx,ny)
  else begin
    g.Brush.Style:=bsSolid;
    g.Pen.Color:=FFP;
    g.Pen.Width:=FHP;
    g.PolyLine([Point(round(FX),round(FY)),Point(round(nx),round(ny))]);
    FX:=nx; FY:=ny;
  end;
end;

procedure TKor.PresunXY(nx,ny:real);
begin
  FX:=nx; FY:=ny;
  g.MoveTo(round(FX),round(FY));
end;

procedure TKor.PH;
begin
  FDole:=false;
end;

procedure TKor.PD;
begin
  FDole:=true;
end;

procedure TKor.ZmenPero(ndole:boolean);
begin
  if ndole then PD else PH;
end;

procedure TKor.ZmenFP(farba:TColor);
begin
  FFP:=farba;
end;

procedure TKor.ZmenHP(hrubka:integer);
begin
  FHP:=hrubka;
end;

//////////////////////////////////////////////////////////////////////////////////////////

procedure TKor.Vypln(farba:TColor);
var
  nx,ny:integer;
begin
  nx:=round(FX); ny:=round(FY);
  g.Brush.Color:=farba;
  g.Brush.Style:=bsSolid;
  g.FloodFill(nx,ny,g.Pixels[nx,ny],fsSurface);
end;

function TKor.Smerom(nx,ny:real):real;
var
  uhol:real;
begin
  nx:=nx-FX; ny:=FY-ny;
  if ny=0 then
    if nx=0 then uhol:=0
    else if nx<0 then uhol:=270 else uhol:=90
  else if ny>0 then
    if nx>=0 then uhol:=arctan(nx/ny)*deg
    else uhol:=360-arctan(-nx/ny)*deg
  else
    if nx>=0 then uhol:=180-arctan(-nx/ny)*deg
    else uhol:=180+arctan(nx/ny)*deg;
  Result:=uhol;
end;

function TKor.Vzd(nx,ny:real):real;
begin
  Result:=sqrt(sqr(nx-FX)+sqr(ny-FY));
end;

function TKor.Blizko(nx,ny:real):boolean;
begin
  Result:=sqr(nx-FX)+sqr(ny-FY)<100;
end;

procedure TKor.Pis(text:string);
begin
  g.Font.Color:=FFP;
  g.TextOut(round(FX),round(FY),text);
end;

//////////////////////////////////////////////////////////////////////////////////////////

procedure Zmaz(fpoz:TColor);
begin
  Inicializuj;
  g.Brush.Color:=fpoz;
  g.Brush.Style:=bsSolid;
  g.FillRect(Rect(0,0,sirka,vyska));
  g.Brush.Style:=bsClear;
end;

procedure Cakaj(MilliSec:Longint);
var
  potom:TDateTime;
begin
  potom:=Now + EncodeTime(0,MilliSec div 60000,(MilliSec div 1000) mod 60,MilliSec mod 1000);
  while Now < potom do Application.ProcessMessages;
end;

procedure ZrusKory;
var
  i:integer;
begin
  for i:=0 to maxkor do kory[i].Free;
end;

//////////////////////////////////////////////////////////////////////////////////////

procedure NastavPlochu(p:TImage);
begin
  if g<>nil then exit;
  if p.Owner is TForm then
    TForm(p.Owner).DoubleBuffered:=true;
  g:=p.Canvas;
  sirka:=p.Width; vyska:=p.Height;
end;

procedure Inicializuj;
var
  i,n:integer;
  f:TForm;
begin
  if g<>nil then exit;
  f:=Application.MainForm;
  if f=nil then begin
    n:=Application.ComponentCount; i:=0;
    while (i<n) and not (Application.Components[i] is TForm) do inc(i);
    if i=n then begin
      ShowMessage('vadná aplikácia - nenašiel som formulár');
      Halt;
    end;
    f:=TForm(Application.Components[i]);
  end;
  n:=f.ControlCount; i:=0;
  while (i<n) and not (f.Controls[i] is TImage) do inc(i);
  if i>=n then begin
    ShowMessage('vadná aplikácia - nenašiel som grafickú plochu');
    halt;
  end;
  NastavPlochu(TImage(f.Controls[i]));
end;

end.