statchar.pas

TeeChart7Source 控件

  With Source do
  if Count>1 then
  begin
    IMoving1.AddPoints(Source);
    IMoving2.Period:=Self.Period;
    IMoving2.AddPoints(Source);
    for t:=0 to Count-1 do
        ParentSeries.AddXY(XValues.Value[t],
                           ISeries1.YValues.Value[t]-ISeries2.YValues.Value[t]);
    ISeries1.Clear;
    ISeries2.Clear;
  end;

  // Calculate "MACDExp" second line, even if not visible.
  PrepareSeries(IOther);
  if ParentSeries.SeriesColor=clWhite then ParentSeries.SeriesColor:=clBlue;
  IOther.DataSource:=nil;
  IOther.DataSource:=ParentSeries;

  { calculate Histogram if Active... }
  if IHisto.Active then
  begin
    PrepareSeries(IHisto);
    IHisto.BeginUpdate;
    IHisto.Clear;
    With IOther do
    for t:=0 to Count-1 do
        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
  result:=ParentSeries.Pen;
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;
  CanUsePeriod:=False;
  SingleSource:=True;
  InternalSetPeriod(10);
end;

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

  if Period>0 then
  With Source do
  if Count>1 then
  begin
    tmpV:=ValueList(Source);
    tmp:=2/(Self.Period+1);
    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;
end;

{ TBollingerFunction }
constructor TBollingerFunction.Create(AOwner: TComponent);
begin
  inherited;
  SingleSource:=True;
  Exponential:=True;
  Deviation:=2;
  IOther:=TFastLineSeries.Create(Self);
  IOther.ShowInLegend:=False;
  TChartSeriesAccess(IOther).InternalUse:=True;
  InternalSetPeriod(10);
end;

class function TBollingerFunction.GetEditorClass: String;
begin
  result:='TBollingerFuncEditor';
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
  result:=ParentSeries.Pen;
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
  begin
    result:=(Value[LastIndex]-Value[0])*100.0/Value[0];
  end
  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.