statchar.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 1,262 行 · 第 1/3 页

  IMoving2.Period:=26;
  ISeries2:=TChartSeries.Create(nil);
  ISeries2.SetFunction(IMoving2);
  Period:=IMoving2.Period;

  IOther:=TFastLineSeries.Create(Self);
  HideSeries(IOther);
  IOther.SetFunction(TExpMovAveFunction.Create(nil));
  IOther.FunctionType.Period:=9;
  IOther.SeriesColor:=clGreen;

  IHisto:=TVolumeSeries.Create(Self);
  HideSeries(IHisto);
  IHisto.SeriesColor:=clRed;
  IHisto.UseYOrigin:=True;
  IHisto.YOrigin:=0;
end;

destructor TMACDFunction.Destroy;
begin
  ISeries1.Free;
  ISeries2.Free;
  inherited;
end;

class function TMACDFunction.GetEditorClass: String;
begin
  result:='TMACDFuncEditor';
end;

procedure TMACDFunction.AddPoints(Source: TChartSeries);

  Procedure PrepareSeries(ASeries:TChartSeries);
  begin { copy properties from "ParentSeries" to ASeries }
    With ASeries do
    begin
      ParentChart     :=ParentSeries.ParentChart;
      CustomVertAxis  :=ParentSeries.CustomVertAxis;
      VertAxis        :=ParentSeries.VertAxis;
      XValues.DateTime:=ParentSeries.XValues.DateTime;
      AfterDrawValues :=ParentSeries.AfterDrawValues;
      BeforeDrawValues:=ParentSeries.BeforeDrawValues;
    end;
  end;

var t : Integer;
begin
  { calculate first line... }
  ParentSeries.Clear;
  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;

{ 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.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:=ParentSeries.DataSources[0];
    tmp1:=ValueList(Source);
    tmpX1:=Source.NotMandatoryValueList;
    tmp2:=ValueList(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;


initialization
  RegisterTeeFunction( TMovingAverageFunction, @TeeMsg_FunctionMovingAverage, @TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TExpMovAveFunction,     @TeeMsg_FunctionExpMovAve, @TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TExpAverageFunction,    @TeeMsg_FunctionExpAverage, @TeeMsg_GalleryExtended );
  RegisterTeeFunction( TMomentumFunction,      @TeeMsg_FunctionMomentum, @TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TMomentumDivFunction,   @TeeMsg_FunctionMomentumDiv, @TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TStdDeviationFunction,  @TeeMsg_FunctionStdDeviation, @TeeMsg_GalleryExtended  );
  RegisterTeeFunction( TRMSFunction,           @TeeMsg_FunctionRMS, @TeeMsg_GalleryExtended );
  RegisterTeeFunction( TMACDFunction,          @TeeMsg_FunctionMACD, @TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TStochasticFunction,    @TeeMsg_FunctionStochastic, @TeeMsg_GalleryFinancial  );
  RegisterTeeFunction( TBollingerFunction,     @TeeMsg_FunctionBollinger, @TeeMsg_GalleryFinancial );
  RegisterTeeFunction( TCrossPointsFunction,   @TeeMsg_FunctionCross, @TeeMsg_GalleryExtended );
  RegisterTeeFunction( TPerformanceFunction,   @TeeMsg_FunctionPerf, @TeeMsg_GalleryExtended );
  RegisterTeeSeries( THistogramSeries,@TeeMsg_GalleryHistogram,@TeeMsg_GalleryStats,1 );
finalization
  UnRegisterTeeFunctions([ TMovingAverageFunction,
                           TExpMovAveFunction,
                           TExpAverageFunction,
                           TMomentumFunction,
                           TMomentumDivFunction,
                           TStdDeviationFunction,
                           TRMSFunction,
                           TMACDFunction,
                           TStochasticFunction,
                           TBollingerFunction,
                           TCrossPointsFunction,
                           TPerformanceFunction ]);
  UnRegisterTeeSeries([THistogramSeries]);
end.