unit ULPrgu;{v0.22}{v0.46}

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, ''));
end;

function TULPrg.GetActionPool: TULActionPool;
begin
  if FActionPool = nil then
    FActionPool := TULActionPool(ChildFindOrAdd(UPAPID, ''));
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.
