Login | Register
My pages Projects Community openCollabNet

Discussions > cvs > CVS update [1.1]: /mathlib/src/

mathlib
Discussion topic

Back to topic list

CVS update [1.1]: /mathlib/src/

Reply

Author larin
Full name Serge Larin
Date 2004-04-19 08:37:28 PDT
Message Tag: 1.1
User: larin
Date: 04/04/19 08:37:28

Added:
 /mathlib/src/
  peakfun.pas, peakprm.pas, peaks.pas

Log:
 First public release on mathlib.tigris.org

File Changes:

Directory: /mathlib/src/
========================

File [added]: peakfun.pas
Url: http://mathlib.tigri​s.org/source/browse/​mathlib/src/peakfun.​pas?rev=1.1&cont​ent-type=text/vnd.vi​ewcvs-markup
Added lines: 0
--------------

File [added]: peakprm.pas
Url: http://mathlib.tigri​s.org/source/browse/​mathlib/src/peakprm.​pas?rev=1.1&cont​ent-type=text/vnd.vi​ewcvs-markup
Added lines: 0
--------------

File [added]: peaks.pas
Url: http://mathlib.tigri​s.org/source/browse/​mathlib/src/peaks.pa​s?rev=1.1&conten​t-type=text/vnd.view​cvs-markup
Added lines: 667
----------------
unit peaks;

interface
uses
  Math386,ASCII, PeakPrm, TA1Mfile, vafile,
  TeEngine, Classes, SysUtils, Series, Graphics, Chart;

type

  TCustomGraph = class
  private
    FColor: TColor;
    FCount: integer;
    FYData:PFloatArray;
    procedure SetColor(const Value: TColor);
    procedure SetCount(const Value: integer);virtual;
    function GetX(Index: integer): float;virtual;
    function GetY(Index: integer): float;virtual;
  public
    constructor Create;
    property Count:integer read FCount write SetCount;
    property X[Index:integer]:float read GetX;
    property Y[Index:integer]:float read GetY;
    property Color:TColor read FColor write SetColor;
    property YData:PFloatArray read FYData write FYData;
    destructor Destroy;override;
    procedure DrawGraph(Chart:TCha​rt);virtual;
  end;

  TCustomPeak = class (TCustomGraph)
  private
    Fv_Factor: float;
    Ft_Factor: float;
    FStepX: float;
    function GetMaxY: float;virtual;
    function GetPeakParam: TPeakParam;virtual;
    function GetMaxPeak: float;
  public
    constructor Create;
    property v_Factor:float read Fv_Factor write Fv_Factor;
    property t_Factor:float read Ft_Factor write Ft_Factor;
    property MaxY:float read GetMaxY;
    // Ìàêñèìàëüíîå çíà÷åíèå èç YData !!!
    property MaxPeak:float read GetMaxPeak;
    // Ìàêñèìàëüíîå çíà÷åíèå èç Y
    property PeakParam:TPeakParam read GetPeakParam;
    // Ïàðàìåòðû ïèêà
    property StepX:float read FStepX;
    // Çíà÷åíèå øàãà ïî X
  end;

  TSVAPeak = class(TCustomPeak)
  private
    FE_start: float;
    FE_end: float;
    FE_step: float;
    FConcentration: float;
    FBaseLineAngle: float;

    procedure SetE_start(const Value: float);
    procedure SetE_step(const Value: float);
    procedure SetE_end(const Value: float);
    function GetX(Index: integer): float;override;
  public
    constructor Create;
    property E_start:float read FE_start write SetE_start;
     // Íà÷àëüíûé ïîòåíöèàë
    property E_end:float read FE_end write SetE_end;
     // Êîíå÷íûé ïîòåíöèàë
    property E_step:float read FE_step write SetE_step;
     // Øàã ðàçâåðòêè
    property Concentration:float read FConcentration write FConcentration;
    property BaseLineAngle:float read FBaseLineAngle write FBaseLineAngle;
    procedure DrawGraph(Chart:TCha​rt);override;
  end;

  TSVAPeakWithBaseLine = class(TSVAPeak)
  private
    FBaseLine: PFloatArray;
    FUseBaseLine: boolean;
    FBaseLineColor: TColor;
    FDrawBaseLine: boolean;
    FTA1DataParam: TTA1DataParam;
    procedure SetCount(const Value: integer);override;
    function GetY(Index: integer): float;override;

  public
    property TA1DataParam:TTA1DataParam read FTA1DataParam write FTA1DataParam;
    constructor Create;
    property BaseLineColor:TColor read FBaseLineColor write FBaseLineColor;
    property UseBaseLine:boolean read FUseBaseLine write FUseBaseLine;
    property DrawBaseLine:boolean read FDrawBaseLine write FDrawBaseLine;
    property BaseLine:PFloatArray read FBaseLine write FBaseLine;
    procedure LoadFromTA1File(const FileName:string);virtual;
    procedure LoadFromVAFile(const FileName: string);virtual;
    procedure DrawGraph(Chart:TCha​rt);override;
    destructor Destroy;override;
  end;

    TVALABPeak = class(TSVAPeakWithBaseLine)
  private
    FBlankBackground:PFloatArray;
    FStandartData:PFloatArray;
    FAddingData:PFloatArray;
    FBlankBackgroundColor:TColor;
    FStandartDataColor:TColor;
    FAddingDataColor:TColor;
  public
    property BlankBackground:PFloatArray read FBlankBackground write FBlankBackground;
    property StandartData:PFloatArray read FStandartData write FStandartData;
    property AddingData:PFloatArray read FAddingData write FAddingData;
    property BlankBackgroundColor:TColor read FBlankBackgroundColor write FBlankBackgroundColor;
    property StandartDataColor:TColor read FStandartDataColor write FStandartDataColor;
    property AddingDataColor:TColor read FAddingDataColor write FAddingDataColor;
    procedure LoadFromVAFile(const FileName: string);override;
    procedure DrawGraph(Chart:TCha​rt);override;
    procedure SetCount(const Value: integer);override;
    constructor Create;
    destructor Destroy;override;
   end;


  TCustomCalibratGraph = class (TCustomGraph)
  private
    FXData: PFloatArray;
    function GetX(Index: integer): float;override;
    procedure SetCount(const Value: integer);override;
  public
    MaxPeak:float;
    property X[Index:integer]:float read GetX;
    property XData:PFloatArray read FXData write FXData;
    procedure DrawGraph(Chart:TCha​rt);override;
    destructor Destroy;override;
  end;

  TCalibratGraph = class (TCustomCalibratGraph)
  end;

  TGraphSeriesList = class(TStringList)
  private
  public
    procedure Clear;override;
    destructor Destroy;override;
  end;

implementation

{ TCustomPeak }

constructor TCustomPeak.Create;
begin
  inherited;
  Fv_Factor:=0.8;
  Ft_Factor:=0.2;
  FStepX := 1;
end;

function TCustomPeak.GetMaxPeak: float;
var
  i:integer;
begin
  for i:=1 to Pred(FCount) do
    if Y[i]<Y[Pred(i)] then
      begin
        Result := Y[Pred(i)];
        break;
      end;
end;

function TCustomPeak.GetMaxY: float;
var
  i:integer;
begin
  //
  Result := Y[0];
  for i:=0 to Pred(FCount) do
    begin
      if Result < Y[i] then
        Result := Y[i];
    end;
end;

function TCustomPeak.GetPeakParam: TPeakParam;
var
  i:integer;
  PPeakY:PFloatArray;

begin
//
  GetMem(PPeakY,FCount​*SizeOf(float));
  try
    for i:=0 to Pred(FCount) do
      PPeakY^[i] := Y[i];
    Peakprm.GetPeakParam​(FCount,PPeakY^,Fv_F​actor, Ft_factor, Result);
    with Result do
      begin
        MaxX := StepX*MaxX;
        Dvm := StepX*Dvm;
        Dvp := StepX*Dvp;
        D05m := StepX*D05m;
        D05p := StepX*D05p;
        Dtm := StepX*Dtm;
        Dtp := StepX*Dtp;
      end;
  finally
    FreeMem(PPeakY,FCoun​t*SizeOf(float));
  end;
end;

{ TSVAPeak }

constructor TSVAPeak.Create;
begin
  inherited;
  FE_step := 1;
  FE_start := 0;
end;


procedure TSVAPeak.DrawGraph(Chart: TChart);
var
  i:integer;
  E:float;
  YDataSeries:TLineSeries;
begin
  YDataSeries := TLineSeries.Create(Chart);
  YDataSeries.SeriesColor := FColor;
  Chart.AddSeries(YDataSeries);
  E := E_start;
  for i:=0 to Pred(FCount) do
    begin
      YDataSeries.AddXY(E,​FYData^[i],'',Color)​;
      E := E+E_step;
    end;
end;

procedure TSVAPeakWithBaseLine​.LoadFromTA1File(con​st FileName: string);

var
  i:integer;
begin
  if FCount<>0 then
    begin
      FreeMem(FYData, FCount*SizeOf(float));
      FreeMem(FBaseLine, FCount*SizeOf(float));
    end;
  try
    FCount := ReadTA1File(FileName, ReadBaseLine, FYData,FBaseLine,
                          FTA1DataParam);
  finally

  end;

  if FCount < 0 then
      FCount := 0
    else
      begin
        FE_start := TA1DataParam.E_start;
        FE_end := TA1DataParam.E_end;
        FE_step := (FE_end-FE_start)/FCount;
        FStepX := FE_step;
        for i:=0 to Pred(FCount) do
          begin
{$IFNDEF NOSCALE}
            FYData^[i] := FYData^[i]*CurrentCoeff;
            FBaseLine^[i] := FBaseLine^[i]*CurrentCoeff;
{$ENDIF}
          end;
      end;

end;

procedure TSVAPeakWithBaseLine​.LoadFromVAFile(cons​t FileName: string);

var
  BlankBackground,Stan​dartData,AddingData:​PFloatArray;
  VADataParam:TVADataParam;

begin
  if FCount<>0 then
    begin
      FreeMem(FYData, FCount*SizeOf(float));
      FreeMem(FBaseLine, FCount*SizeOf(float));
    end;
  try
    FCount := ReadVAFile(FileName, ReadBaseLine, BlankBackground,StandartData,
                         FYData,FBaseLine, AddingData, VADataParam);
  finally

  end;

  if FCount < 0 then
      FCount := 0
    else
      begin
        FE_start := VADataParam.E_start;
        FE_end := VADataParam.E_end;
        FE_step := (FE_end-FE_start)/FCount;
        FStepX := FE_step;
      end;
  if BlankBackground<>nil then
    FreeMem(BlankBackground, SizeOf(Float)*FCount);
  if StandartData <> nil then
    FreeMem(StandartData, SizeOf(Float)*FCount);
  if AddingData <> nil then
    FreeMem(AddingData, SizeOf(Float)*FCount);


end;

procedure TSVAPeakWithBaseLine​.SetCount(const Value: integer);
begin
//
  if FCount=Value then
    exit;
  if FCount <> 0 then
    FreeMem(FBaseLine, FCount*SizeOf(float));
  GetMem(FBaseLine,Val​ue*SizeOf(float));
  inherited;

end;


function TSVAPeak.GetX(Index: integer): float;
begin
//
  Result := E_start+Index*E_step;
end;

procedure TSVAPeak.SetE_step(const Value: float);
begin
  FE_step := Value;
end;

procedure TSVAPeak.SetE_start(const Value: float);
begin
  FE_start := Value;
end;

procedure TSVAPeak.SetE_end(const Value: float);
begin
  FE_end := Value;
end;

{ TSVAPeakWithBaseLine }

constructor TSVAPeakWithBaseLine.Create;
begin
  inherited;
  FUseBaseLine := false;
  FDrawBaseLine := true;
  FBaseLineColor := clTeeColor;

end;

destructor TSVAPeakWithBaseLine.Destroy;
begin
  if FCount<>0 then
    begin
      FreeMem(FBaseLine, FCount*SizeOf(float));
    end;
  inherited;
end;

procedure TSVAPeakWithBaseLine​.DrawGraph(Chart: TChart);
var
  i:integer;
  E:float;
  BaseLineSeries,
  YDataSeries:TLineSeries;
begin
  YDataSeries := TLineSeries.Create(Chart);
  YDataSeries.SeriesColor := FColor;
  Chart.AddSeries(YDataSeries);
  if not (FUseBaseLine) and FDrawBaseLine then
    begin
      BaseLineSeries := TLineSeries.Create(Chart);
      BaseLineSeries.SeriesColor := FBaseLineColor;
      Chart.AddSeries(Base​LineSeries);
    end;
  E := E_start;
  for i:=0 to Pred(FCount) do
    begin
      if FUseBaseLine then
          YDataSeries.AddXY(E,​FYData^[i]-FBaseLine​^[i],'',Color)
        else
          begin
            YDataSeries.AddXY(E,​FYData^[i],'',Color)​;
            if FDrawBaseLine then
              BaseLineSeries.AddXY​(E,FBaseLine^[i],'',​BaseLineColor);
          end;
      E := E+E_step;
    end;
end;

function TSVAPeakWithBaseLine​.GetY(Index: integer): float;
begin
//
  if FUseBaseLine then
      Result := YData^[Index]-BaseLine^[Index]
    else
      Result := YData^[Index];
end;

{ TCustomGraph }

destructor TCustomCalibratGraph.Destroy;
begin
  if FCount<>0 then
    FreeMem(FXData, FCount*SizeOf(float));
  inherited;

end;

procedure TCustomCalibratGraph​.DrawGraph(Chart: TChart);
var
  i:integer;
  YDataSeries:TLineSeries;
begin
  YDataSeries := TLineSeries.Create(Chart);
  YDataSeries.SeriesColor := FColor;
  Chart.AddSeries(YDataSeries);
  for i:=0 to Pred(FCount) do
    YDataSeries.AddXY(FX​Data^[i],FYData^[i],​'',Color);
end;

function TCustomCalibratGraph​.GetX(Index: integer): float;
begin
  Result := XData^[index];
end;

procedure TCustomCalibratGraph​.SetCount(const Value: integer);
begin
  if FCount=Value then
    exit;
  if FCount <> 0 then
    begin
      FreeMem(FXData, FCount*SizeOf(float));
    end;
  GetMem(FXData, Value*SizeOf(float));
  inherited;
end;

{ TCustomGraph }

procedure TCustomGraph.DrawGraph(Chart: TChart);
var
  i:integer;
begin
//
  Chart.AddSeries(TLin​eSeries.Create(Chart​));
  with Chart.Series[Pred(Ch​art.SeriesCount)] do
    begin
      SeriesColor := FColor;
      for i:=0 to Pred(FCount) do
        AddY(FYData^[i],'',Color)
    end;
end;

constructor TCustomGraph.Create;
begin
  FCount := 0;
  FColor := clTeeColor;
end;

destructor TCustomGraph.Destroy;
begin
  if FCount<>0 then
    begin
      FreeMem(FYData, FCount*SizeOf(float));
    end;
  inherited;
end;

function TCustomGraph.GetX(Index: integer): float;
begin
  result := index;
end;

function TCustomGraph.GetY(Index: integer): float;
begin
  Result := YData^[Index];
end;

procedure TCustomGraph.SetColor(const Value: TColor);
begin
  FColor := Value;
end;

procedure TCustomGraph.SetCount(const Value: integer);
begin
  if FCount=Value then
    exit;
  if FCount <> 0 then
    FreeMem(FYData, FCount*SizeOf(float));
  GetMem(FYData, Value*SizeOf(float));
  FCount := Value;

end;

{ TGraphSeriesList }

procedure TGraphSeriesList.Clear;
var
  i:integer;
begin
//
  for i:=0 to Pred(Count) do
    begin
      if Assigned(Objects[i]) then
        (Objects[i] as TCustomGraph).Free;
    end;
  inherited;
end;

destructor TGraphSeriesList.Destroy;
var
  i:integer;
begin
  for i:=0 to Pred(Count) do
    begin
      if Assigned(Objects[i]) then
        (Objects[i] as TCustomGraph).Free;
    end;
  inherited;
end;

{ TVALABPeak }

constructor TVALABPeak.Create;
begin
  inherited;
  Color := clRed;
  BaseLIneColor := clGreen;
  BlankBackgroundColor := clGray;
  AddingDataColor := clYellow;
//
end;

destructor TVALABPeak.Destroy;
begin
  if FCount<>0 then
    begin
      if FBlankBackground<>nil then
        FreeMem(FBlankBackgr​ound,FCount*SizeOf(f​loat));
      if FStandartData<>nil then
        FreeMem(FStandartDat​a,FCount*SizeOf(floa​t));
      if FAddingData<>nil then
        FreeMem(FAddingData,​FCount*SizeOf(float)​);
      if FBaseLine<>nil then
        FreeMem(FBaseLine,FC​ount*SizeOf(float));​
      if FYData<>nil then
        FreeMem(FYData,FCoun​t*SizeOf(float));
      FCount := 0;
    end;
  inherited;
end;

procedure TVALABPeak.DrawGraph(Chart: TChart);
var
  i:integer;
  E:float;
  BlankBackgroundSeries,
  StandartDataSeries,
  AddingDataSeries: TLineSeries;
begin
  if YData<>nil then
    inherited;
  if BlankBackground<>nil then
    begin
      BlankBackgroundSeries := TLineSeries.Create(Chart);
      BlankBackgroundSerie​s.SeriesColor := BlankBackgroundColor;
      Chart.AddSeries(Blan​kBackgroundSeries);
    end;

  if AddingData<>nil then
    begin
      AddingDataSeries := TLineSeries.Create(Chart);
      AddingDataSeries.SeriesColor := AddingDataColor;
      Chart.AddSeries(Addi​ngDataSeries);
    end;

  E := E_start;
  for i:=0 to Pred(FCount) do
    begin
      if BlankBackground<>nil then
          BlankBackgroundSerie​s.AddXY(E,FBlankBack​ground^[i],'',BlankB​ackgroundColor);
      if AddingData<>nil then
          AddingDataSeries.Add​XY(E,FAddingData^[i]​,'',AddingDataColor)​;
      E := E+E_step;
    end;
// AddingDataColor := clYellow;

end;

procedure TVALABPeak.LoadFromVAFile(const FileName: string);
var
  VADataParam:TVADataParam;
begin
  if FCount<>0 then
    begin
      if FBlankBackground<>nil then
        FreeMem(FBlankBackgr​ound,FCount*SizeOf(f​loat));
      if FStandartData<>nil then
        FreeMem(FStandartDat​a,FCount*SizeOf(floa​t));
      if FAddingData<>nil then
        FreeMem(FAddingData,​FCount*SizeOf(float)​);
      if FBaseLine<>nil then
        FreeMem(FBaseLine,FC​ount*SizeOf(float));​
      if FYData<>nil then
        FreeMem(FYData,FCoun​t*SizeOf(float));
      FCount := 0;
    end;

  try
    FCount := ReadVAFile(FileName, ReadBaseLine, FBlankBackground,FStandartData,
                         FYData,FBaseLine, FAddingData, VADataParam);
  finally

  end;

  if FCount < 0 then
      FCount := 0
    else
      begin
        FE_start := VADataParam.E_start;
        FE_end := VADataParam.E_end;
        FE_step := (FE_end-FE_start)/FCount;
        FStepX := FE_step;
      end;

end;

procedure TVALABPeak.SetCount(const Value: integer);
begin
  if FCount=Value then
    exit;
  if FCount<>0 then
    begin
      if FBlankBackground<>nil then
        begin
          FreeMem(FBlankBackgr​ound,FCount*SizeOf(f​loat));
          GetMem(FBlankBackgro​und,FCount*SizeOf(fl​oat));
        end;
      if FStandartData<>nil then
        begin
          GetMem(FStandartData​,FCount*SizeOf(float​));
        end;
      if FAddingData<>nil then
        begin
          GetMem(FAddingData,F​Count*SizeOf(float))​;
        end;
      if FBaseLine<>nil then
        begin
          GetMem(FBaseLine,FCo​unt*SizeOf(float));
        end;
      if FYData<>nil then
        begin
          GetMem(FYData,FCount​*SizeOf(float));
        end;
      FCount := 0;
    end;
end;

end.






--------------------​--------------------​--------------------​---------
To unsubscribe, e-mail: cvs-unsubscribe@math​lib.tigris.org
For additional commands, e-mail: cvs-help at mathlib dot tigris dot org

« Previous message in topic | 1 of 1 | Next message in topic »

Messages

Show all messages in topic

CVS update [1.1]: /mathlib/src/ larin Serge Larin 2004-04-19 08:37:28 PDT
Messages per page: