statchar.pas

BCB第三方组件

        IHisto.AddXY(IOther.XValues.Value[t],
                     ParentSeries.YValues.Value[t]-IOther.YValues.Value[t]);

    IHisto.EndUpdate;
  end;
end;

function TMACDFunction.GetPeriod2: Double;
begin
  result:=IMoving1.Period
end;

procedure TMACDFunction.SetPeriod2(const Value: Double);
begin
  if IMoving1.Period<>Value then
  begin
    IMoving1.Period:=Value;

    if IMoving1.Period<1 then
       IMoving1.Period:=1;

    Recalculate;
  end;
end;

function TMACDFunction.GetPeriod3: Integer;
begin
  result:=Round(IOther.FunctionType.Period);
end;

procedure TMACDFunction.SetPeriod3(const Value: Integer);
begin
  IOther.FunctionType.Period:=Value;
end;

function TMACDFunction.GetHistoPen: TChartPen;
begin
  result:=Histogram.Pen;
end;

function TMACDFunction.GetMACDExpPen: TChartPen;
begin
  result:=MACDExp.Pen;
end;

procedure TMACDFunction.SetHistoPen(const Value: TChartPen);
begin
  Histogram.Pen:=Value;
end;

procedure TMACDFunction.SetMACDExpPen(const Value: TChartPen);
begin
  MACDExp.Pen:=Value;
end;

function TMACDFunction.GetMACDPen: TChartPen;
begin
  if Assigned(ParentSeries) then
     result:=ParentSeries.Pen
  else
     result:=nil;
end;

procedure TMACDFunction.SetMACDPen(const Value: TChartPen);
begin
  ParentSeries.Pen:=Value;
end;

procedure TMACDFunction.Clear;
begin
  inherited;
  IOther.Clear;
  IHisto.Clear;
end;

{ TExpMovAveFunction }
constructor TExpMovAveFunction.Create(AOwner: TComponent);
begin
  inherited;
  FIgnoreNulls:=True;
  CanUsePeriod:=False;
  SingleSource:=True;
  InternalSetPeriod(10);
end;

procedure TExpMovAveFunction.AddPoints(Source: TChartSeries);
var tmpV : TChartValueList;
    Old  : Double;
    t    : Integer;
    tmp  : Double;
    t0   : Integer;
begin
  ParentSeries.Clear;

  if Period>0 then
  With Source do
  if Count>1 then
  begin
    tmpV:=ValueList(Source);
    tmp:=2/(Self.Period+1);

    if FIgnoreNulls then
    begin
      Old:=tmpV.Value[0];
      ParentSeries.AddXY(NotMandatoryValueList.Value[0],Old);

      for t:=1 to Count-1 do
      begin
        Old:=(tmpV.Value[t]*tmp)+(Old*(1-tmp));
        ParentSeries.AddXY(NotMandatoryValueList.Value[t],Old);
      end;
    end
    else
    begin
      t0:=0;

      while IsNull(t0) and (t0<Count-1) do
            Inc(t0);

      if t0<Count then
      begin
        Old:=tmpV.Value[t0];
        ParentSeries.AddXY(NotMandatoryValueList.Value[t0],Old);

        for t:=t0+1 to Count-1 do
        if not IsNull(t) then 
        begin
          Old:=(tmpV.Value[t]*tmp)+(Old*(1-tmp));
          ParentSeries.AddXY(NotMandatoryValueList.Value[t],Old);
        end;
      end;
    end;
  end;
end;

procedure TExpMovAveFunction.SetIgnoreNulls(const Value:Boolean);
begin
  if FIgnoreNulls<>Value then
  begin
    FIgnoreNulls:=Value;
    Recalculate;
  end;
end;

{ TBollingerFunction }
constructor TBollingerFunction.Create(AOwner: TComponent);
begin
  inherited;
  SingleSource:=True;
  Exponential:=True;
  Deviation:=2;

  IOther:=TFastLineSeries.Create(Self);
  IOther.ShowInLegend:=False;
  TChartSeriesAccess(IOther).DontSerialize:=True;
  IOther.ShowInEditor:=False;

  InternalSetPeriod(10);
end;

class function TBollingerFunction.GetEditorClass: String;
begin
  result:='TBollingerFuncEditor'; // Do not localize
end;

procedure TBollingerFunction.AddPoints(Source:TChartSeries);
Var AList : TChartValueList;

  Function StdDev(First,Last:Integer):Double;
  var ISum  : Double;
      ISum2 : Double;
      tmp   : Double;
      t     : Integer;
  begin
    ISum:=0;
    ISum2:=0;

    for t:=First to Last do
    begin
      tmp:=AList.Value[t];
      ISum:=ISum+tmp;
      ISum2:=ISum2+Sqr(tmp);
    end;

    ISum:=((Period*ISum2) - Sqr(ISum)) / Sqr(Period);

    if ISum>0 then result:=Sqrt( ISum )
              else result:=0;  { 5.01  Negative square root not allowed }
  end;

  Procedure InternalAddPoints(ASeries:TChartSeries; const ADeviation:Double);
  var Mov       : TTeeFunction;
      tmp       : TChartSeries;
      tmpValue  : Double;
      tmpPeriod : Integer;
      t         : Integer;
      tmpSource : String;
  begin
    if Exponential then Mov:=TExpMovAveFunction.Create(nil)
                   else Mov:=TMovingAverageFunction.Create(nil);

    Mov.Period:=Period;

    tmp:=TChartSeries.Create(nil);
    try
      tmp.ParentChart:=Source.ParentChart;
      tmp.DataSource:=Source;
      tmpSource:=ParentSeries.MandatoryValueList.ValueSource;

      if tmpSource='' then
         tmpSource:=Source.MandatoryValueList.Name;

      tmp.MandatoryValueList.ValueSource:=tmpSource;
      tmp.SetFunction(Mov);

      ASeries.Clear;
      AList:=Source.GetYValueList(tmpSource);
      tmpPeriod:=Round(Period);

      for t:=tmpPeriod to Source.Count do
      begin
        tmpValue:=(ADeviation*StdDev(t-tmpPeriod,t-1));

        if Exponential then
           tmpValue:=tmp.YValues.Value[t-1]+tmpValue
        else
           tmpValue:=tmp.YValues.Value[t-tmpPeriod]+tmpValue;

        ASeries.AddXY(Source.XValues.Value[t-1],tmpValue);
      end;

      tmp.DataSource:=nil;
    finally
      tmp.Free;
    end;
  end;

begin
  With IOther do
  begin
    ParentChart:=ParentSeries.ParentChart;
    CustomVertAxis:=ParentSeries.CustomVertAxis;
    VertAxis:=ParentSeries.VertAxis;
    SeriesColor:=ParentSeries.SeriesColor;

    if ClassType=ParentSeries.ClassType then
       Pen.Assign(ParentSeries.Pen);

    XValues.DateTime:=ParentSeries.XValues.DateTime;
    AfterDrawValues:=ParentSeries.AfterDrawValues;
    BeforeDrawValues:=ParentSeries.BeforeDrawValues;
  end;

  if Period>0 then  // 5.03
  begin
    InternalAddPoints(ParentSeries,Deviation);
    InternalAddPoints(IOther,-Deviation);
  end;
end;

procedure TBollingerFunction.Clear; // 6.02
begin
  inherited;
  IOther.Clear;
end;

procedure TBollingerFunction.SetDeviation(const Value: Double);
begin
  if FDeviation<>Value then
  begin
    FDeviation:=Value;
    ReCalculate;
  end;
end;

procedure TBollingerFunction.SetExponential(const Value: Boolean);
begin
  if FExponential<>Value then
  begin
    FExponential:=Value;
    ReCalculate;
  end;
end;

destructor TBollingerFunction.Destroy;
begin
  IOther.Free;
  inherited;
end;

function TBollingerFunction.GetLowBandPen: TChartPen;
begin
  result:=LowBand.Pen;
end;

procedure TBollingerFunction.SetLowBandPen(const Value: TChartPen);
begin
  LowBand.Pen:=Value;
end;

function TBollingerFunction.GetUpperBandPen: TChartPen;
begin
  if Assigned(ParentSeries) then
     result:=ParentSeries.Pen
  else
     result:=nil;
end;

procedure TBollingerFunction.SetUpperBandPen(const Value: TChartPen);
begin
  ParentSeries.Pen:=Value;
end;

{ TCrossPointsFunction }
constructor TCrossPointsFunction.Create(AOwner: TComponent); // 6.0
begin
  inherited;
  CanUsePeriod:=False;
end;

procedure TCrossPointsFunction.AddPoints(Source: TChartSeries);
var tmp1   : TChartValueList;
    tmp2   : TChartValueList;
    tmpX1  : TChartValueList;
    tmpX2  : TChartValueList;

  Function LinesCross(index1,index2:Integer; var x,y:Double):Boolean;
  begin
    result:=CrossingLines(
                tmpX1.Value[index1],tmp1.Value[index1],
                tmpX1.Value[index1+1],tmp1.Value[index1+1],
                tmpX2.Value[index2],tmp2.Value[index2],
                tmpX2.Value[index2+1],tmp2.Value[index2+1],
                x,y
                );
  end;

var Index1,
    Index2 : Integer;
    x,
    y : Double;
begin
  if ParentSeries.DataSources.Count>1 then
  begin
    Source:=TChartSeries(ParentSeries.DataSources[0]);
    tmp1:=ValueList(Source);
    tmpX1:=Source.NotMandatoryValueList;
    tmp2:=ValueList(TChartSeries(ParentSeries.DataSources[1]));
    tmpX2:=TChartSeries(ParentSeries.DataSources[1]).NotMandatoryValueList;

    ParentSeries.Clear;

    if (tmpX1.Count>1) and (tmpX2.Count>1) then
    begin
      index1:=0;
      index2:=0;

      repeat
        if LinesCross(index1,index2,x,y) then
           ParentSeries.AddXY(x,y);

        if tmpX2.Value[index2+1]<tmpX1.Value[index1+1] then
           Inc(Index2)
        else
           Inc(Index1);

      until (index1>=tmpX1.Count) or (index2>=tmpX2.Count);
    end;
  end;
end;

class function TCrossPointsFunction.GetEditorClass: String;
begin
  result:=''; // no options for this function
end;

{ TPerformanceFunction }
function TPerformanceFunction.Calculate(SourceSeries: TChartSeries;
  FirstIndex, LastIndex: Integer): Double;
begin
  if FirstIndex=TeeAllValues then
     LastIndex:=SourceSeries.Count-1;

  With ValueList(SourceSeries) do
  if Value[0]<>0 then
     result:=(Value[LastIndex]-Value[0])*100.0/Value[0]
  else
     result:=0;
end;


{ TVarianceFunction }
function TVarianceFunction.Calculate(SourceSeries: TChartSeries;
  FirstIndex, LastIndex: Integer): Double;
var tmpCount : Integer;
    tmpMean  : Double;
    tmpSum   : Double;
    t        : Integer;
begin
  if FirstIndex=-1 then
     FirstIndex:=0;

  if LastIndex=-1 then
     LastIndex:=SourceSeries.Count-1;

  tmpCount:=LastIndex-FirstIndex+1;

  if tmpCount>0 then
  begin
    if tmpCount=SourceSeries.Count then
       tmpMean:=SourceSeries.MandatoryValueList.Total/tmpCount
    else
    begin
      tmpMean:=0;

      for t:=FirstIndex to LastIndex do
          tmpMean:=tmpMean+SourceSeries.MandatoryValueList.Value[t];

      tmpMean:=tmpMean/tmpCount;
    end;

    tmpSum:=0;

    for t:=FirstIndex to LastIndex do
        tmpSum:=tmpSum+Sqr(SourceSeries.MandatoryValueList.Value[t]-tmpMean);

    result:=tmpSum/tmpCount;
  end
  else result:=0;
end;

function TVarianceFunction.CalculateMany(SourceSeriesList: TList;
  ValueIndex: Integer): Double;
var tmpCount : Integer;
    tmpMean  : Double;
    tmpSum   : Double;
    t        : Integer;
begin
  tmpCount:=SourceSeriesList.Count;

  if tmpCount>0 then
  begin
    tmpMean:=0;

    for t:=0 to tmpCount-1 do
        tmpMean:=tmpMean+TChartSeries(SourceSeriesList[t]).MandatoryValueList.Value[ValueIndex];

    tmpMean:=tmpMean/tmpCount;

    tmpSum:=0;

    for t:=0 to tmpCount-1 do
        tmpSum:=tmpSum+Sqr(TChartSeries(SourceSeriesList[t]).MandatoryValueList.Value[ValueIndex]-tmpMean);

    result:=tmpSum/tmpCount;
  end
  else result:=0;
end;

{ TPerimeterFunction }
constructor TPerimeterFunction.Create(AOwner: TComponent);
begin
  inherited;
  CanUsePeriod:=False;
  SingleSource:=True;
end;

procedure TPerimeterFunction.AddPoints(Source:TChartSeries);
var t : Integer;
    tmp : Integer;
    P : TPointArray;
begin
  ParentSeries.Clear;

  if Source.Count>0 then
  begin
    SetLength(P,Source.Count);
    try
      with Source,ParentChart.Canvas do
      begin
        if (GetHorizAxis.IAxisSize=0) or (GetVertAxis.IAxisSize=0) then
           ParentChart.Draw;

        for t:=0 to Count-1 do
            P[t]:=Calculate3DPosition(CalcXPos(t),CalcYPos(t),MiddleZ);

        ConvexHull(P);
      end;

      with ParentSeries do
      begin
        XValues.Order:=loNone;

        tmp:=Length(P);
        for t:=0 to tmp-1 do
            AddXY(XScreenToValue(P[t].X),YScreenToValue(P[t].Y));

        if tmp>0 then
            AddXY(XValues[0],YValues[0]);
      end;
    finally
      P:=nil;
    end;
  end;
end;

initialization
  RegisterTeeFunction( TMovingAverageFunction, {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionMovingAverage,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TExpMovAveFunction,     {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionExpMovAve,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TExpAverageFunction,    {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionExpAverage,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
  RegisterTeeFunction( TMomentumFunction,      {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionMomentum,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TMomentumDivFunction,   {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionMomentumDiv,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TStdDeviationFunction,  {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionStdDeviation,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended  );
  RegisterTeeFunction( TRMSFunction,           {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionRMS,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
  RegisterTeeFunction( TMACDFunction,          {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionMACD,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TStochasticFunction,    {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionStochastic,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TBollingerFunction,     {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionBollinger,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TCrossPointsFunction,   {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionCross,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
  RegisterTeeFunction( TPerformanceFunction,   {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionPerf,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
  RegisterTeeFunction( TVarianceFunction,      {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionVariance,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
  RegisterTeeFunction( TPerimeterFunction,     {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionPerimeter,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );

  RegisterTeeSeries( THistogramSeries,         {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryHistogram,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryStats,1 );
  RegisterTeeSeries( THorizHistogramSeries,    {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryHorizHistogram,
                                               {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryStats,1 );
finalization
  UnRegisterTeeFunctions([ TMovingAverageFunction,
                           TExpMovAveFunction,
                           TExpAverageFunction,
                           TMomentumFunction,
                           TMomentumDivFunction,
                           TStdDeviationFunction,
                           TRMSFunction,
                           TMACDFunction,
                           TStochasticFunction,
                           TBollingerFunction,
                           TCrossPointsFunction,
                           TPerformanceFunction,
                           TVarianceFunction,
                           TPerimeterFunction ]);

  UnRegisterTeeSeries([THistogramSeries, THorizHistogramSeries]);
end.