unit kavesimu;
{
   Tässä tiedostossa on simulaattorin peruskomponentit.

   Author:  Vesa Lappalainen
   Date:    9.9.1996
   Changes: 5.10.1996
              + Automaattinen scale
              + muuttuneen top/left/height/width muuttaminen
                reaalikoordinaatteihin
   Changes: 02.04.1997
              + SimulationOn ominaisuus, joka on oletuksen poissa päältä.
                Se voidaan asettaa komponenttikohtaisesti päälle.
                Erikseen pitää tarkistaa mihin komponentteihin tämä
                vaikuttaa.  Lisäyshetkellä vain anturiin


     TScale        - paneeli, johon voidaan komponentteja laittaa, ja
                     jolla on skaala, jolla komponentit skaalataan

     TaSimuObject  - "abstrakti" simulaattoriobjekti, joka osaa käyttää
                     reaalilukokoordinaatteja ja periytyy TShape-komponentista

         Paint-viestin käsittely
                     Jos tämän perillisessä määritellään Paint uudestaan
                     pitää joko kutsua perittyä Paintia tai kutsua
                     CheckScale -metodia, jolla voidaan tarkistaa onko
                     skaala muuttunut tai suunnittelija siirtänyt komponenttia
                     kokonaislukukoordinaattien avulla (lähinnä suunnittelun
                     aikana).

         Automaattinen scale
                     Jos komponentti laitetaan Scale-ikkunan sisään, on sen
                     Scale aina Parent.  Jos laitetaan ei-Scale -ikkunan
                     sisään, niin Scale voidaan vaihtaa, mutta Scale-arvon
                     muuttuessa ei välttämättä päivitys onnistu
                     sataporsenttisesti (ei tule välttämättä Paint-viestiä

}

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,kdouble,kpoint;

type

  {----------------------------------------------------------------------------}
  TScale = class(TPanel)
  private
    FFactor  : Double;
    FFactorX : Double;
    FFactorY : Double;
    FOrigoX : integer;
    FOrigoY : integer;
    FChanges : integer;
  protected
    procedure SetFactor(f:double); virtual;
    procedure SetFactorX(f:double); virtual;
    procedure SetFactorY(f:double); virtual;
    procedure SetOrigoX(x:integer); virtual;
    procedure SetOrigoY(y:integer); virtual;
    procedure TellOthers;           virtual;
  public
    constructor Create(AOwner:TComponent); override;
    function DownScaleX(x:double)   : integer;
    function DownScaleY(y:double)   : integer;
    function DownScaleDX(d:double)  : integer;
    function DownScaleDY(d:double)  : integer;
    function UpScaleX(ix:integer)   : double;
    function UpScaleY(iy:integer)   : double;
    function UpScaleDX(i:integer)   : double;
    function UpScaleDY(i:integer)   : double;
  published
    property Factor : Double  Read FFactor Write SetFactor;
    property FactorX : Double  Read FFactorX Write SetFactorX;
    property FactorY : Double  Read FFactorY Write SetFactorY;
    property OrigoX : integer Read FOrigoX Write SetOrigoX default 320;
    property OrigoY : integer Read FOrigoY Write SetOrigoY default 72;
    property Changes : integer Read FChanges;
  end; { TScale }

  {----------------------------------------------------------------------------}
  {
      TaSimuObject
        - Fy,Fy  - reaalisia
  }
  {----------------------------------------------------------------------------}
  TaSimuObject = class(TShape)
  private
    FScale : TScale;
    FScaleVersion : integer;         { Skaalauksen muuttumisen tarkistus       }
    FXLen : double;
    FYLen : Double;
    Fx : double;
    Fy : double;
    Fix,Fiy,Fixlen,Fiylen : integer; { Muutokset Left <> Fix vertaamiseksi     }

    FLink : TControl;
    FLinkX : double;
    FLinkY : double;
    FSimulationOn : boolean;
    FP : TDPoint;
  protected

    procedure SetX(ax:Double);                virtual;
    procedure SetY(ay:Double);                virtual;
    procedure SetXLen(AXLen:Double);          virtual;
    procedure SetYLen(AYLen:Double);          virtual;

    procedure SetIX(ax:Double);               virtual;
    procedure SetIY(ay:Double);               virtual;
    procedure SetIXLen(AXLen:Double);         virtual;
    procedure SetIYLen(AYLen:Double);         virtual;

    procedure SetFX(ix:integer);              virtual;
    procedure SetFY(iy:integer);              virtual;
    procedure SetFXLen(iXLen:integer);        virtual;
    procedure SetFYLen(iYLen:integer);        virtual;

    function DownScaleX(x:double) : integer;
    function DownScaleY(y:double) : integer;
    function DownScaleDX(d:double)  : integer;
    function DownScaleDY(d:double)  : integer;
    function UpScaleX(ix:integer) : double;
    function UpScaleY(iy:integer) : double;
    function UpScaleDX(i:integer)   : double;
    function UpScaleDY(i:integer)   : double;
    function FactorX : double;
    function FactorY : double;

    procedure DoScale(force:boolean);          virtual;
    procedure DoIScale;                        virtual;
    procedure SetScale(AScale:TScale);         virtual;
    function CheckScale           : boolean;   virtual;
    procedure SetParent(AParent:TWinControl);  override;
    procedure SetLinkX(lx:double);             virtual;
    procedure SetLinkY(ly:double);             virtual;
    procedure SetLink(l:TControl);             virtual;
  public
    constructor Create(AOwner:TComponent);     override;
    destructor Destroy;                        override;
    procedure ShowChange;                      virtual;
    function Advance(dx:Double) : boolean;     virtual;
    procedure Paint;                           override;
    procedure Loaded;                          override;
    procedure CheckLink;                       virtual;

  published
{$ifdef Left}
    property Left : integer Read GetLeft write SetLeft default 0;
    property Top  : integer Read GetTop  write SetTop default 0;
    property Width : integer Read GetWidth write SetWidth default 10;
    property Height : integer Read GetHeight write SetHeight default 10;
{$endif}
    property Scale : TScale Read FScale write SetScale;
    property XLen : Double Read FXLen write SetXLen;
    property YLen : Double Read FYLen write SetYLen;
    property x : double Read Fx write SetX;
    property y : double Read Fy write SetY;
    property Link : TControl Read FLink write SetLink;
    property LinkX : double Read FLinkX write SetLinkX;
    property LinkY : double Read FLinkY write SetLinkY;
    property SimulationOn : boolean Read FSimulationOn write FSimulationOn default false;
    property P : TDPoint read FP write FP;
  end; { TSheet }


procedure Register;

{------------------------------------------------------------------------------}
implementation

{------------------------------------------------------------------------------}
{ TScale ======================================================================}
{------------------------------------------------------------------------------}
function TScale.DownScaleX(x:double) : integer;
begin Result := Trunc(x*FactorX + OrigoX); end;

function TScale.DownScaleY(y:double) : integer;
begin Result := Trunc(-y*FactorY + OrigoY); end;

function TScale.DownScaleDX(d:double) : integer;
begin Result := Trunc(d*FactorX); end;

function TScale.DownScaleDY(d:double) : integer;
begin Result := Trunc(d*FactorY); end;

function TScale.UpScaleX(ix:integer) : double;
begin
  if ( FactorX = 0 ) then Result := ix-OrigoX
  else Result := (ix-OrigoX)/FactorX;
end;

function TScale.UpScaleY(iy:integer) : double;
begin
  if ( FactorY = 0 ) then Result := (iy-OrigoY)
  else Result := -(iy-OrigoY)/FactorY;
end;

function TScale.UpScaleDX(i:integer) : double;
begin
  if ( FactorX = 0 ) then Result := i
  else Result := i/FactorX;
end;

function TScale.UpScaleDY(i:integer) : double;
begin
  if ( FactorY = 0 ) then Result := i
  else Result := i/FactorY;
end;


{------------------------------------------------------------------------------}
constructor TScale.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FFactor := 800.0/20000.0;
  FFactorX := FFactor;
  FFactorY := FFactor;
  OrigoX := 320;
  OrigoY := 72;
  FChanges := 0;
end;

{------------------------------------------------------------------------------}
procedure TScale.SetFactor(f:double);
var ratio:double;
begin
  if ( FFactor = f ) then exit;
  if ( FFactor = 0 ) then begin
    FFactor  := f;
    FFactorX := f;
    FFactorY := f;
  end
  else begin
    Ratio := f/FFactor;
    FFactorX := FFactorX*Ratio;
    FFactorY := FFactorY*Ratio;
    FFactor :=  FFactor*Ratio;
  end;
  inc(FChanges);  TellOthers;
end;

procedure TScale.SetFactorX(f:double);
begin
  if ( FFactorX = f ) then exit;
  FFactorX := f; FFactor := abs(f);
  inc(FChanges);  TellOthers;
end;

procedure TScale.SetFactorY(f:double);
begin
  if ( FFactorY = f ) then exit;
  FFactorY := f; FFactor := abs(f);
  inc(FChanges);  TellOthers;
end;

procedure TScale.SetOrigoX(x:integer);
begin
  if ( OrigoX = x ) then exit;
  FOrigoX := x; inc(FChanges);  TellOthers;
end;

procedure TScale.SetOrigoY(y:integer);
begin
  if ( OrigoY = y ) then exit;
  FOrigoY := y; inc(FChanges);  TellOthers;
end;

{------------------------------------------------------------------------------}
procedure TScale.TellOthers;
var i:integer;
begin
  for i:=0 to ControlCount-1 do begin
    if ( Controls[i] is TaSimuObject ) and
       ( (Controls[i] as TaSimuObject).Scale = self ) then
      (Controls[i] as TaSimuObject).DoScale(false);
  end;
end;

{------------------------------------------------------------------------------}
{ TaSimuObject ================================================================}
{------------------------------------------------------------------------------}
{ Ei voi käyttää WM_MOVE -viestiä, koska sitä ei sitä ei tule!                 }

{------------------------------------------------------------------------------}
procedure TaSimuObject.ShowChange;
begin
end;

function TaSimuObject.DownScaleX(x:double) : integer;
begin
  if ( FScale <> NIL ) then Result := FScale.DownScaleX(x)
  else Result := Trunc(x);
end;

function TaSimuObject.DownScaleY(y:double) : integer;
begin
  if ( FScale <> NIL ) then Result := FScale.DownScaleY(y)
  else Result := Trunc(y);
end;

function TaSimuObject.UpScaleX(ix:integer) : double;
begin
  if ( FScale <> NIL ) then Result := FScale.UpScaleX(ix)
  else Result := ix;
end;

function TaSimuObject.UpScaleY(iy:integer) : double;
begin
  if ( FScale <> NIL ) then Result := FScale.UpScaleY(iy)
  else Result := iy;
end;

function TaSimuObject.DownScaleDX(d:double) : integer;
begin
  if ( FScale <> NIL ) then Result := FScale.DownScaleDX(d)
  else Result := Trunc(d);
end;

function TaSimuObject.DownScaleDY(d:double) : integer;
begin
  if ( FScale <> NIL ) then Result := FScale.DownScaleDY(d)
  else Result := Trunc(d);
end;

function TaSimuObject.UpScaleDX(i:integer) : double;
begin
  if ( FScale<> NIL ) then Result := FScale.UpScaleDX(i)
  else Result := i;
end;

function TaSimuObject.UpScaleDY(i:integer) : double;
begin
  if ( FScale<> NIL ) then Result := FScale.UpScaleDY(i)
  else Result := i;
end;

function TaSimuObject.FactorX : double;
begin
  if ( FScale = NIL ) Then Result := 1
  else Result := FScale.FactorX;
end;

function TaSimuObject.FactorY : double;
begin
  if ( FScale = NIL ) Then Result := 1
  else Result := FScale.FactorY;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.DoIScale;
{ Skaalataan reaalikoordinaatit kok. koordinaattien pohjalta                   }
begin
  Fix := -999; Fiy := -999; FixLen := -999; FiyLen := -999;
  CheckScale;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.DoScale(force:boolean);
begin
  if ( not force ) and ( csLoading in ComponentState ) then exit;
  if ( FScale = NIL ) then begin
    DoIScale;
    Exit;
  end;
  SetIX(Fx);
  SetIY(Fy);
  SetIXLen(FXLen);
  SetIYLen(FYLen);
  FScaleVersion := Scale.Changes;
  SetBounds(Fix,Fiy,FixLen,FiyLen);
  CheckLink;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.SetScale(AScale:TScale);
begin
  if ( FScale = Parent ) then exit;
  FScale := AScale;
  if ( csLoading in ComponentState ) then exit;
  DoScale(false);
end;

{------------------------------------------------------------------------------}
function TaSimuObject.Advance(dx:Double) : boolean;
begin
  SetX(Fx + dx);
  Result := True;
end;

{------------------------------------------------------------------------------}
constructor TaSimuObject.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
{  Brush.Color := clBlue;}
  Shape := stRectangle;
  FScale := NIL;
  SetIXLen(20.0);
  SetIYLen(20.0);
  SetIx(0);
  SetIy(0);
  FSimulationOn := false;
  FP := TDPoint.Create;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.SetIX(ax:Double);
begin
  Fx := ax;
  if ( FactorX > 0 ) then
    Fix := DownScaleX(Fx)
  else
    Fix := DownScaleX(Fx+FXLen);
end;

procedure TaSimuObject.SetIY(ay:Double);
begin
  Fy := ay;
  if ( FactorY > 0 ) then
    Fiy := DownScaleY(Fy+FYLen)
  else
    Fiy := DownScaleY(Fy);
end;

procedure TaSimuObject.SetIXLen(AXLen:Double);
begin
  FXLen := AXLen;
  if ( FactorX > 0 ) then
    FixLen := Abs(DownScaleDX(AXLen))
  else begin
    FixLen := Abs(DownScaleDX(AXLen));
    Fix := DownScaleX(Fx+FXLen);
  end;
end;

procedure TaSimuObject.SetIYLen(AYLen:Double);
begin
  FYLen := AYLen;
  if ( FactorY > 0 ) then begin
    FiyLen := Abs(DownScaleDY(AYLen));
    Fiy := DownScaleY(Fy+FYLen);
  end
  else
    FiyLen := Abs(DownScaleDY(AYLen));
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.SetFX(ix:integer);
begin
  if ( FactorX > 0 ) then
    SetIX(UpScaleX(ix))
  else
    SetIX(UpScaleX(ix)-FxLen)
end;

procedure TaSimuObject.SetFY(iy:integer);
begin
  if ( FactorY > 0 ) then
    SetIY(UpScaleY(iy)-FyLen)
  else
    SetIY(UpScaleY(iy));
end;

procedure TaSimuObject.SetFXLen(iXLen:integer);
begin
  SetIXLen(Abs(UpScaleDX(ixLen)));
end;

procedure TaSimuObject.SetFYLen(iYLen:integer);
begin
  SetIYLen(Abs(UpScaleDY(iYLen)));
end;
{
  if ( Width <> FixLen ) then begin SetIXLen(UpScaleDX(Width)); Result := False; end;
  if ( Left <> Fix ) then begin SetIX(UpScaleX(Left)); Result := False; end;
  if ( Height <> FiyLen ) then begin SetIYLen(UpScaleDY(Height)); Result := False; end;
  if ( Top  <> Fiy ) then begin SetIY(UpScaleY(Top)-FyLen); Result := False; end;
}
{------------------------------------------------------------------------------}
procedure TaSimuObject.SetX(ax:Double);
begin SetIX(ax);  SetBounds(Fix,Fiy,FixLen,FiyLen); end;

procedure TaSimuObject.SetY(ay:Double);
begin SetIY(ay); SetBounds(Fix,Fiy,FixLen,FiyLen); end;

procedure TaSimuObject.SetXLen(AXLen:Double);
begin SetIXLen(AXLen);  SetBounds(Fix,Fiy,FixLen,FiyLen); end;

procedure TaSimuObject.SetYLen(AYLen:Double);
begin SetIYLen(AYLen);  SetBounds(Fix,Fiy,FixLen,FiyLen); end;

{------------------------------------------------------------------------------}
function TaSimuObject.CheckScale : boolean;
{ Tämän pääasiallinen tehtävä on tarkistaa SUUNNITTELUN aikan mahdolliset
  suunnittelijan tekemät siirrot kontrollille.  Jos on siirretty, niin
  reaalikoordinaatit pitää päivittää muuttuneiden kokonaislukukoordinaattien
  mukaan
}
begin
  Result := True;
{  ShowMessage(Format('(%g,%g) %d->%d',[Fx,Fy,Fiy,Top]));}
  if ( Scale <> NIL ) and ( FScaleVersion <> Scale.Changes ) then begin
    DoScale(True);  { Tällä on käyttöä vaan jos Scale ei ole conrtollin isä }
    Result := False;
    Exit;
  end;
  if ( Width <> FixLen )  then begin SetFXLen(Width);  Result := False; end;
  if ( Left <> Fix )      then begin SetFX(Left);      Result := False; end;
  if ( Height <> FiyLen ) then begin SetFYLen(Height); Result := False; end;
  if ( Top  <> Fiy )      then begin SetFY(Top);       Result := False; end;
  if ( Result = false ) then begin
    CheckLink;
  end;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.Paint;
begin
  CheckScale;
  inherited Paint;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.Loaded;
begin
  inherited Loaded;
  if ( Scale = NIL ) and ( Parent is TScale ) then begin
    FScale := (Parent as TScale);
    DoIScale;
    Exit;
  end;
  if ( Scale <> NIL ) then DoScale(true);
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.SetParent(AParent:TWinControl);
begin
  inherited SetParent(AParent);
  if {( Scale = NIL ) and }( Parent is TScale ) then begin
    Scale := (Parent as TScale);
{    ShowMessage(Format('(%g,%g)',[Fx,Fy]));}
  end;

end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.SetLinkX(lx:double);
begin
  FLinkX := lx;
  CheckLink;
end;

procedure TaSimuObject.SetLinkY(ly:double);
begin
  FLinkY := ly;
  CheckLink;
end;

procedure TaSimuObject.SetLink(l:TControl);
begin
  FLink := l;
  CheckLink;
end;

procedure TaSimuObject.CheckLink;
var nx,ny : integer;
begin
  if ( FLink = NIL ) then exit;
  nx := DownScaleX(x+LinkX);
  if ( FactorX < 0 ) then nx := nx - Link.Width;
  ny  := DownScaleY(y+LinkY);
  if ( FactorY < 0 ) then ny := ny - Link.Height;
  if ( nx <> Link.Left ) then Link.Left := nx;
  if ( ny <> Link.Top ) then Link.Top := ny;
end;

{------------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('Kave2000', [TScale,TaSimuObject]);
end;


//-----------------------------------------------------------------------------
destructor TaSimuObject.Destroy; //                         override;
begin
  P.Free;
  inherited;
end;


end.