{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
unit MCAD_MI1201_Range;

interface
  USES Classes, SysUtils,Registry, MultiThreadList, MITypes;

const
  cRange='Range';

type
  tFlag=(fInactiveRange, fClearRange, fUseExistingPoints, fRepeatBack,
         fAccumulation, fGlobalAccumulation, fPointProcessed);
const
  cFlagsChar:array[tFlag] of char=('I','C','U','R','A','G','P');

type
  tFlags=set of tFlag;
  tRangeItem=( riMin, riMax, riStep, riTime, riRepeatCount, riEnabled, riFlags,
               riDescription);
  tRangeItems=set of tRangeItem;
  tRangeChangeNotification=procedure(Sender:TObject; AItem:tRangeItem) of object;
  tRangeState=(rsNo, rsYes, rsUseGlobal);

const
  cRangeFlags=[Low(tFlag)..High(tFlag)];

type
  tRange=class(TObject)
    private
      prMin,prMax,prStep,prMass:tMass;
      prIntegrationTime:word;
      prRepeatCount:cardinal;
      prFlags:tFlags;
      prOnChange:tRangeChangeNotification;
      prOwner:TObject;
      prIndex:integer;
      prDescription:string;
      prStart,prStop:cardinal;
      procedure DoOnChange(AItem:tRangeItem);
      procedure ActiveSet(AState:boolean);
      function ActiveGet:boolean;
      procedure ClearOnStartSet(AState:boolean);
      function ClearOnStartGet:boolean;
      procedure AccumulationSet(AState:tRangeState);
      function  AccumulationGet:tRangeState;
      procedure UseExistingPointsSet(AState:boolean);
      function  UseExistingPointsGet:boolean;
      procedure PointProcessedSet(AState:boolean);
      function  PointProcessedGet:boolean;
      procedure IntegrationTimeSet(ATime:word);
      procedure MinSet(AMass:tMass);
      procedure MaxSet(AMass:tMass);
      procedure StepSet(AStep:tMass);
      function OwnerGet:TObject;
      procedure DescriptionSet(const ADescription:String);
    public
      property Description:string read prDescription write DescriptionSet;
      constructor Create(AOwner:TObject);
      destructor Destroy; override;
      property Owner:TObject read OwnerGet;

      procedure Assign(ARange:tRange);
      property Flags:tFlags read prFlags;


      property Min:tMass read prMin write MinSet;
      property Max:tMass read prMax write MaxSet;
      property Step:tMass read prStep write StepSet;
      property IntegrationTime:word read prIntegrationTime write IntegrationTimeSet;
      property RepeatCount:cardinal read prRepeatCount write prRepeatCount;

      property Enabled:boolean read ActiveGet write ActiveSet;
      property ClearOnStart:boolean read ClearOnStartGet write ClearOnStartSet;
      property Accumulation:tRangeState read AccumulationGet write AccumulationSet;
      property UseExistingPoints:boolean read UseExistingPointsGet write UseExistingPointsSet;
      property PointProcessed:boolean read PointProcessedGet write PointProcessedSet;

      procedure WriteToRegistry(ARegistry:tRegistry);
      procedure ReadFromRegistry(ARegistry:tRegistry);

      property OnChange:tRangeChangeNotification read prOnChange write prOnChange;

      property Index:integer read prIndex write prIndex;
      property Mass:tMass read prMass write prMass;

      function MassInRange(AMass,dM:tMass):boolean;
      function InRange(dM:tMass):boolean;
      procedure ResetMass(AStepMul:integer);
      function StartMass(AStepMul:integer):tMass;
      function RangeCaption(i:integer):string;
      function RangeMassCaption(i:integer):string;
      function RangeCaptionEx(i:integer; AItems:tRangeItems):string;
      property StartTime:cardinal read prStart write prStart;
      property StopTime:cardinal read prStop write prStop;
  end;

  tRangesFlag=(fChanged);
  tRangesFlags=set of tRangesFlag;
  tRangeListChangeNotification=procedure(Sender:TObject; ARangeIndex:integer; AItem:tRangeItem) of object;
  tRangeList=class(tMultiThreadList)
   private
     prOnChangeRange:tRangeListChangeNotification;
     prOnChange:tNotifyEvent;
     prActiveList:tMultiThreadList;
     prFlags:tRangesFlags;
     function Get(i:integer):tRange;
     procedure Put(i:integer; ARange:tRange);
     procedure HandleOnChange(Sender:TObject; AItem:tRangeItem);
     procedure DoOnChangeRange(ARangeIndex:integer; AItem:tRangeItem); virtual;
     procedure DoOnChange; virtual;
     function  ChangedGet:boolean;
     procedure ChangedSet(AState:boolean);
     function  ActiveGet(i:integer):tRange;
     function  ActiveCountGet:integer;
     function  ActiveAdd(ARange:tRange):integer;
     function  ActiveRemove(ARange:tRange):integer;
   public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    function Add(ARange:tRange):Integer;
    function Remove(ARange:tRange):Integer;
    procedure Delete(Index:Integer);
    function  New:tRange;
    function  NewI:integer;
    function  MoveUp(i:integer):integer;
    function  MoveDown(i:integer):integer;
    procedure ActiveSort;
    property  Ranges[i:integer]:tRange read Get write Put; default;
    procedure WriteToRegistry(ARegistry:tRegistry);
    procedure ReadFromRegistry(ARegistry:tRegistry);
    property OnChangeRange:tRangeListChangeNotification read prOnChangeRange write prOnChangeRange;
    property OnChange:tNotifyEvent read prOnChange write prOnChange;
    property ActiveCount:integer read ActiveCountGet;
    property ActiveRanges[i:integer]:tRange read ActiveGet;
    property Changed:boolean read ChangedGet write ChangedSet;
  end;

  tRangeListCollectionItem=class(tCollectionItem)
  end;

  tRangeListCollection=class(tCollection)
    private
    public
  end;

implementation

procedure tRange.DescriptionSet(const ADescription:String);
begin
  if ADescription=Description then Exit;
  prDescription:=ADescription;
  DoOnChange(riDescription);
end;

function xFloatToStr(x:double):string;
begin
  Result:=FloatToStrF(x,ffGeneral,6,4);
end;

function tRange.RangeCaptionEx(i:integer; AItems:tRangeItems):string;
  var f:tFlag; fs:tFlags;
begin
  if (riDescription in AItems) then begin
    Result:=Description;
    if Result<>'' then Result:=Result;
  end;
  if i>=0 then
    Result:=Result+' N='+IntToStr(i);
  if (riMin in AItems) and (riMax in AItems) and (riStep in AItems) then begin
    Result:=Result+' ['+xFloatToStr(Min)+'..'+xFloatToStr(Max)  +'; '+xFloatToStr(Step)+'].';
  end else if (riMin in AItems) and (riMax in AItems) then begin
    Result:=Result+' ['+xFloatToStr(Min)+' .. '+xFloatToStr(Max)+'].';
  end else begin
    if (riMin in AItems) then
      Result:=Result+' Min='+xFloatToStr(Min);
    if (riMax in AItems) then
      Result:=Result+' Max='+xFloatToStr(Max);
    if (riStep in AItems) then
      Result:=Result+' Шаг='+xFloatToStr(Step);
  end;
  if (riTime in AItems) then
    Result:=Result+' T='+IntToStr(IntegrationTime);
  if (riFlags in AItems) then begin
    fs:=Flags;
    Result:=Result+' F=';
    for f:=Low(f) to High(f) do begin
      if f in fs then begin
        Result:=Result+cFlagsChar[f];
      end;
    end;
  end;
end;

function tRange.RangeMassCaption(i:integer):string;
begin
  Result:=RangeCaptionEx(i, [riDescription,riMin,riMax,riStep]);
end;

function tRange.RangeCaption(i:integer):string;
begin
  Result:=RangeCaptionEx(i, [riDescription,riMin,riMax,riStep,riTime]);
end;

function tRangeList.ChangedGet:boolean;
begin
  Result:=fChanged in prFlags;
end;

procedure tRangeList.ChangedSet(AState:boolean);
begin
  If AState then Include(prFlags,fChanged)
  else Exclude(prFlags,fChanged);
end;

function CompareRangeIndex(Item1, Item2: Pointer): Integer;
begin
  Result:=tRange(Item1).Index-tRange(Item2).Index;
end;

function tRangeList.ActiveAdd(ARange:tRange):integer;
begin
  Result:=-1;
  if not ARange.Enabled then Exit;
  Result:=prActiveList.IndexOf(ARange);
  if Result=-1 then begin
    Result:=prActiveList.Add(ARange);
    ActiveSort;
  end;
end;

procedure tRangeList.ActiveSort;
  var i:integer;
begin
  BeginWrite;
  try
    for i:=0 to Pred(Count) do begin
      Ranges[i].Index:=i;
    end;
    prActiveList.Sort(CompareRangeIndex);
  finally
    EndWrite;
  end;
end;

function tRangeList.ActiveRemove(ARange:tRange):integer;
begin
  BeginWrite;
  try
    Result:=prActiveList.IndexOf(ARange);
    if Result>=0 then
    prActiveList.Delete(Result);
  finally
    EndWrite;
  end;
end;

function tRangeList.ActiveGet(i:integer):tRange;
begin
  Result:=tRange(prActiveList.Items[i]);
end;

function tRangeList.ActiveCountGet:integer;
begin
  Result:=prActiveList.Count;
end;

constructor tRangeList.Create;
begin
  Inherited;
  prActiveList:=tMultiThreadList.Create;
end;

procedure tRange.Assign(ARange:tRange);
begin
  Description:=ARange.Description;
  Min:=ARange.Min;
  Max:=ARange.Max;
  Step:=ARange.Step;
  Step:=ARange.Step;
  IntegrationTime:=ARange.IntegrationTime;
  RepeatCount:=ARange.RepeatCount;
  prFlags:=ARange.Flags+[fInactiveRange];
  Mass:=ARange.Mass;
end;

function tRange.MassInRange(AMass,dM:tMass):boolean;
begin
  if Assigned(Self) then
    Result:=(Min<=(AMass+dM)) and ((AMass-dM)<=Max)
  else
    Result:=FALSE;
end;

function tRange.InRange(dM:tMass):boolean;
begin
  if Assigned(Self) then
    Result:=(Min<=(Mass+dM)) and ((Mass-dM)<=Max)
  else
    Result:=FALSE;
end;

function tRange.StartMass(AStepMul:integer):tMass;
begin
  if (Step*AStepMul)>=0 then
    Result:=Min
  else
    Result:=Max;
end;

procedure tRange.ResetMass(AStepMul:integer);
begin
  if (Step*AStepMul)>=0 then
    Mass:=Min
  else
    Mass:=Max;
end;

function tRange.OwnerGet:TObject;
begin
  if Assigned(Self) then
    Result:=prOwner
  else
    Result:=NIL;
end;

procedure tRange.IntegrationTimeSet(ATime:word);
begin
  if ATime=IntegrationTime then Exit;
  prIntegrationTime:=ATime;
  DoOnChange(riTime);
end;

procedure tRange.MinSet(AMass:tMass);
begin
  if AMass=Min then Exit;
  prMin:=AMass;
  DoOnChange(riMin);
end;

procedure tRange.MaxSet(AMass:tMass);
begin
  if AMass=Max then Exit;
  prMax:=AMass;
  DoOnChange(riMax);
end;

procedure tRange.StepSet(AStep:tMass);
begin
  if AStep=Step then Exit;
  prStep:=AStep;
  DoOnChange(riStep);
end;

procedure tRange.DoOnChange(AItem:tRangeItem);
begin
  if Assigned(OnChange) then
    OnChange(Self, AItem);
end;

procedure tRangeList.DoOnChangeRange(ARangeIndex:integer; AItem:tRangeItem);
begin
  if Assigned(OnChangeRange) then begin
    Changed:=TRUE;
    OnChangeRange(Self, ARangeIndex, AItem);
  end;
end;

procedure tRangeList.DoOnChange;
begin
  if Assigned(OnChange) then begin
    Changed:=TRUE;
    OnChange(Self);
  end;
end;

procedure tRangeList.HandleOnChange(Sender:TObject; AItem:tRangeItem);
  var i:integer;
begin
  i:=IndexOf(Sender);
  if i=-1 then Exit;
  case AItem of
    riEnabled: begin
      if (Sender as tRange).Enabled then
        ActiveAdd(tRange(Sender))
      else
        ActiveRemove(tRange(Sender));
    end;
  end;
  if i>=0 then begin
    DoOnChangeRange(i,AItem);
  end;
end;

procedure tRange.WriteToRegistry(ARegistry:tRegistry);
begin
  ARegistry.WriteString('Description',Description);
  ARegistry.WriteFloat('Min',Min);
  ARegistry.WriteFloat('Max',Max);
  ARegistry.WriteFloat('Step',Step);
  ARegistry.WriteInteger('IntegrationTime',IntegrationTime);
  ARegistry.WriteBinaryData('Flags',prFlags,SizeOf(prFlags));
  ARegistry.WriteInteger('RepeatCount',Integer(prRepeatCount));
end;

procedure tRange.ReadFromRegistry(ARegistry:tRegistry);
begin
  Description:=ARegistry.ReadString('Description');
  Min:=ARegistry.ReadFloat('Min');
  Max:=ARegistry.ReadFloat('Max');
  Step:=ARegistry.ReadFloat('Step');
  IntegrationTime:=ARegistry.ReadInteger('IntegrationTime');
  ARegistry.ReadBinaryData('Flags',prFlags,SizeOf(prFlags));
  Integer(prRepeatCount):=ARegistry.ReadInteger('RepeatCount');
end;

constructor tRange.Create(AOwner:TObject);
begin
  Inherited Create;
  prOwner:=AOwner;
end;

destructor tRange.Destroy;
begin
  Inherited Destroy;
end;

function tRangeList.NewI:integer;
  var r:tRange;
begin
  r:=tRange.Create(Self);
  if Assigned(r) then
    Result:=Add(r)
  else
    Result:=-1;
end;

function tRangeList.New:tRange;
begin
  Result:=tRange.Create(Self);
  if Assigned(Result) then
    Add(Result);
end;

function tRangeList.Add(ARange:tRange):Integer;
begin
  if IndexOf(ARange)<>-1 then begin
    Result:=-1;
    Exit;
  end;
  Result:=Inherited Add(Pointer(ARange));
  ARange.OnChange:=HandleOnChange;
  ActiveAdd(ARange);
  DoOnChange;
end;

function tRangeList.Remove(ARange:tRange):Integer;
begin
  Result:=Inherited Remove(Pointer(ARange));
  if Result>=0 then begin
    ARange.Enabled:=FALSE;
    prActiveList.Remove(ARange);
    DoOnChange;
    if ARange.Owner=Self then
      ARange.Free;
  end;
end;

procedure tRangeList.Delete(Index:Integer);
  var r:tRange;
begin
  if (Index>=0) and (Index<Count) then
    r:=Ranges[Index]
  else
    r:=NIL;
  inherited Delete(Index);
  prActiveList.Remove(r);
  if r.Owner=Self then r.Free;
end;

function tRangeList.Get(i:integer):tRange;
begin
  Result:=tRange(inherited Get(i));
end;

procedure tRangeList.Put(i:integer; ARange:tRange);
  var chg:boolean;
begin
  chg:=Pointer(ARange)<>Items[i];
  inherited Put(i,Pointer(ARange));
  if chg then begin
    ActiveAdd(ARange);
    DoOnChange;
  end;
end;

procedure tRangeList.WriteToRegistry(ARegistry:tRegistry);
  var i:integer; Root,s:string;
begin
  Root:='\'+ARegistry.CurrentPath;
  try
    for i:=0 to Pred(Count) do begin
      if ARegistry.OpenKey(Root+'\'+cRange+IntToStr(i),TRUE) then begin
        Ranges[i].WriteToRegistry(ARegistry);
      end;
    end;
    i:=Count;
    ARegistry.OpenKey(Root,TRUE);
    while i<High(i) do begin
      s:=cRange+IntToStr(i);
      if ARegistry.KeyExists(s) then begin
        ARegistry.DeleteKey(s);
        Inc(i);
      end else begin
        i:=High(i)
      end;
    end;
  finally
    ARegistry.OpenKey(Root,TRUE);
  end;
end;

procedure tRangeList.ReadFromRegistry(ARegistry:tRegistry);
  var i:integer; Root,s:string; r:tRange;
      OldEnabled:boolean;
begin
  Root:='\'+ARegistry.CurrentPath;
  try
    i:=0;
    while i<High(i) do begin
      s:=cRange+IntToStr(i);
      ARegistry.OpenKey(Root,TRUE);
      if ARegistry.KeyExists(s) then begin
        if ARegistry.OpenKeyReadOnly(s) then begin
          if i>=Count then r:=New
          else r:=Ranges[i];
          if Assigned(r) then begin
            OldEnabled:=r.Enabled;
            r.ReadFromRegistry(ARegistry);
            if OldEnabled<>r.Enabled then begin
              if r.Enabled then
                prActiveList.Add(r)
              else
                prActiveList.Remove(r);
            end;
          end;
        end;
        Inc(i);
      end else begin
        i:=High(i)
      end;
    end;
  finally
    ARegistry.OpenKey(Root,TRUE);
  end;
end;

function tRangeList.MoveUp(i:integer):integer;
begin
  Result:=-1;
  if i>0 then begin
    if Count>i then begin
      Exchange(i,Pred(i));
      ActiveSort;
      DoOnChange;
    end;
  end;
end;

function tRangeList.MoveDown(i:integer):integer;
begin
  Result:=-1;
  if (i>=0) and (i<Count) then begin
    if i<Count then begin
      Exchange(i,Succ(i));
      ActiveSort;
      DoOnChange;
    end;
  end;
end;

procedure tRange.ActiveSet(AState:boolean);
begin
  if AState=Enabled then Exit;
  if AState then begin
    Exclude(prFlags,fInactiveRange);
  end else begin
    Include(prFlags,fInactiveRange);
  end;
  DoOnChange(riEnabled);
end;

function tRange.ActiveGet:boolean;
begin
  Result:=not (fInactiveRange in prFlags);
end;

procedure tRange.ClearOnStartSet(AState:boolean);
begin
  if AState=ClearOnStart then Exit;
  if AState then begin
    Include(prFlags,fClearRange);
  end else begin
    Exclude(prFlags,fClearRange);
  end;
  DoOnChange(riFlags);
end;

function tRange.ClearOnStartGet:boolean;
begin
  Result:=(fClearRange in prFlags);
end;

procedure tRange.AccumulationSet(AState:tRangeState);
begin
  if AState=Accumulation then Exit;
  case AState of
    rsNo: begin
      Exclude(prFlags,fAccumulation);
      Exclude(prFlags,fGlobalAccumulation);
    end;
    rsYes: begin
      Include(prFlags,fAccumulation);
      Exclude(prFlags,fGlobalAccumulation);
    end;
    rsUseGlobal: begin
      Include(prFlags,fGlobalAccumulation);
    end;
  end;
  DoOnChange(riFlags);
end;

function tRange.AccumulationGet:tRangeState;
begin
  if (fGlobalAccumulation in prFlags) then
    Result:=rsUseGlobal
  else if (fAccumulation in prFlags) then
    Result:=rsYes
  else
    Result:=rsNo
end;

procedure tRange.PointProcessedSet(AState:boolean);
begin
  if AState=PointProcessed then Exit;
  if AState then begin
    Include(prFlags,fPointProcessed);
  end else begin
    Exclude(prFlags,fPointProcessed);
  end;
end;

function  tRange.PointProcessedGet:boolean;
begin
  Result:=(fPointProcessed in prFlags);
end;

procedure tRange.UseExistingPointsSet(AState:boolean);
begin
  if AState=UseExistingPoints then Exit;
  if AState then begin
    Include(prFlags,fUseExistingPoints);
  end else begin
    Exclude(prFlags,fUseExistingPoints);
  end;
  DoOnChange(riFlags);
end;

function  tRange.UseExistingPointsGet:boolean;
begin
  Result:=(fUseExistingPoints in prFlags);
end;

destructor tRangeList.Destroy;
  var i:integer;
begin
  prActiveList.Free;
  for i:=Pred(inherited Count) downto 0 do begin
    if Ranges[i].Owner=Self then
      Ranges[i].Free;
    inherited Delete(i);
  end;
  inherited;
end;

procedure tRangeList.Clear;
  var i:integer;
begin
  BeginWrite;
  try
    for i:=Pred(prActiveList.Count) downto 0 do begin
      prActiveList.Delete(i);
    end;
    for i:=Pred(inherited Count) downto 0 do begin
      if Ranges[i].Owner=Self then
        Ranges[i].Free;
      inherited Delete(i);
    end;
  finally
    EndWrite;
  end;
  DoOnChange;
end;


end.