unit ksimu;
{
   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?


     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,kbox,kscale,kinicomp, StdCtrls, kComp, KParam,
  savepos;

type

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

  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;

  TFormEditSimuObject = class;

  TaSimuObject = class(TShape)
  private
    FScale : TScale;
    FBox : TDBox;
    FLink : TLink;
    FSimulationOn : boolean;
    FIni : TIniSave;
  protected

    procedure SetScale(AScale:TScale);         virtual;
    procedure SetParent(AParent:TWinControl);  override;
  public
    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 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 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 CreateEditForm : TFormEditSimuObject; virtual;
  published
    property Scale : TScale Read FScale write SetScale;
    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 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;
  end; { TaSimuObject }


  TFormEditSimuObject = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    ButtonOK: TButton;
    ParamPX: TkParam;
    ParamOrigoY: TkParam;
    ParamOrigoX: TkParam;
    ParamDpY: TkParam;
    ParamDpX: TkParam;
    ParamPY: TkParam;
    SavePos1: TSavePos;
    ButtonCancel: TButton;
    CBAutoApply: TkCheckBox;
    ColorDialog: TColorDialog;
    Panel5: TPanel;
    ButtonColor: TButton;
    PanelColor: TPanel;
    procedure ParamPXAfterChange(Sender: TObject; var val: Double);
    procedure CBAutoApplyClick(Sender: TObject);
    procedure ButtonColorClick(Sender: TObject);
  private
    { Private declarations }
  protected
    FGetting : boolean;
    fmyobj : TaSimuObject;
    procedure GetData(const o:TaSimuObject); virtual;
    procedure SetData(o:TaSimuObject); virtual;
    procedure SetCol(c:TColor); virtual;
  public
    { Public declarations }
    procedure CheckSet; virtual;
  end;

//var
//  FormEditSimuObject: TFormEditSimuObject;

procedure Register;

{------------------------------------------------------------------------------}
implementation
{$R *.DFM}

{------------------------------------------------------------------------------}
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
  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');
  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);
    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
    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.CreateEditForm : TFormEditSimuObject; //  virtual;
begin
  Result := TFormEditSimuObject.Create(self);
end;


//-----------------------------------------------------------------------------
procedure TaSimuObject.Edit; // virtual;
var  f : TFormEditSimuObject;
begin
  f := CreateEditForm;
  f.fmyobj := self;
  f.FGetting := true;
  f.GetData(self);
  f.FGetting := false;
  f.Caption := 'Edit ' + self.Name;
  if ( f.ShowModal = mrOK ) then begin
    f.SetData(self);
    if ( Ini.AutoSave ) then Ini.Save;
  end;
  f.Free;

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;


//-----------------------------------------------------------------------------
// TFormEditSimuObject
//-----------------------------------------------------------------------------

//-----------------------------------------------------------------------------
procedure TFormEditSimuObject.GetData(const o:TaSimuObject); //  virtual;
var olda : boolean;
begin
  olda := CBAutoApply.Checked;
  CBAutoApply.Checked := false;
  with o do begin
    ParamPX.value := box.p.x;
    ParamPY.value := box.p.y;
    ParamDpX.value := box.dp.x;
    ParamDpY.value := box.dp.y;
    ParamOrigoX.value := box.Origo.x;
    ParamOrigoY.value := box.Origo.y;
    SetCol(Brush.Color);
  end;
  CBAutoApply.Checked := olda;
end;


//-----------------------------------------------------------------------------
procedure TFormEditSimuObject.SetData(o:TaSimuObject); //  virtual;
var oldInfo : boolean;
begin
  with o do begin
    oldInfo := box.DoInform; box.DoInform := false;
    box.p.x := ParamPX.value;
    box.p.y := ParamPY.value;
    box.dp.x := ParamDpX.value;
    box.dp.y := ParamDpY.value;
    box.Origo.x := ParamOrigoX.value;
    box.Origo.y := ParamOrigoY.value;
    box.DoInform := oldInfo;
    box.PChange(nil);
    Brush.Color := PanelColor.Color;
  end;
end;

procedure TFormEditSimuObject.ParamPXAfterChange(Sender: TObject;
  var val: Double);
begin
  CheckSet;
end;

procedure TFormEditSimuObject.CBAutoApplyClick(Sender: TObject);
begin
  CheckSet;
end;

procedure TFormEditSimuObject.ButtonColorClick(Sender: TObject);
begin
  ColorDialog.Color := PanelColor.Color;
  if not ColorDialog.Execute then exit;
  SetCol(ColorDialog.Color);
  CheckSet;
end;


//-----------------------------------------------------------------------------
procedure TFormEditSimuObject.SetCol(c:TColor); //  virtual;
begin
  PanelColor.Color := c;
  PanelColor.Caption := IntToHex(c,6);
end;


//-----------------------------------------------------------------------------
procedure TFormEditSimuObject.CheckSet; //  virtual;
begin
  if ( csLoading in ComponentState ) or  ( FGetting ) then exit;
  if ( CBAutoApply.Checked ) then SetData(fmyobj);
end;



end.