unit ULPrgu;{v0.22}{v0.46}
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
uses
  SysUtils, ULRecTyp, ULObju, ULObjUsru,
  UPRSType, UPRSObju,
  UPRGType, UPRGObju,
  UPEPType, UPEPObju,
  UPESType, UPESObju,
  UPEXType, UPEXObju,
  UPSSType, UPSSObju,
  UPSTType, UPSTObju,
  UPAPType, UPAPObju,
  UPASType, UPASObju,
  UPAVType, UPAVObju,
  UPACType, UPACObju
  ;

type

  TULPrgs = class(TULObjUsr)
  private
  protected
    function ChildCreate(AChildObj:TULObj): TULObjUsr; override;
    function GetRecID: TULRecID; override;
  public
    constructor Create;reintroduce;
  end;

  TULPrgSteps = class;
    TULPrgStep = class;
  TULExpPool = class;
    TULExpSet = class;
      TULExp = class;


  TULActionPool = class;
    TULActionSet = class;
      TULActionSetValue = class;
      TULActionCommand = class;

  TULPrg = class(TULObjUsr)
  private
    FPrgSteps: TULPrgSteps;
    FExpPool: TULExpPool;
    FActionPool: TULActionPool;
    {FUPSS: TUPSSObj;
    FUPEP: TUPEPObj;}
    function GetPrgSteps: TULPrgSteps;
    function GetExpPool: TULExpPool;
    function GetActionPool: TULActionPool;
  protected
    function ChildCreate(AChildObj:TULObj): TULObjUsr; override;
    function GetRecID: TULRecID; override;
    procedure ClassFieldsCreate; override;
    procedure ChildDestroyed(AChild: TULObjUsr); override;
  public
    constructor Create(AOwner: TULObjUsr; AObj:TULObj; ARecID: TULRecID);reintroduce;
    destructor Destroy;override;
    property PrgSteps: TULPrgSteps read GetPrgSteps;
    property ExpPool: TULExpPool read GetExpPool;
  end;

  TULPrgSteps = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
    function GetPrgStep(Index: integer): TULPrgStep;
    function GetPrgStepCount: integer;
  public
    property PrgSteps[Index:integer]: TULPrgStep read GetPrgStep; default;
  end;

  TULPrgStep = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
  end;

  TULExpPool = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
  end;

  TULExpSet = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
  end;

  TULExp = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
  end;

  TULActionPool = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
  end;

  TULActionSet = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
    function ChildCreate(AChildObj: TULObj): TULObjUsr; override;
  end;


  TULActionSetValue = class(TULObjUsr)
  private
    function GetUPAV: TUPAVObj;
  protected
    function GetRecID: TULRecID; override;
    procedure ValuesSourceNeeded; override;
  public
    property UPAV: TUPAVObj read GetUPAV;
  end;

  TULActionCommand = class(TULObjUsr)
  protected
    function GetRecID: TULRecID; override;
  end;

function ULPrgs: TULPrgs;

implementation
uses
  ModuType, Modulu;

{TULPrg}
constructor TULPrg.Create(AOwner: TULObjUsr; AObj:TULObj; ARecID: TULRecID);
begin
  inherited Create(AOwner, AObj, ARecID);
  {FUPSS := TUPSSObj(Obj.FindOrAdd(UPSSID, ''));
    FUPSS.SetFlag(rfCantDelete, true);
  ChildAdd(FUPSS, 0, '');
  FUPEP := TUPEPObj(Obj.FindOrAdd(UPEPID, ''));
    FUPEP.SetFlag(rfCantDelete, true);
  ChildAdd(FUPEP, 0, '');}
end;

function TULPrg.GetPrgSteps: TULPrgSteps;
begin
  if FPrgSteps = nil then
    FPrgSteps := TULPrgSteps(ChildFindOrAdd(UPSSID, ''));
  Result := FPrgSteps;
end;

function TULPrg.GetExpPool: TULExpPool;
begin
  if FExpPool = nil then
    FExpPool := TULExpPool(ChildFindOrAdd(UPEPID, ''));
  Result := FExpPool;
end;

function TULPrg.GetActionPool: TULActionPool;
begin
  if FActionPool = nil then
    FActionPool := TULActionPool(ChildFindOrAdd(UPAPID, ''));
  Result := FActionPool;
end;

function TULPrg.GetRecID: TULRecID;
begin
  Result := UPRGID;
end;

function TULPrg.ChildCreate(AChildObj:TULObj): TULObjUsr;
var ou: TULObjUsr;
begin
  case AChildObj.RecID of
    UPEPID: ou := TULExpPool.Create(Self, AChildObj, 0);
    UPSSID: ou := TULPrgSteps.Create(Self, AChildObj, 0);
    UPAPID: ou := TULActionPool.Create(Self, AChildObj, 0);
  else
    raise Exception.Create('TULPrg.ChildCreate Invalid RecID ' + AChildObj.RecIDStr);
  end;
  Result := ou;
end;

procedure TULPrg.ChildDestroyed(AChild: TULObjUsr);
begin
  if AChild = FPrgSteps then
    FPrgSteps := nil
  else if AChild = FExpPool then
    FExpPool := nil;
end;

procedure TULPrg.ClassFieldsCreate;
begin
  inherited;
  GetPrgSteps;
  GetExpPool;
  GetActionPool;
end;

destructor TULPrg.Destroy;
begin
{  if FUPEP <> nil then
    FUPEP.SetFlag(rfCantDelete, false);
  if FUPSS <> nil then
    FUPSS.SetFlag(rfCantDelete, false);}
  inherited Destroy;
end;
{/TULPrg}

{TULPrgSteps}
function TULPrgSteps.GetRecID: TULRecID;
begin
  Result := UPSSID;
end;

function TULPrgSteps.ChildCreate(AChildObj: TULObj): TULObjUsr;
var
  ou: TULObjUsr;
begin
  case AChildObj.RecID of
    UPSTID: ou := TULPrgStep.Create(Self, AChildObj, 0);
  else
    raise Exception.Create('TULPrgSteps.ChildCreate Invalid RecID ' + AChildObj.RecIDStr);
  end;
  Result := ou;
end;

function TULPrgSteps.GetPrgStep(Index: integer): TULPrgStep;
begin
  Result := TULPrgStep(Childs[Index]);
end;

function TULPrgSteps.GetPrgStepCount: integer;
begin
  Result := ChildCount;
end;
{/TULPrgSteps.}

{TULPrgStep.}
function TULPrgStep.GetRecID: TULRecID;
begin
  Result := UPSTID;
end;
{/TULPrgStep.}

{TULPrgs}
constructor TULPrgs.Create;
begin
  inherited Create(nil, nil, UPRSID);
end;

function TULPrgs.GetRecID: TULRecID;
begin
  Result := UPRSID;
end;

function TULPrgs.ChildCreate(AChildObj:TULObj): TULObjUsr;
begin
  Result := TULPrg.Create(Self, AChildObj, UPRGID);
end;
{/TULPrgs}

{TExpPool}
function TULExpPool.GetRecID: TULRecID;
begin
  Result := UPEPID;
end;

function TULExpPool.ChildCreate(AChildObj: TULObj): TULObjUsr;
begin
  Result := TULExpSet.Create(Self, AChildObj, UPESID);
end;
{/TExpPool}

{TULExpSet.}
function TULExpSet.GetRecID: TULRecID;
begin
  Result := UPESID;
end;

function TULExpSet.ChildCreate(AChildObj: TULObj): TULObjUsr;
begin
  Result := TULExp.Create(Self, AChildObj, UPEXID);
end;
{/TULExpSet.}


{TULExp.}
function TULExp.GetRecID: TULRecID;
begin
  Result := UPEXID;
end;
{/TULExp.}

{TActionPool}
function TULActionPool.GetRecID: TULRecID;
begin
  Result := UPAPID;
end;

function TULActionPool.ChildCreate(AChildObj: TULObj): TULObjUsr;
var
  ou: TULObjUsr;
begin
  case AChildObj.RecID of
    UPASID: ou := TULActionSet.Create(Self, AChildObj, 0);
  else
    raise Exception.Create('TULActionPool.ChildCreate Invalid RecID ' + AChildObj.RecIDStr);
  end;
  Result := ou;
end;

{/TActionPool}

{TULActionSet.}
function TULActionSet.GetRecID: TULRecID;
begin
  Result := UPASID;
end;

function TULActionSet.ChildCreate(AChildObj: TULObj): TULObjUsr;
var
  ou: TULObjUsr;
begin
  case AChildObj.RecID of
    UPAVID: ou := TULActionSetValue.Create(Self, AChildObj, 0);
    UPACID: ou := TULActionCommand.Create(Self, AChildObj, 0);
  else
    raise Exception.Create('TULActionSet.ChildCreate Invalid RecID ' + AChildObj.RecIDStr);
  end;
  Result := ou;
end;
{/TULActionSet.}

{TULActionSetValue.}
function TULActionSetValue.GetUPAV: TUPAVObj;
begin
  Result := TUPAVObj(Obj);
end;

function TULActionSetValue.GetRecID: TULRecID;
begin
  Result := UPAVID;
end; {upavtype}

{procedure TULActionSetValue.FieldChangedInBrowser(AField: TULObjField);
begin
end;}

procedure TULActionSetValue.ValuesSourceNeeded;
var
  m: TModule;
begin
  if Modules.FindModuleWithPropVal(piDeviceName, UPAV.DeviceName, m) then begin
    UPAV.PropDesc_Src_Ptr := longint(m.ULDR);
  end else begin
    UPAV.PropDesc_Src_Ptr := 0;
  end;
end;

{/TULActionSetValue.}

{TULActionCommand.}
function TULActionCommand.GetRecID: TULRecID;
begin
  Result := UPACID;
end;
{/TULActionCommand.}

const
  FULPrgs: TULPrgs = nil;

function ULPrgs: TULPrgs;
begin
  if FULPrgs = nil then
    FULPrgs := TULPrgs.Create;
  Result := FULPrgs;
end;

end.
