unit nkscale;
{
   Unit to scale real points to window points

   Author:  Vesa Lappalainen
   Date:    15.2.1998
   Changes:

}

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

  {----------------------------------------------------------------------------}
type
  TScale = class(TPanel)
  private
    FFactor  : Double;
    FFac     : TDPoint;
    FOrigo   : TDPoint;
    FChanges : integer;
  protected
    procedure SetFactor(f:double); virtual;
    procedure TellOthers;           virtual;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function DownScaleP(const p:TDPoint)   : TPoint;  virtual;
    function DownScaleDP(const dp:TDPoint) : TPoint;  virtual;
    function UpScaleP(ip:TPoint;p:TDPoint) : TDPoint; virtual;
    function UpScaleDP(idp:TPoint;dp:TDPoint): TDPoint; virtual;
    procedure FacChange(const p:TDPoint); virtual;
    procedure OrigoChange(const p:TDPoint); virtual;
  published
    property Factor : Double  Read FFactor Write SetFactor;
    property Fac    : TDPoint Read FFac Write FFac;
    property Origo  : TDPoint Read FOrigo Write FOrigo;
    property Changes : integer Read FChanges;
  end; { TScale }

procedure Register;

implementation
uses nkavesimu;


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

{------------------------------------------------------------------------------}
{ TScale ======================================================================}
{------------------------------------------------------------------------------}
//-----------------------------------------------------------------------------
function TScale.DownScaleP(const p:TDPoint)   : TPoint; //   virtual;
begin
  Result.x := Round( p.x*Fac.x + Origo.x);
  Result.y := Round(-p.y*Fac.y + Origo.y);
end;

//-----------------------------------------------------------------------------
function TScale.DownScaleDP(const dp:TDPoint) : TPoint; //   virtual;
begin
  Result.x := Round(dp.x*Fac.x);
  Result.y := Round(dp.y*Fac.y);
end;


//-----------------------------------------------------------------------------
function TScale.UpScaleP(ip:TPoint;p:TDPoint) : TDPoint; //  virtual;
begin
  if ( Fac.x = 0 ) then p.x := ip.x-Origo.x
                   else p.x := (ip.x-Origo.x)/Fac.x;
  if ( Fac.y = 0 ) then p.y := (ip.y-Origo.y)
                   else p.y :=-(ip.y-Origo.y)/Fac.y;
  Result := p;
end;


//-----------------------------------------------------------------------------
function TScale.UpScaleDP(idp:TPoint;dp:TDPoint): TDPoint; //  virtual;
begin
  if ( Fac.x = 0 ) then dp.x := idp.x  else dp.x := (idp.x/Fac.x);
  if ( Fac.y = 0 ) then dp.y := idp.y  else dp.y := (idp.y/Fac.y);
  Result := dp;
end;

{------------------------------------------------------------------------------}
constructor TScale.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FFactor := 800.0/20000.0;
  Fac   := TDPoint.Create3(FFactor,FFactor,FacChange);
  Origo := TDPoint.Create3(320,72,OrigoChange);
  FChanges := 0;
end;

{------------------------------------------------------------------------------}
procedure TScale.SetFactor(f:double);
var ratio:double;
begin
  if ( FFactor = f ) then exit;
  if ( FFactor = 0 ) then begin
    FFactor  := f;
    Fac.SetXY(f,f);
  end
  else begin
    Ratio := f/FFactor;
    FFactor :=  FFactor*Ratio;
    Fac.Mul(Ratio);
  end;
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;


//-----------------------------------------------------------------------------
procedure TScale.FacChange(const p:TDPoint); //  virtual;
begin
  FFactor := abs(Fac.x);
  inc(FChanges);  TellOthers;
end;

//-----------------------------------------------------------------------------
procedure TScale.OrigoChange(const p:TDPoint); //  virtual;
begin
  inc(FChanges);  TellOthers;
end;


//-----------------------------------------------------------------------------
destructor TScale.Destroy; //  virtual;
begin
  FFac.Free;
  FOrigo.Free;
  inherited;
end;


end.