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
   Changes: 02.02.-25.02.1998
              + TLink, TLinkComp,
              + muutettu käyttämään TDPoint ja uutta TScale-komponenttia
              + kun TLInkissä yritettiin Published Write-only ominaisuutta,
                niin suunnitteluaikan tulee ilmoitus: read 0000 in 0000
              + lisäksi ei näytä kestävän sitä, että esim. Destoyssa on
                ShowMessage jos vaihetaan Formin tekstimuotoon?
   Changes: 17.03.1998
              + Editointiformi + talletus iniin


     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
                     niin enää ei tarvitse mitään kommervenkkejä :-)

         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 muuttuessa
                     ulkopuolella olevat komponentit eivät välttämättä
                     see päivitysviestiä.

}

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,kdouble,kpoint,kbox,kscale,kIniSave, StdCtrls, kComp, KParam,
  savepos;

type

  {----------------------------------------------------------------------------}
  {
      TaSimuObject
        - Fy,Fy  - reaalisia
  }
  {----------------------------------------------------------------------------}
  TaSimuObject = class;
  TLinkComp = class;

  TNotifySimuEvent = procedure(Sender: TaSimuObject) of object;

  TLink = class(TPersistent)
  private
    FLink : TControl;
    FLink2 : TLinkComp;
    FLinkP : TDPoint;
    FLinkDirX : TLinkDirX;
    FLinkDirY : TLinkDirY;
    FLinkOrgX : TLinkDirX;
    FLinkOrgY : TLinkDirY;
    FLinkBox : TDBox;
    FWhosLink : TaSimuObject;  // WhosLink
  protected

  public
    constructor Create; virtual;
    constructor Create1(AWhosLink:TaSimuObject); virtual;
    destructor Destroy; override;
    procedure SetLinkDirX(value:TLinkDirX); virtual;
    procedure SetLinkDirY(value:TLinkDirY); virtual;
    procedure SetLinkOrgX(value:TLinkDirX); virtual;
    procedure SetLinkOrgY(value:TLinkDirY); virtual;
    procedure SetLink(l:TControl);             virtual;
    procedure LinkChange(const p:TDPoint); virtual;
    procedure CheckLink;                       virtual;
    procedure Assign(Source: TPersistent); override;
    procedure SetWhosLink(s:TaSimuObject); virtual;
    procedure SetWhosLinkNU(s:TaSimuObject); virtual;
    procedure SetLink2(value:TLinkComp); virtual;

    procedure SetLinkVisible(value:boolean); virtual;
    procedure SetLinkP(value:TDPoint); virtual;
//    property LinkVisible : boolean write SetLinkVisible;
  published
    property Link : TControl read FLink write SetLink;
    property LinkDirX : TLinkDirX read FLinkDirX write SetLinkDirX default ldLeft;
    property LinkDirY : TLinkDirY read FLinkDirY write SetLinkDirY default ldBottom;
    property LinkOrgX : TLinkDirX read FLinkOrgX write SetLinkOrgX default ldLeft;
    property LinkOrgY : TLinkDirY read FLinkOrgY write SetLinkOrgY default ldBottom;
    property Link2 : TLinkComp read FLink2 write SetLink2;
    property LinkP : TDPoint read FLinkP write SetLinkP;
  end;

  TLinkComp = class(TComponent)
    FLink : TLink;
  public
    constructor Create(AParent:TComponent); override;
    destructor Destroy; override;
    procedure CheckLink;                       virtual;
    procedure SetLink(value:TLink); virtual;
  published
    property Link : TLink read FLink write SetLink;
  end;

  TEditFormClass = class of TForm;

  TaSimuObject = class(TShape)
  private
    FScale : TScale;
    FBox : TDBox;
    FLink : TLink;
    FSimulationOn : boolean;
    FIni : TIniSave;
    FOnAfterChange : TNotifySimuEvent;
    FOnAfterEdit : TNotifySimuEvent;
    function GetXR: double;
  protected

    procedure SetScale(AScale:TScale);         virtual;
    procedure SetParent(AParent:TWinControl);  override;
  public
    Form : TForm;
    constructor Create(AOwner:TComponent);     override;
    destructor Destroy;                        override;
    procedure DoScale(force:boolean);          virtual;
    procedure DoIScale;                        virtual;
    procedure ShowChange;                      virtual;
    function Advance(dx:Double) : boolean;     virtual;
    procedure Paint;                           override;
    procedure Loaded;                          override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure MySetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
    procedure BoxChange(const b:TDBox); virtual;
    procedure SetLink(l:TLink); virtual;
    procedure CheckLink;                       virtual;
    function  GetX : double; virtual;
    procedure SetX(value:double); virtual;
    function  GetVisible : boolean; virtual;
    procedure SetVisible(value:boolean); virtual;
//    procedure SetVisible(value:boolean); override;
    procedure ControlVisible(value:boolean); virtual;
    procedure Edit; virtual;
    function  GetAsString : string; virtual;
    procedure SetAsString(value:string); virtual;
    procedure ExtAsString(var value:string); virtual;
    procedure FreeIni; virtual;
    function GetEditForm : TEditFormClass; virtual;
    function GetScaleStored : boolean; virtual;
    function  GetLen : double; virtual;
    procedure SetLen(value:double); virtual;
    property XR : double read GetXR;
  published
    property Scale : TScale Read FScale write SetScale stored GetScaleStored;
    property Box : TDBox read FBox write FBox;
    property Link : TLink read FLink write SetLink;
    property SimulationOn : boolean Read FSimulationOn write FSimulationOn default false;
    property X : double read GetX write SetX stored false;
    property Len : double read GetLen write SetLen stored false;
    property Left stored false;
    property Top stored false;
    property Width stored false;
    property Height stored false;
    property Visible : boolean read GetVisible write SetVisible default true;
    property Ini : TIniSave read FIni write FIni;
    property AsString : string read GetAsString write SetAsString stored false;
    property OnAfterChange : TNotifySimuEvent read FOnAfterChange write FOnAfterChange;
    property OnAfterEdit : TNotifySimuEvent read FOnAfterEdit write FOnAfterEdit;
  end; { TaSimuObject }


procedure Register;

{------------------------------------------------------------------------------}
implementation
uses kavesimf;

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

{------------------------------------------------------------------------------}
{ TaSimuObject ================================================================}
{------------------------------------------------------------------------------}

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

{------------------------------------------------------------------------------}
procedure TaSimuObject.DoIScale;
{ Skaalataan reaalikoordinaatit kok. koordinaattien pohjalta                   }
begin

end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.DoScale(force:boolean);
// Kaikki koonmuutokset kiertävät tästä kautta.
var ip,idp : TPoint;
begin
  if ( not force ) and ( csLoading in ComponentState ) then exit;
  if ( FScale = NIL ) then begin
    DoIScale;
    Exit;
  end;
  Box.ToWin(ip,idp,Scale);
  if ( idp.x <= 0 ) then idp.x := 1;
  if ( idp.y <= 0 ) then idp.y := 1;
  inherited SetBounds(ip.x,ip.y,idp.x,idp.y);
  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
  Box.p.AddXY(dx,0);
  Result := True;
end;

{------------------------------------------------------------------------------}
constructor TaSimuObject.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Shape := stRectangle;
  FScale := NIL;
  FSimulationOn := false;
  FBox := TDBox.Create5(0,0,20,20,BoxChange);
  FLink := TLink.Create1(self);
  FIni := TIniSave.Create(self);
  Ini.AutoSave := false;
{  Brush.Color := clBlue;}
end;

//-----------------------------------------------------------------------------
destructor TaSimuObject.Destroy; //                         override;
begin
  FreeIni;
  FLink.Free;
  FBox.Free;
  inherited;
end;

{------------------------------------------------------------------------------}
procedure TaSimuObject.Paint;
begin
  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);
  if ( Ini.AutoSave ) then Ini.Load;
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.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); //  override;
{ 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
  if ( Box = nil ) then begin
    inherited SetBounds(ALeft,ATop,AWidth,AHeight);
    Exit;
  end;
  if ( csLoading in ComponentState ) then exit;
  Box.FromWin(ALeft,ATop,AWidth,AHeight,Scale);
  CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TaSimuObject.BoxChange(const b:TDBox); //  virtual;
begin
  DoScale(true);
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.SetLink(l:TLink); //  virtual;
begin
  FLink := l;
  CheckLink;
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.CheckLink; //                        virtual;
begin
//  ShowMessage('TaSimuobject Voi');
  if ( Assigned(Link) ) then Link.CheckLink;
end;

//-----------------------------------------------------------------------------
function TaSimuObject.GetX : double; //  virtual;
begin
  Result := Box.p.x;
end;

//-----------------------------------------------------------------------------
procedure TaSimuObject.SetX(value:double); //  virtual;
begin
  Box.p.x := value;
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.SetVisible(value:boolean); //  virtual;
begin
  inherited visible := value;

  ControlVisible(value);
  if ( assigned(Link) ) then
    Link.SetLinkVisible(value);

end;


//-----------------------------------------------------------------------------
function  TaSimuObject.GetVisible : boolean; //  virtual;
begin
  Result := inherited Visible;
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.ControlVisible(value:boolean); //  virtual;
begin
  inherited Visible := value;
end;



//-----------------------------------------------------------------------------
// TLink
//-----------------------------------------------------------------------------

//-----------------------------------------------------------------------------
procedure TLink.SetWhosLinkNU(s:TaSimuObject); //  virtual;
// Asettaa sen, kuka linkkaa, muttei päivitä linkkejä => edullisempi rekursio
begin
//  ShowMessage('Link SetWhosLinkNU');
  FWhosLink := s; // ???? Ja kaikki tähän liittyvä
  if ( Assigned(FLink2) ) then FLink2.FLink.SetWhosLinkNU(s);
end;


//-----------------------------------------------------------------------------
procedure TLink.SetWhosLink(s:TaSimuObject); //  virtual;
// Asettaa sen, kuka linkkaa ja päivittää linkit
begin
//  ShowMessage('Link SetWhosLink');
  SetWhosLinkNU(s);
  CheckLink;
end;


//-----------------------------------------------------------------------------
constructor TLink.Create; //  virtual;
begin
//  ShowMessage('Link Create Start');
  inherited Create;
  FLinkP := TDPoint.Create3(0,0,LinkChange);
  FLinkBox := TDBox.Create;
//  ShowMessage('Link Create');

end;

//-----------------------------------------------------------------------------
constructor TLink.Create1(AWhosLink:TaSimuObject); //  virtual;
begin
//  ShowMessage('Link Create1 start');
  inherited Create;
  FLinkP := TDPoint.Create3(0,0,LinkChange);
  FLinkBox := TDBox.Create;
  FWhosLink := AWhosLink;
//  ShowMessage('Link Create1');
end;


//-----------------------------------------------------------------------------
destructor TLink.Destroy; //  override;
begin
//  ShowMessage('Link Destroy');
  FLinkBox.Free;
  FLinkP.Free;
  inherited;
//  ShowMessage('Link Destroy done');
end;

//------------------------------------------------------------------------------
procedure TLink.SetLink(l:TControl);
begin
//  ShowMessage('Link SetLink');
  if ( FWhosLink = l ) then exit; // ei linkkiä itseensä
  FLink := l;
  CheckLink;
end;

//------------------------------------------------------------------------------
procedure TLink.CheckLink;
var np,ndp : TPoint; l : TaSimuObject;
  procedure AddOrg;
  begin
    FLinkBox.p.AddXY(Ord(LinkOrgX)/2*FWhosLink.Box.dp.x,
                     Ord(LinkOrgY)/2*FWhosLink.Box.dp.y);
  end;
  procedure AddDir;
  begin
    FLinkBox.p.AddXY(-Ord(LinkDirX)/2*l.Box.dp.x,
                     -Ord(LinkDirY)/2*l.Box.dp.y);
  end;
begin
//  ShowMessage('Link CheckLink');
  if ( FLink = NIL ) then exit;
  if ( FWhosLink = nil ) then exit;
  SetLinkVisible(FWhosLink.Visible);
  if ( FLink is TaSimuObject ) then begin
    l := FLink as TaSimuObject;
    FLinkBox.p.Assign(FWhosLink.Box.p); FLinkBox.p.AddV(FLinkP);
    AddOrg;
    AddDir;
    l.Box.p.Assign(FLinkBox.p);
    if ( Assigned(FLink2) ) then FLink2.CheckLink;
    exit;
  end;
  FLinkBox.FromWin(FLink.Left,FLink.Top,FLink.Width,FLink.Height,FWhosLink.Scale);
  FLinkBox.p.Assign(FWhosLink.Box.p);
  AddOrg;
  FLinkBox.ToWinDXY(np,ndp,FWhosLink.Scale,
                    -ord(LinkDirX)*FLink.Width div 2,
                    -ord(LinkDirY)*FLink.Height div 2);
  FLink.SetBounds(np.x,np.y,FLink.Width,FLink.Height);
  if ( Assigned(FLink2) ) then FLink2.CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TLink.LinkChange(const p:TDPoint); //  virtual;
begin
//  ShowMessage('Link Change');
  FLinkBox.Origo.Assign(p);
  FLinkBox.Origo.Neg;
  CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TLink.SetLinkDirX(value:TLinkDirX); //  virtual;
begin
//  ShowMessage('Link.SetLinkDirX');
  FLinkDirX := value;
  CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TLink.SetLinkDirY(value:TLinkDirY); //  virtual;
begin
//  ShowMessage('Link.SetLinkDirY');
  FLinkDirY := value;
  CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TLink.SetLinkOrgX(value:TLinkDirX); //  virtual;
begin
//  ShowMessage('Link.SetLinkOrgX');
  FLinkOrgX := value;
  CheckLink;
end;


//-----------------------------------------------------------------------------
procedure TLink.SetLinkOrgY(value:TLinkDirY); //  virtual;
begin
//  ShowMessage('Link.SetLinkOrgX');
  FLinkOrgY := value;
  CheckLink;
end;


//-----------------------------------------------------------------------------
procedure TLink.Assign(Source: TPersistent); //  virtual;
var l : TLink;
begin
//  ShowMessage('Link Assign');
  if not (source is TPersistent) then exit;
  l := source as TLink;
  FLink := l.FLink;
  FLinkP.Assign(l.FLinkP);
  FLinkDirX := l.LinkDirX;
  FLinkDirY := l.LinkDirY;
  FLinkOrgX := l.LinkOrgX;
  FLinkOrgY := l.LinkOrgY;
  CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TLinkComp.SetLink(value:TLink); //  virtual;
begin
//  ShowMessage('Link SetLink');
  FLink.Assign(value);
end;

//-----------------------------------------------------------------------------
procedure TLink.SetLink2(value:TLinkCOmp); //  virtual;
begin
//  ShowMessage('Link SetLink2');
  FLink2 := value;
  if ( assigned(FLink2) ) then FLink2.FLink.SetWhosLinkNU(FWhosLink);
  CheckLink;
end;

//-----------------------------------------------------------------------------
procedure TLink.SetLinkVisible(value:boolean); //  virtual;
begin
//  ShowMessage('Link SetLinkVisible');
  if ( Assigned(FLink) ) then begin
    if ( FLink is TaSimuObject ) then
      (FLink as TaSimuObject).Visible := value
    else
      FLink.Visible := value;
  end;
  if ( Assigned(FLink2) ) then begin
    FLink2.FLink.SetLinkVisible(value);
  end;
end;

//-----------------------------------------------------------------------------
procedure TLink.SetLinkP(value:TDPoint); //  virtual;
begin
//  ShowMessage('Link.SetLinkP');
  FLinkP.Assign(value);
end;


//-----------------------------------------------------------------------------
// TLinkCOmp
//-----------------------------------------------------------------------------
constructor TLinkComp.Create(AParent:TComponent); //  override;
begin
//  ShowMessage('LinkComp.Start Create');
  inherited;
//  ShowMessage('LinkComp.Create');
  FLink := TLink.Create1(nil);
//  ShowMessage('LinkComp.End Create');
end;


//-----------------------------------------------------------------------------
destructor TLinkComp.Destroy; //  override;
begin
//  ShowMessage('LinkComp.Destroy');
  FLink.Free;
  inherited;
end;


//-----------------------------------------------------------------------------
procedure TLinkComp.CheckLink; //                        virtual;
begin
//  ShowMessage('LinkComp.Destroy');
  if ( Assigned(FLink) ) then FLink.CheckLink;
end;


//-----------------------------------------------------------------------------
function TaSimuObject.GetEditForm : TEditFormClass; //  virtual;
begin
  Result := TFormEditSimuObject;
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.Edit; // virtual;
var fr : TForm; f : TFormEditSimuObject;
begin
  if ( Form <> nil ) then begin Form.Show; exit; end;
  fr := GetEditForm.Create(nil);
  if not ( fr is TFormEditSimuObject ) then begin
    if Assigned(fr) then fr.free;
    exit;
  end;

  f := fr as TFormEditSimuObject;
  f.MyObj := self;
  f.Getting := true;
  f.GetData(self);
  f.Getting := false;
  f.Caption := 'Edit ' + self.Name;
  if ( f.CBAutoApply.Checked ) then begin f.Show; Form := fr; exit; end;
  if ( f.ShowModal = mrOK ) then begin
    f.SetData(self);
    if ( Ini.AutoSave ) then Ini.Save;
  end;
  f.Release;
  Form := nil;
  if Assigned(FOnAfterEdit) then FOnAfterEdit(self);
end;


//-----------------------------------------------------------------------------
function  TaSimuObject.GetAsString : string; //  virtual;
begin
  Result := '';
  if ( csLoading in ComponentState ) or ( csDesigning in ComponentState ) then exit;
  Result := '$'+IntToHex(Brush.Color,6) + ';' + box.GetAsString + '|';
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.SetAsString(value:string); //  virtual;
begin
  if ( csLoading in ComponentState ) or ( csDesigning in ComponentState ) then exit;
  ExtAsString(value);
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.ExtAsString(var value:string); //  virtual;
var val:string;
begin
  val := ExtractString(value,'|','');
  if ( val = '' ) then exit;
  Brush.Color := ExtractInt(val,';',Brush.Color);
  box.ExtAsString(val);
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.FreeIni; //  virtual;
begin
  if ( Ini <> nil ) then begin
    if ( Ini.AutoSave ) then Ini.Save;
    Ini.Free;
    Ini := nil;
  end;
end;

//-----------------------------------------------------------------------------
function TaSimuObject.GetScaleStored : boolean; //  virtual;
begin
  Result := FScale <> Parent;
end;

//-----------------------------------------------------------------------------
function  TaSimuObject.GetLen : double; //  virtual;
begin
  Result := Box.dp.x;
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.SetLen(value:double); //  virtual;
begin
  Box.dp.x := value;
end;


//-----------------------------------------------------------------------------
function TaSimuObject.GetXR: double;
begin
  Result := Box.p.x + Box.dp.x;
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.MySetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft,ATop,AWidth,AHeight);
end;

end.