unit SModulu;

interface
uses
  Windows, Messages, SysUtils, Classes, Dialogs, Math,
  InfoFrm, WinUtl, UlanGlob, BinHex,
  ULDrvTyp, ULDrvUtl, ULDriver,
  LogType, Logu, Stru,
  MyType, UlanType,
  ULRecTyp, ULObju, uLDType, uLDObju, Timer,
  ULDPType, ULDPObju, ULDRType, ULDRObju, ULFObju,
  ModuType, {v0.24}ModuUtl, {/v0.24}ModActu
  {$IFDEF DEBUG}
  ,DebugFrm
  {$ENDIF}
  ,ULLType, ULLObju, ULNType, ULNObju, ULNDType, ULNDObju,
  ExtDevIntu ,ExeLogu, TypInfo, PropUtl,

  Modulu, Channelsu;

type
  TSModule = class(TComponent)
  private
    FFailOnNotFound: boolean;
    FChannel: TChannel;
    FDeviceName: TDeviceName;
    FDeviceType: TDeviceType;
    FModule: TModule;

    procedure GetULFields;
    procedure GetULField(const AAAPropName: string; var AField: TULObjFldAutoCon);
    function FindULDP(const AAAObjPropName: string): TULDPObj;
      { as GeTULDP but raises exception if not found }
    function GetULDP(const AAAObjPropName: string; var AULDP:TULDPObj): boolean;
      { find uldp object that corresponds to property name of TAAAObj
        (i.e. to what ULDPObj should be assigned initial values)
        Syntax of AAAObjPropName: DeviceName_PropDesc }
    procedure FindModule;
    {function FindULDR(const AAAObjPropName: string): TULDRObj;}
  public
    constructor Create(AOwner: TComponent; AChannel: TChannel;
      const ADeviceName: TDeviceName; ADeviceType: TDeviceType;
      AFailOnNotFound: boolean); reintroduce;
      { tries to locate device of given name or type either in AChannel or
        in all devices (if AChannel = nil). If ADeviceName = '', then first
        device of given ADeviceType is used. If not found, create fails.
        Then tries to locate all TULObjFldAutoCon fields, if some not found fails,
        unless AFailOnFound is false (in that case unfound fields are nil) }

    property Module: TModule read FModule;
    property Channel: TChannel read FChannel;
  published
    { in descendants should be published properties of type   TULObjFldAutoCon,
      will search in module of ADeviceName for properties with the same name.
      Will raise exception if FailOnNotFound is true and some prop. not found. }
  end;

  TPumpModule = class(TSModule)
  private
    FPRGACTN: TULObjFldAutoCon;// = 1 (vyber programu)
    FPRGRUN: TULObjFldAutoCon;//  = cmd
    FPRGEND: TULObjFldAutoCon;//  cmd  (prerus program, nastavi pocatecni parametry}
    FSTATUS: TULObjFldAutoCon;//   = 0 vypnuto, 1 cerpa, 2 purge, >=256 bezi program, < 0 chyba
    FSTART: TULObjFldAutoCon;//   = 0 vypnuto, 1 cerpa, 2 purge, >=256 bezi program, < 0 chyba

  public
    constructor Create(AOwner: TComponent; AChannel: TChannel); reintroduce;
  published
    property PRGACTN: TULObjFldAutoCon read FPRGACTN write FPRGACTN;
    property PRGRUN: TULObjFldAutoCon read FPRGRUN write FPRGRUN;
    property PRGEND: TULObjFldAutoCon read FPRGEND write FPRGEND;
    property STATUS: TULObjFldAutoCon read FSTATUS write FSTATUS;
    property START: TULObjFldAutoCon read FSTART write FSTART;
  end;

implementation

constructor TSModule.Create(AOwner: TComponent; AChannel: TChannel;
   const ADeviceName: TDeviceName; ADeviceType: TDeviceType;
   AFailOnNotFound: boolean);

begin
  inherited Create(AOwner);
  FChannel := AChannel;
  FDeviceName := ADeviceName;
  FDeviceType := ADeviceType;
  FFailOnNotFound := AFailOnNotFound;
  FModule := nil;
  FindModule;
  GetULFields;
end;

procedure TSModule.FindModule;
var
  m, cm: TModule;
  i, j: integer;
begin
  {m := nil;}
  for i := 0 to Modules.Count - 1 do begin
    m := Modules[i]; {modulu}
    if ((FDeviceName = '') or (m.DeviceName = FDeviceName))
       and
       ((FDeviceType = dtUnknown) or (m.DeviceType = FDeviceType)) then
    begin
      if FChannel = nil then begin
        FModule := m;
        break;
      end else begin
        for j := 0 to FChannel.DeviceCount - 1 do begin
          cm := FChannel.Devices[j];
          if m.DeviceName = cm.DeviceName then begin
            FModule := m;
            break;
          end;
        end;
        if FModule <> nil then
          break;
        {channelsu}
      end;
    end;{ulantype}
  end;
  if FModule = nil then
    raise Exception.Create('SModule.FindModule Failed ' + FDeviceName);

  {
  FP1 := FindULDR('P1');
  FP2 := FindULDR('P2');
  FAS := FindULDR('AS');
  FIK := FindULDR('IK');
  FDET := FindULDR('DET');
  if not Modules.FindModuleWithPropVal(piDeviceName, 'DET', m) then
    raise Exception.Create('Module DeviceName=DET not found in Modules');
  if not m.FindPropByDesc('CHA', FCHAProp) then
    raise  Exception.Create('Property CHA not found in Module DET');
  if not m.FindPropByDesc('CHB', FCHBProp) then
    raise  Exception.Create('Property CHB not found in Module DET');
  }
end;

{
function TAAA.FindULDR(const AAAObjPropName: string): TULDRObj;
var o: TULObj;
begin
  if ULFKeeper.FindByULObjPath(AAAObjPropName, 0, o) and
    (o is TULDRObj)
  then begin
    Result := TULDRObj(o);
  end else begin
    raise Exception.Create('AAA ' + AAAObjPropName + ' not found.');
  end;
end;
}

procedure TSModule.GetULFields;
var
  i: integer;
  n: shortstring;
  value: ansistring;
  f: TULObjFldAutoCon;
  pi: PPropInfo;
begin
  i := 0;
  while ClassGetPropNameAndValue(Self, i, n, value) do begin
    if ClassGetPropInfo(Self, n, pi) then begin
      if pi^.PropType^^.Name = 'TULObjFldAutoCon' then begin
        {if pos('_', n) > 0 then begin}
        GetULField(n, f);
        SetOrdProp(Self, pi, integer(f));
      end;
    end;
    inc(i);
  end;
end;

procedure TSModule.GetULField(const AAAPropName: string; var AField: TULObjFldAutoCon);
var
  o: TULDPObj;
begin
  o := FindULDP(AAAPropName);
  if o <> nil then
    AField := TULObjFldAutoCon(o.FindField(pvValueInPC))
  else
    AField := nil;
end;

function TSModule.FindULDP(const AAAObjPropName: string): TULDPObj;
{ as GeTULDP but raises exception if not found }
var o: TULDPObj;
begin
  if not GetULDP(AAAObjPropName, o) then begin
    if FFailOnNotFound then
      raise Exception.Create('AAA ' + AAAObjPropName + ' not found.')
    else
      o := nil;
  end;
  Result := o;
end;

function TSModule.GetULDP(const AAAObjPropName: string; var AULDP:TULDPObj): boolean;
{ find uldp object that corresponds to property name of TAAAObj
 (i.e. to what uldpobj should be assigned these initial values }
var
  dn, pn: string;
  o: TULObj;
begin
  Result := false;
  dn := FModule.DeviceName;
  pn := AAAObjPropName;
  if ULFKeeper.FindByULObjPath(dn + '.' + pn, 0, o) then begin
    if o is TULDPObj then begin
      AULDP := TULDPObj(o);
      Result := true;
      exit;
    end;
  end;
  {
  i := pos('_', AAAObjPropName);
  if i > 0 then begin
    dn := copy(AAAObjPropName, 1, i - 1);
    pn := copy(AAAObjPropName, i + 1, length(AAAObjPropName));
    if ULFKeeper.FindByULObjPath(dn + '.' + pn, 0, o) then begin
      if o is TULDPObj then begin
        AULDP := TULDPObj(o);
        Result := true;
        exit;
      end;
    end;
  end;
  }
end;

constructor TPumpModule.Create(AOwner: TComponent; AChannel: TChannel);
begin
  inherited Create(AOwner, AChannel, '', dtPump, false);
end;

end.
