{---------------------------------------------------------------------------
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_TChartSeries;

interface
  Uses Classes, SysUtils, Registry, TeEngine, Series,
       McadUserTypes, MassClbr;

const
  cEOL=#13#10;
  cSignature1=#13#10'MI1201 Series v.'+cEOL;
  cSignature=#13#10'MI1201 Series v. 01.00'+cEOL;
  cVersion=0003;

type

  tMSChartValuesList=class(tChartValueList)
   private
   protected
   public
    constructor Create(AOwner:TChartSeries; const AName:string); override;
    destructor Destroy; override;
    procedure ReadData(AStream:tStream);
    procedure WriteData(AStream:tStream);
  end;

  tMSSeriesFlag=(fPointsNumberChanged);
  tMSSeriesFlags=set of tMSSeriesFlag;
  tMSSeries=class(TLineSeries)
   private
    prFlags:tMSSeriesFlags;
    prXShift,prXShiftPlusOne,prDataSavedXShift:double;
    function  Path(APath:string):string;
    function  PointsNumberChangedGet:boolean;
    procedure SetXShift(aShift:double);
    function  CalculateShiftedX(X:double; aShiftPlusOne:double):double; overload;
   protected
    procedure ReadValues(AStream:tStream);
    procedure WriteValues(AStream:tStream);
    function  ReadDataVersionEx(AStream:tStream; const ASignature:string):cardinal;
    function  ReadDataVersion0001(AStream:tStream):cardinal;
    function  ReadDataVersion(AStream:tStream):cardinal;
    procedure WriteDataVersion(AStream:tStream);
    procedure ReadData0000(AStream:tStream);
    procedure ReadData0001(AStream:tStream);
    procedure ReadData0003(AStream:tStream);
    procedure WriteData0000(AStream:tStream);
    procedure WriteData0001(AStream:tStream);
    procedure WriteData0003(AStream:tStream);
   public
    constructor Create(AOwner:TComponent); override;
    constructor CreateEx(AOwner:TComponent; InitialCapacity:longint);

    function UpdateXY(X,Y:double):integer;
    function  AccumulateXY(X,Y:double; var dT:double):integer;
    function  SumUpY(X,Y:double):integer;
    property PointsNumberChanged:boolean read PointsNumberChangedGet;
    property Flags:tMSSeriesFlags read prFlags;

    procedure SaveParameters(Registry:tRegistry);
    procedure RestoreParameters(Registry:tRegistry);
    procedure WriteParameters(Registry:tRegistry);
    procedure ReadParameters(Registry:tRegistry);

    procedure ReadData(AStream:tStream);
    procedure WriteData(AStream:tStream);

    procedure ShiftXValues(dX:double);
    procedure RecalculateXValues(const OldCalibration,NewCalibration:tMassCalibration);
    procedure ConvertXValuesToMass(const Calibration:tMassCalibration; CounterShift:integer);
    procedure ConvertXValuesToCounter(const Calibration:tMassCalibration);


    function  FindFirstXAboveEqual(x:double):integer;
    function  FindLastXBelowEqual(x:double):integer;
    function  FindNearestX(x:double):integer;
    function  FindNeighbours(x:double; var iMin,iMax:integer):boolean;

    function  RangeXDeleteByIndexes(AMinIndex,AMaxIndex:integer):integer;
    function  RangeXDeleteByValues(AMinX,AMaxX:double):integer;

    procedure RangeXIndexesGet(AMinX,AMaxX:double; var AMinIndex,AMaxIndex:integer);
    function  RangePointsCount(AMinX,AMaxX:double):integer;

    function  RangeYPointsGet(var AMcadColumn:tColumn; ARows:tMatrixIndex; AMinX,AMaxX:double):integer;
    function  RangeXYPointsGet(var AMcadColumnX,AMcadColumnY:tColumn; ARows:tMatrixIndex; AMinX,AMaxX:double):integer;
    property  XShift:double read prXShift write SetXShift;
    property  DataSavedXShift:double read prDataSavedXShift;
    function  CalculateShiftedX(X:double):double; overload;
    function  CalculateInitialX(X:double):double;
  end;

implementation
  USES Windows,Graphics;


constructor tMSChartValuesList.Create(AOwner:TChartSeries; const AName:string);
begin
  Inherited Create(AOwner,AName);
end;

destructor tMSChartValuesList.Destroy;
begin
  Inherited;
end;

procedure tMSChartValuesList.ReadData(AStream:tStream);
  var c,xc:Cardinal; s:string; iPos:cardinal; i:integer; v:double;
begin
  iPos:=AStream.Position;
  try
    xc:=AStream.Read(c,SizeOf(c)); if xc<>SizeOf(c) then raise EReadError.Create(Name+': '+' ошибка чтения заголовка');
    SetLength(s,c);
    xc:=AStream.Read(s[1],c); if xc<>SizeOf(c) then raise EReadError.Create(Name+': '+' ошибка чтения имени');
    if s<>Name then begin
      raise EReadError.Create(Name+': '+' неправильное имя '+s);
    end;
    xc:=AStream.Read(c,SizeOf(c)); if xc<>SizeOf(c) then raise EReadError.Create(Name+': '+' ошибка чтения размера данных');
    for i:=0 to Pred(c) do begin
      xc:=AStream.Read(v,SizeOf(v));
      if xc<>SizeOf(v) then raise EReadError.Create(Name+': '+' ошибка чтения данных '+IntToStr(i));
    end;
  finally
    AStream.Seek(iPos,soFromBeginning);
  end;
end;

procedure tMSChartValuesList.WriteData(AStream:tStream);
  var c:Cardinal; i:integer; v:double;
begin
  c:=Length(Name);
  AStream.Write(c,SizeOf(c));
  AStream.Write(Name[1],c);
  c:=Count;
  AStream.Write(c,SizeOf(c));
  for i:=0 to Pred(c) do begin
    v:=Value[i];
    AStream.Write(v,SizeOf(v));
  end;
end;

constructor tMSSeries.Create(AOwner:TComponent);
begin
  prXShift:=0;
  prXShiftPlusOne:=1;
  prDataSavedXShift:=1;
  Inherited Create(AOwner);
end;

constructor tMSSeries.CreateEx(AOwner:TComponent; InitialCapacity:longint);
  var i:longint;
begin
  i:=TeeDefaultCapacity;
  if InitialCapacity>0 then begin
    TeeDefaultCapacity:=InitialCapacity;
  end;
  try
    Create(AOwner);
  finally
    if InitialCapacity>0 then
      TeeDefaultCapacity:=i;
  end;
end;

function tMSSeries.UpdateXY(X,Y:double):integer;
  var sx:double;
begin
  sx:=CalculateShiftedX(X);
  Result:=XValues.Locate(sx);
  if Result=-1 then begin
    Result:=AddXY(sx,Y);
    Include(prFlags,fPointsNumberChanged);
  end else begin
    YValues[Result]:=Y;
    Exclude(prFlags,fPointsNumberChanged);
  end;
end;

function tMSSeries.AccumulateXY(X,Y:double; var dT:double):integer;
  var sx:double;
begin
  sx:=CalculateShiftedX(X);
  Result:=XValues.Locate(sx);
  if Result=-1 then begin
    Result:=AddXY(sx,Y);
    Include(prFlags,fPointsNumberChanged);
  end else begin
    YValues[Result]:= (YValues[Result]+Y*dT)/(1+dT);
    Exclude(prFlags,fPointsNumberChanged);
  end;
end;

function  tMSSeries.SumUpY(X,Y:double):integer;
  var sx:double;
begin
  sx:=CalculateShiftedX(X);
  Result:=XValues.Locate(sx);
  if Result=-1 then begin
    Result:=AddXY(sx,Y);
    Include(prFlags,fPointsNumberChanged);
  end else begin
    YValues[Result]:= YValues[Result]+Y;
    Exclude(prFlags,fPointsNumberChanged);
  end;
end;

procedure tMSSeries.WriteParameters(Registry:tRegistry);
begin
  Registry.WriteBool('Active',Active);
  Registry.WriteInteger('SeriesColor',Ord(SeriesColor));
  Registry.WriteInteger('LinePen.Style',Ord(LinePen.Style));
  Registry.WriteInteger('LinePen.Width',LinePen.Width);
  Registry.WriteFloat('XShift',XShift);
end;

procedure tMSSeries.ReadParameters(Registry:tRegistry);
begin
  try
  Active:=Registry.ReadBool('Active');
  except end;
  try
  SeriesColor:=tColor(Registry.ReadInteger('SeriesColor'));
  except end;
  try
  LinePen.Style:=TPenStyle(Registry.ReadInteger('LinePen.Style'));
  except end;
  try
  LinePen.Width:=Registry.ReadInteger('LinePen.Width');
  except end;
  try
  prXShift:=Registry.ReadFloat('XShift');
  except end;
  if Abs(prXShift-1)<1E-3 then prXShift:=0;
  prXShiftPlusOne:=prXShift+1;
end;

procedure tMSSeries.SaveParameters(Registry:tRegistry);
  var rkey:String; ra:cardinal;
begin
  rkey:=Registry.CurrentPath;
  if rkey<>'' then begin
    ra:=Registry.Access;
    Registry.Access:=KEY_WRITE;
    try
      if Registry.OpenKey(Path(rkey),TRUE) then
        WriteParameters(Registry);
    finally
      Registry.Access:=ra;
      Registry.OpenKey('\'+rkey,FALSE);
    end;
  end;
end;

procedure tMSSeries.RestoreParameters(Registry:tRegistry);
  var rkey:String;
begin
  rkey:=Registry.CurrentPath;
  if rkey<>'' then begin
    try
      if Registry.OpenKeyReadOnly(Path(rkey)) then
        ReadParameters(Registry);
    finally
      Registry.OpenKey('\'+rkey,FALSE);
    end;
  end;
end;

function tMSSeries.Path(APath:string):string;
begin
  Result:=Title;
  if Result='' then Result:=Name;
end;

procedure tMSSeries.ShiftXValues(dX:double);
  var i:integer;
begin
  if dX=0 then exit;
  for i:=0 to Pred(Count) do begin
    XValues[i]:=XValues[i]+dX;
  end;
end;

procedure tMSSeries.RecalculateXValues(const OldCalibration,NewCalibration:tMassCalibration);
  var i:integer;
begin
  for i:=0 to Pred(Count) do begin
    XValues[i]:=CalculateShiftedX(NewCalibration.Convert(CalculateInitialX(XValues[i]),OldCalibration));
  end;
end;

procedure tMSSeries.ConvertXValuesToMass(const Calibration:tMassCalibration; CounterShift:integer);
  var i:integer;
begin
  for i:=0 to Pred(Count) do begin
    XValues[i]:=CalculateShiftedX(Calibration.Counter2Mass(Round(XValues[i])+CounterShift));
  end;
end;

procedure tMSSeries.ConvertXValuesToCounter(const Calibration:tMassCalibration);
  var i:integer;
begin
  for i:=0 to Pred(Count) do begin
    XValues[i]:=Calibration.Mass2Counter(CalculateInitialX(XValues[i]));
  end;
end;

function tMSSeries.ReadDataVersionEx(AStream:tStream; const ASignature:string):cardinal;
  var xc:integer; s:string; iPos:cardinal;
begin
  Result:=0;
  iPos:=AStream.Position;
  try
    SetLength(s,Length(ASignature));
    xc:=AStream.Read(s[1],Length(ASignature));
    if (xc=Length(ASignature)) and (s=ASignature) then begin
      xc:=AStream.Read(Result,SizeOf(Result));
      if xc<>SizeOf(Result) then
        raise EReadError.Create(Name+': '+' ошибка чтения версии');
    end else begin
      AStream.Seek(iPos,soFromBeginning);
    end
  except
    AStream.Seek(iPos,soFromBeginning);
    Raise;
  end;
end;

function tMSSeries.ReadDataVersion0001(AStream:tStream):cardinal;
begin
  Result:=ReadDataVersionEx(AStream, cSignature1);
end;

function tMSSeries.ReadDataVersion(AStream:tStream):cardinal;
begin
  Result:=ReadDataVersion0001(AStream);
  if Result=1 then Exit;
  Result:=ReadDataVersionEx(AStream, cSignature);
end;

procedure tMSSeries.WriteDataVersion(AStream:tStream);
  var c:cardinal;
begin
  AStream.Write(cSignature[1],Length(cSignature));
  c:=cVersion;
  AStream.Write(c,SizeOf(c));
end;

procedure tMSSeries.ReadData(AStream:tStream);
  var ver:Cardinal;
begin
  ver:=ReadDataVersion(AStream);
  case ver of
    0000:       ReadData0000(AStream);
    0001,0002:  ReadData0001(AStream);
    0003:       ReadData0003(AStream);
    else begin
      raise EReadError.Create(Name+': '+' неподдерживаемая версия данных: '+IntToStr(ver));
    end;
  end;
end;

type
  EReadHeaderError=class(EReadError)
    constructor Create(AName:String);
  end;

  EReadNameError=class(EReadError)
    constructor Create(AName:String);
  end;

  EReadInvalidNameError=class(EReadError)
    constructor Create(AName, ASubName:String);
  end;

constructor EReadHeaderError.Create;
begin
  Inherited Create(AName+': ошибка чтения заголовка');
end;

constructor EReadNameError.Create;
begin
  Inherited Create(AName+': ошибка чтения имени');
end;

constructor EReadInvalidNameError.Create;
begin
  Inherited Create(AName+': неправильное имя '+ASubName);
end;

procedure tMSSeries.ReadData0000(AStream:tStream);
  var c,xc:Cardinal; s:string; iPos:cardinal;
begin
  iPos:=AStream.Position;
  try
    xc:=AStream.Read(c,SizeOf(c));
    if xc<>SizeOf(c) then
      raise EReadHeaderError.Create(Name);
    SetLength(s,c);
    xc:=AStream.Read(s[1],c);
    if xc<>c then
      raise EReadNameError.Create(Name);
    if (s<>Name) and (s<>ClassName) and (s<>'MsSeries') then begin
      raise EReadInvalidNameError.Create(Name,s);
    end;
    ReadValues(AStream);
  except
    AStream.Seek(iPos,soFromBeginning);
    Raise;
  end;
end;

procedure tMSSeries.ReadData0001(AStream:tStream);
  var c,xc:Cardinal; s:string; iPos:cardinal;
begin
  iPos:=AStream.Position;
  try
    xc:=AStream.Read(c,SizeOf(c));
    if xc<>SizeOf(c) then
      raise EReadHeaderError.Create(Name);
    SetLength(s,c);
    xc:=AStream.Read(s[1],c);
    if xc<>c then
      raise EReadNameError.Create(Name);
    if   (s<>(cEOL+Name+cEOL))
     and (s<>(cEOL+ClassName+cEOL))
     and (s<>(cEOL+'MsSeries'+cEOL)) then begin
      raise EReadInvalidNameError.Create(Name,s);
    end;
    ReadValues(AStream);
  except
    AStream.Seek(iPos,soFromBeginning);
    Raise;
  end;
end;

procedure tMSSeries.ReadData0003(AStream:tStream);
  var c:Cardinal; iPos:cardinal; 
begin
  iPos:=AStream.Position;
  try
    ReadData0001(AStream);
//    c:=AStream.Read(prXShift,SizeOf(prXShift));
    c:=AStream.Read(prDataSavedXShift,SizeOf(prDataSavedXShift));
    if c<>SizeOf(prDataSavedXShift) then
      raise EReadHeaderError.Create(Name);
  except
    AStream.Seek(iPos,soFromBeginning);
    Raise;
  end;
end;

procedure tMSSeries.WriteData(AStream:tStream);
begin
  case cVersion of
    0000:       WriteData0000(AStream);
    0001,0002:  WriteData0001(AStream);
    0003:       WriteData0003(AStream);
    else raise EReadError.Create(Name+': ошибка версии при записи данных');
  end;
end;

procedure tMSSeries.WriteData0000(AStream:tStream);
  var c:Cardinal;s:string;
begin
  s:=Name;
  if s='' then s:=ClassName;
  if s='' then s:='MsSeries';
  c:=Length(s);
  AStream.Write(c,SizeOf(c));
  AStream.Write(s[1],c);
  WriteValues(AStream);
end;

procedure tMSSeries.WriteData0001(AStream:tStream);
  var c:Cardinal; s:string;
begin
  WriteDataVersion(AStream);
  s:=Name;
  if s='' then s:=ClassName;
  if s='' then s:='MsSeries';
  s:=cEOL+s+cEOL;
  c:=Length(s);
  AStream.Write(c,SizeOf(c));
  AStream.Write(s[1],c);
  WriteValues(AStream);
end;

procedure tMSSeries.WriteData0003(AStream:tStream);
begin
  WriteData0001(AStream);
  AStream.Write(prXShift,SizeOf(prXShift));
end;

type
  tXY=record
    X,Y:double;
  end;

procedure tMSSeries.ReadValues(AStream:tStream);
  var xc:Cardinal; iPos:cardinal; i:integer; v:tXY;
begin
  iPos:=AStream.Position;
  try
    xc:=AStream.Read(i,SizeOf(i));
    if xc<>SizeOf(i) then
      raise EReadError.Create(Name+': '+' ошибка чтения размера данных');
    for i:=0 to Pred(i) do begin
      xc:=AStream.Read(v,SizeOf(v));
      if xc<>SizeOf(v) then
        raise EReadError.Create(Name+': '+' ошибка чтения данных '+IntToStr(i));
      AddXY(v.X,v.Y);
    end;
  except
    AStream.Seek(iPos,soFromBeginning);
    Raise;
  end;
end;

procedure tMSSeries.WriteValues(AStream:tStream);
  var i:integer; v:tXY;
begin
  i:=Count;
  AStream.Write(i,SizeOf(i));
  for i:=0 to Pred(i) do begin
    v.X:=XValues[i];
    v.Y:=YValues[i];
    AStream.Write(v,SizeOf(v));
  end;
end;

function  tMSSeries.FindFirstXAboveEqual(x:double):integer;
  var il,ir,im:Cardinal;
begin
  if Count=0 then begin
    Result:=-1;
  end else if x>XValues[Pred(Count)] then begin
    Result:=-1;
  end else if x<=XValues[0] then begin
    Result:=0;
  end else begin
    il:=0; ir:=Pred(Count);
    while (il<ir) do begin
      im:=(il+ir) shr 1;
      if XValues[im]>=x then
        ir:=im
      else
        il:=Succ(im);
    end;
    Result:=ir
  end;
end;

function  tMSSeries.FindLastXBelowEqual(x:double):integer;
  var il,ir,im:Cardinal;
begin
  if Count=0 then begin
    Result:=-1;
  end else if XValues[0]>x then begin
    Result:=-1;
  end else if x>XValues[Pred(Count)] then begin
    Result:=Pred(Count);
  end else begin
    il:=0; ir:=Pred(Count);
    while (il<ir) do begin
      im:=(il+ir) shr 1;
      if XValues[im]>x then
        ir:=im
      else
        il:=Succ(im);
    end;
    Result:=Pred(ir)
  end;
end;

function  tMSSeries.FindNearestX(x:double):integer;
begin
  Result:=FindFirstXAboveEqual(x);
  if Result=-1 then begin
    Result:=Pred(Count);
  end else begin
    if Result>0 then begin
       if Abs(XValues[Result]-x)>Abs(XValues[Pred(Result)]-x) then
          Dec(Result);
    end;
  end;
end;

function tMSSeries.FindNeighbours(x:double; var iMin,iMax:integer):boolean;
  var i:integer;
begin
  i:=FindFirstXAboveEqual(x);
  if i=-1 then begin
    iMax:=Pred(Count); iMin:=i;
    Result:=FALSE;
  end else if i=0 then begin
    iMax:=i; iMin:=i;
    Result:=FALSE;
  end else begin
    iMax:=i; iMin:=Pred(i);
    Result:=TRUE;
  end;
end;

procedure tMSSeries.RangeXIndexesGet(AMinX,AMaxX:double; var AMinIndex,AMaxIndex:integer);
  var x:double;
begin
  if AMinX>AMaxX then begin
    x:=AMaxX;
    AMaxX:=AMinX;
    AMinX:=x;
  end;
  AMinIndex:=FindFirstXAboveEqual(AMinX);
  AMaxIndex:=FindLastXBelowEqual(AMaxX);
end;

function tMSSeries.RangeXDeleteByIndexes(AMinIndex,AMaxIndex:integer):integer;
  var i:integer;
begin
  Result:=0;
  if (AMaxIndex<0) or (AMinIndex<0) then Exit;
  if AMaxIndex<AMinIndex then begin
    i:=AMaxIndex;
    AMaxIndex:=AMinIndex;
    AMinIndex:=i;
  end;
  if AMaxIndex>=Count then
    AMaxIndex:=Pred(Count);
  for i:=AMaxIndex downto AMinIndex do begin
    Delete(i);
  end;
  Result:=Succ(AMaxIndex-AMinIndex);
end;

function tMSSeries.RangeXDeleteByValues(AMinX,AMaxX:double):integer;
  var imin,imax:integer;
begin
  RangeXIndexesGet(AMinX,AMaxX, iMin,iMax);
  Result:=RangeXDeleteByIndexes(iMin,iMax);
end;

function tMSSeries.RangePointsCount(AMinX,AMaxX:double):integer;
  var i:integer;
begin
  RangeXIndexesGet(AMinX,AMaxX, i,Result);
  if (i<0) or (Result<0) then
    Result:=0
  else
    Dec(Result,Pred(i));
end;

function tMSSeries.RangeYPointsGet(var AMcadColumn:tColumn; ARows:tMatrixIndex; AMinX,AMaxX:double):integer;
  var imin,i:integer;
begin
  RangeXIndexesGet(AMinX,AMaxX, imin,Result);
  if (imin<0) or (Result<0) then begin
    Result:=0;
  end;
  Dec(Result,Pred(imin));
  if ARows<Result then
    Result:=ARows;
  for i:=0 to Pred(Result) do begin
    AMcadColumn[i]:=YValues[imin];
    Inc(imin);
  end;
end;

function  tMSSeries.RangeXYPointsGet(var AMcadColumnX,AMcadColumnY:tColumn; ARows:tMatrixIndex; AMinX,AMaxX:double):integer;
  var imin,i:integer;
begin
  RangeXIndexesGet(AMinX,AMaxX, imin,Result);
  if (imin<0) or (Result<0) then begin
    Result:=0;
  end;
  Dec(Result,Pred(imin));
  if ARows<Result then
    Result:=ARows;
  for i:=0 to Pred(Result) do begin
    AMcadColumnX[i]:=XValues[imin];
    AMcadColumnY[i]:=YValues[imin];
    Inc(imin);
  end;
end;

function  tMSSeries.PointsNumberChangedGet:boolean;
begin
  Result:= fPointsNumberChanged in Flags;
end;

procedure tMSSeries.SetXShift(aShift:double);
  var i:integer; lShiftPlusOne:double;
begin
  if Abs(aShift-1)<1E-3 then exit;
  lShiftPlusOne:=aShift+1;
  for i:=0 to Pred(Count) do begin
    XValues[i]:=CalculateShiftedX(CalculateInitialX(XValues[i]),lShiftPlusOne);
  end;
  prXShift:=aShift;
  prXShiftPlusOne:=lShiftPlusOne;
end;

function  tMSSeries.CalculateShiftedX(X:double):double;
begin
  Result:=X*prXShiftPlusOne;
end;

function  tMSSeries.CalculateShiftedX(X:double; aShiftPlusOne:double):double;
begin
  Result:=X*aShiftPlusOne;
end;

function  tMSSeries.CalculateInitialX(X:double):double;
begin
  Result:=X/prXShiftPlusOne;
end;

END.