unit SModulu;{ Objects for controlling individual hardware devices. Deprecated. }
{
  (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.
}
{$I DEFINE.PAS}
interface
uses
  Windows, Messages, SysUtils, Classes, Dialogs, Math, TypInfo,

  Timer, BinHex, UtlType, WinUtl, PropUtl, ExeLogu, InfoFrm,

  UlanType, UlanGlob,

  ULDrvTyp,

  ULRecTyp, ULObju, ULDType, ULDObju,
  ULDPType, ULDPObju, ULDRType, ULDRObju, ULFObju,
  ModuType,
  {$IFDEF USEDLL}
  ModuProc,
  {$ELSE}
  Modulu, ModuUtl, ULDrvUtl, ULDriver, ModActu,
  {$ENDIF}

  {$IFDEF DEBUG}
  DebugFrm,
  {$ENDIF}
  ULLType, ULLObju, ULNType, ULNObju, ULNDType, ULNDObju,
  ExtDevIntu, 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;

  {v0.47}
  TAutoSamplerModule = class(TSModule){uld.asc}
  private
    FPREPSAMP: TULObjFldAutoCon;
    FSAMPNUM: TULObjFldAutoCon;
    FASLOAD: TULObjFldAutoCon;
    FASPREPARE: TULObjFldAutoCon;
    FCALLPS: TULObjFldAutoCon;
    FINJECT: TULObjFldAutoCon;
    FTEMP_ON: TULObjFldAutoCon;
    FTEMP_OFF: TULObjFldAutoCon;
    FTEMP1RQ: TULObjFldAutoCon;
    FTEMP1: TULObjFldAutoCon;
    FOFF: TULObjFldAutoCon;
    FERRCLR: TULObjFldAutoCon;
    FTEMP_ST: TULObjFldAutoCon;
    FSTATUS: TULObjFldAutoCon;
    FON: TULObjFldAutoCon;
    function GetState: TASState;
  public
    constructor Create(AOwner: TComponent; AChannel: TChannel); reintroduce;
    property State: TASState read GetState;
  published
    property PREPSAMP: TULObjFldAutoCon read FPREPSAMP write FPREPSAMP;
    property SAMPNUM: TULObjFldAutoCon read FSAMPNUM write FSAMPNUM;
    property ASLOAD: TULObjFldAutoCon read FASLOAD write FASLOAD;
    property ASPREPARE: TULObjFldAutoCon read FASPREPARE write FASPREPARE;
    property CALLPS: TULObjFldAutoCon read FCALLPS write FCALLPS;
    property INJECT: TULObjFldAutoCon read FINJECT write FINJECT;
    property TEMP_ON: TULObjFldAutoCon read FTEMP_ON write FTEMP_ON;
    property TEMP_OFF: TULObjFldAutoCon read FTEMP_OFF write FTEMP_OFF;
    property TEMP1RQ: TULObjFldAutoCon read FTEMP1RQ write FTEMP1RQ;
    property TEMP1: TULObjFldAutoCon read FTEMP1 write FTEMP1;
    property OFF: TULObjFldAutoCon read FOFF write FOFF;
    property ERRCLR: TULObjFldAutoCon read FERRCLR write FERRCLR;
    property TEMP_ST: TULObjFldAutoCon read FTEMP_ST write FTEMP_ST;
    property STATUS: TULObjFldAutoCon read FSTATUS write FSTATUS;
    property ON: TULObjFldAutoCon read FON write FON;
  end;{aaau}

  {/v0.47}

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
  {$IFDEF USEDLL}
  for i := 0 to ModulesCount(Modules) do begin
    m := ModulesModule(Modules, i);
    if ((FDeviceName = '') or (ModuleGetPropStr(m, mpDeviceName) = FDeviceName))
       and
       ((FDeviceType = dtUnknown) or (TDeviceType(ModuleGetPropInt(m, mpDeviceType)) = 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 ModuleGetPropStr(m, mpDeviceName) = ModuleGetPropStr(cm, mpDeviceName) then begin
            FModule := m;
            break;
          end;
        end;
        if FModule <> nil then
          break;
        {channelsu}
      end;
    end;{ulantype}

  end;
  {$ELSE}
  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;
  {$ENDIF}
  if FModule = nil then
    raise Exception.Create('SModule.FindModule Failed ' + FDeviceName);
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;
  {$IFDEF USEDLL}
  dn := ModuleGetPropStr(FModule, mpDeviceName);
  {$ELSE}
  dn := FModule.DeviceName;
  {$ENDIF}
  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;

{v0.47}
constructor TAutoSamplerModule.Create(AOwner: TComponent; AChannel: TChannel);
begin
  inherited Create(AOwner, AChannel, '', dtAutoSampler, false);
end;
function TAutoSamplerModule.GetState: TASState;
begin
  {$IFDEF USEDLL}
  Result := TASState(ModulesIntToInt(Modules, mcnASStatusDecode,  STATUS.AsInteger));
  {$ELSE}
  Result := AS_STATUS_Decode(STATUS.AsInteger);
  {$ENDIF}
end;
{/v0.47}
end.
