statchar.pas

TeeChart7Source 控件

{******************************************}
{ TeeChart Statistical Functions           }
{ Copyright (c) 2001-2004 by David Berneda }
{    All Rights Reserved                   }
{******************************************}
unit StatChar;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     {$IFDEF CLX}
     Types,
     {$ENDIF}
     {$IFDEF CLR}
     Types,
     {$ENDIF}
     Classes, TeEngine, Series, TeCanvas, CandleCh;

Type
  { Moving Average, Weigted, WeightedIndex }
  TMovingAverageFunction=class(TTeeMovingFunction)
  private
    FWeighted      : Boolean;
    FWeightedIndex : Boolean;
    Procedure SetWeighted(Value:Boolean);
    procedure SetWeightedIndex(const Value: Boolean);
  protected
    class function GetEditorClass: String; override;
  public
    Function Calculate( Series:TChartSeries;
                        FirstIndex,LastIndex:Integer):Double; override;
  published
    property Weighted:Boolean read FWeighted write SetWeighted default False;
    property WeightedIndex:Boolean read FWeightedIndex write SetWeightedIndex default False;
  end;

  { Exponential Moving Average }
  TExpMovAveFunction=class(TTeeFunction)
  public
    Constructor Create(AOwner:TComponent); override;
    procedure AddPoints(Source:TChartSeries); override;
  end;

  { Exponential Average }
  TExpAverageFunction = class(TTeeMovingFunction)
  private
    FWeight : Double;
    Procedure SetWeight(Const Value:Double);
  protected
    class function GetEditorClass: String; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Function Calculate( Series:TChartSeries;
                        FirstIndex,LastIndex:Integer):Double; override;
  published
    property Weight:Double read FWeight write SetWeight;
  end;

  { Momemtum }
  TMomentumFunction=class(TTeeMovingFunction)
  public
    Function Calculate( Series:TChartSeries;
                        FirstIndex,LastIndex:Integer):Double; override;
  end;

  { Momemtum Divisor }
  TMomentumDivFunction=class(TTeeMovingFunction)
  public
    Function Calculate( Series:TChartSeries;
                        FirstIndex,LastIndex:Integer):Double; override;
  end;

  { RMS, Root Mean Square }
  TRMSFunction = class(TTeeFunction)
  private
    FComplete  : Boolean;

    INumPoints : Integer;
    ISum2      : Double;
    Procedure Accumulate(Const Value: Double);
    Function  CalculateRMS: Double;
    Procedure SetComplete(const Value: Boolean);
  protected
    class function GetEditorClass: String; override;
  public
    Function Calculate(SourceSeries:TChartSeries; FirstIndex,LastIndex:Integer):Double; override;
    Function CalculateMany(SourceSeriesList:TList; ValueIndex:Integer):Double;  override;
  published
    property Complete: Boolean read FComplete write SetComplete default False;
  end;

  // Standard Deviation, Complete
  TStdDeviationFunction=class(TTeeFunction)
  private
    FComplete : Boolean;
    ISum      : Double;
    ISum2     : Double;
    INumPoints: Integer;
    Procedure Accumulate(Const Value:Double);
    Function CalculateDeviation:Double;
    Procedure SetComplete(Value:Boolean);
  protected
    class function GetEditorClass: String; override;
  public
    Function Calculate(SourceSeries:TChartSeries; FirstIndex,LastIndex:Integer):Double; override;
    Function CalculateMany(SourceSeriesList:TList; ValueIndex:Integer):Double;  override;
  published
    property Complete:Boolean read FComplete write SetComplete default False;
  end;

  { MACD, Moving Average Convergence }
  TMACDFunction=class(TTeeMovingFunction)
  private
    IHisto   : TVolumeSeries;
    IMoving1 : TExpMovAveFunction;
    IMoving2 : TExpMovAveFunction;
    IOther   : TFastLineSeries;
    ISeries1 : TChartSeries;
    ISeries2 : TChartSeries;

    function GetHistoPen: TChartPen;
    function GetMACDExpPen: TChartPen;
    function GetPeriod2: Double;
    function GetPeriod3:Integer;
    procedure SetHistoPen(const Value: TChartPen);
    procedure SetMACDExpPen(const Value: TChartPen);
    procedure SetPeriod2(const Value:Double);
    procedure SetPeriod3(Const Value:Integer);
    function GetMACDPen: TChartPen;
    procedure SetMACDPen(const Value: TChartPen);
  protected
    procedure Clear; override;
    class function GetEditorClass: String; override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    procedure AddPoints(Source: TChartSeries); override;

    property MACDExp:TFastLineSeries read IOther; { 5.02 }
    property Histogram:TVolumeSeries read IHisto; { 5.02 }
  published
    property HistogramPen:TChartPen read GetHistoPen write SetHistoPen;
    property MACDPen:TChartPen read GetMACDPen write SetMACDPen;
    property MACDExpPen:TChartPen read GetMACDExpPen write SetMACDExpPen;
    property Period2:Double read GetPeriod2 write SetPeriod2;
    property Period3:Integer read GetPeriod3 write SetPeriod3 default 9;
  end;

  { Stochastic }
  TStochasticFunction=class(TTeeMovingFunction)
  protected
    FNums : Array of Double;
    FDens : Array of Double;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    procedure AddPoints(Source: TChartSeries); override;
    Function Calculate( Series:TChartSeries;
                        FirstIndex,LastIndex:Integer):Double; override;
  end;

  { Histogram Series }
  THistogramSeries=class(TCustomLineSeries)
  private
    FLinesPen     : TChartHiddenPen;
    FTransparency : TTeeTransparency;

    IPrevious : Integer;
    Procedure InternalCalcHoriz(Axis:TChartAxis; Var Min,Max:Integer);
    procedure SetLinesPen(const Value: TChartHiddenPen);
    procedure SetTransparency(Const Value:TTeeTransparency);
    Function VisiblePoints:Integer;
  protected
    function CalcRect(ValueIndex:Integer):TRect; virtual;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure CalcFirstLastVisibleIndex; override;
    Procedure CalcHorizMargins(Var LeftMargin,RightMargin:Integer); override;
    Procedure CalcVerticalMargins(Var TopMargin,BottomMargin:Integer); override;
    procedure DrawValue(ValueIndex:Integer); override;
    class Function GetEditorClass:String; override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Function Clicked(x,y:Integer):Integer; override;
  published
    property Active;
    property ColorEachPoint;
    property ColorSource;
    property Cursor;
    property HorizAxis;
    property LinePen;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;

    property Brush;
    property LinesPen:TChartHiddenPen read FLinesPen write SetLinesPen;
    property Pen;
    property Transparency:TTeeTransparency read FTransparency write SetTransparency default 0;
    property XValues;
    property YValues;
  end;

  THorizHistogramSeries=class(THistogramSeries)  // 7.0
  protected
    function CalcRect(ValueIndex:Integer):TRect; override;
  public
    Constructor Create(AOwner: TComponent); override;
  end;

  { Financial Bollinger Bands }
  TBollingerFunction=class(TTeeFunction)
  private
    FExponential : Boolean;
    FDeviation   : Double;
    IOther       : TChartSeries;
    procedure SetDeviation(const Value: Double);
    procedure SetExponential(const Value: Boolean);
    function GetLowBandPen: TChartPen;
    procedure SetLowBandPen(const Value: TChartPen);
    function GetUpperBandPen: TChartPen;
    procedure SetUpperBandPen(const Value: TChartPen);
  protected
    procedure Clear; override;
    class function GetEditorClass: String; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;
    procedure AddPoints(Source:TChartSeries); override;
    property LowBand:TChartSeries read IOther;
  published
    property Deviation:Double read FDeviation write SetDeviation;
    property Exponential:Boolean read FExponential write SetExponential default True;
    property LowBandPen:TChartPen read GetLowBandPen write SetLowBandPen;
    property UpperBandPen:TChartPen read GetUpperBandPen write SetUpperBandPen;
  end;

  { Cross Points }
  TCrossPointsFunction=class(TTeeFunction)
  protected
    class function GetEditorClass: String; override;
  public
    Constructor Create(AOwner:TComponent); override;
    procedure AddPoints(Source:TChartSeries); override;
  end;

  { Performance }
  TPerformanceFunction=class(TTeeMovingFunction)
  public
    Function Calculate(SourceSeries:TChartSeries;
                       FirstIndex,LastIndex:Integer):Double; override;
  end;

  // Variance
  TVarianceFunction=class(TTeeFunction)  // 6.02
  public
    Function Calculate(SourceSeries:TChartSeries; FirstIndex,LastIndex:Integer):Double; override;
    Function CalculateMany(SourceSeriesList:TList; ValueIndex:Integer):Double;  override;
  end;

  // Perimeter
  TPerimeterFunction=class(TTeeFunction)
  public
    constructor Create(AOwner: TComponent); override;
    procedure AddPoints(Source:TChartSeries); override;
  end;

implementation

Uses SysUtils,
     {$IFDEF CLX}
     QGraphics,
     {$ELSE}
     Graphics,
     {$ENDIF}
     Math, TeeProcs, TeeConst, TeeProCo, Chart;

{ TMovingAverageFunction }
Procedure TMovingAverageFunction.SetWeighted(Value:Boolean);
begin
  if FWeighted<>Value then
  begin
    FWeighted:=Value;
    Recalculate;
  end;
end;

class function TMovingAverageFunction.GetEditorClass: String;
begin
  result:='TMovAveFuncEditor';
end;

Function TMovingAverageFunction.Calculate( Series:TChartSeries;
                                           FirstIndex,LastIndex:Integer):Double;
var t         : Integer;
    tmpSumX   : Double;
    tmpYValue : Double;
    tmpXValue : Double;
    tmpVList  : TChartValueList;
begin
  result:=0;
  tmpSumX:=0;
  tmpVList:=ValueList(Series);

  for t:=FirstIndex to LastIndex do
  begin
    tmpYValue:=tmpVList.Value[t];
    if FWeighted then
    Begin
      tmpXValue:=Series.XValues.Value[t];
      result:=result+tmpYValue*tmpXValue;
      tmpSumX:=tmpSumX+tmpXValue;
    end
    else
    if FWeightedIndex then
    begin
      tmpXValue:=t-FirstIndex+1;
      result:=result+tmpYValue*tmpXValue;
      tmpSumX:=tmpSumX+tmpXValue;
    end
    else
      result:=result+tmpYValue;
  end;

  if FWeighted or FWeightedIndex then
  begin
    if tmpSumX<>0 then result:=result/tmpSumX else result:=0;
  end
  else result:=result/(LastIndex-FirstIndex+1);
end;

procedure TMovingAverageFunction.SetWeightedIndex(const Value: Boolean);
begin
  if FWeightedIndex<>Value then
  begin
    FWeightedIndex:=Value;
    Recalculate;
  end;
end;

{ TExpAverageFunction }
Constructor TExpAverageFunction.Create(AOwner: TComponent);
Begin
  inherited;
  FWeight:=0.2;
End;

class function TExpAverageFunction.GetEditorClass: String;
begin
  result:='TExpAveFuncEditor';
end;

Procedure TExpAverageFunction.SetWeight(Const Value:Double);
Begin
  if (Value<0) or (Value>1) then
     raise Exception.Create(TeeMsg_ExpAverageWeight);

  if FWeight<>Value then
  begin
    FWeight:=Value;
    Recalculate;
  end;
End;

Function TExpAverageFunction.Calculate( Series:TChartSeries;
                                        FirstIndex,LastIndex:Integer):Double;
Begin
  With ValueList(Series) do
  begin
    result:=Value[LastIndex];
    if LastIndex>0 then result:=Value[LastIndex-1]*(1.0-Weight)+result*Weight;
  end;
end;

{ Momentum }
Function TMomentumFunction.Calculate( Series:TChartSeries;
                                      FirstIndex,LastIndex:Integer):Double;
Begin
  if FirstIndex=TeeAllValues then
  begin
    FirstIndex:=0;
    LastIndex:=Series.Count-1;
  end;
  With ValueList(Series) do result:=Value[LastIndex]-Value[FirstIndex];
End;

{ MomentumDivision }
Function TMomentumDivFunction.Calculate( Series:TChartSeries;
                                      FirstIndex,LastIndex:Integer):Double;
Begin
  if FirstIndex=TeeAllValues then
  begin
    FirstIndex:=0;
    LastIndex:=Series.Count-1;
  end;
  With ValueList(Series) do
  if Value[FirstIndex]=0 then result:=0
                         else result:=100.0*Value[LastIndex]/Value[FirstIndex];
End;

{ StdDeviation }
Function TStdDeviationFunction.CalculateDeviation:Double;
var Divisor : Double;
begin
  if Complete then Divisor:=Sqr(INumPoints)
              else Divisor:=INumPoints*(INumPoints-1);

  result:=((INumPoints*ISum2) - Sqr(ISum)) / Divisor;
  if result<0 then result:=0
              else result:=Sqrt(result);
end;

Procedure TStdDeviationFunction.Accumulate(Const Value:Double);
begin
  ISum:=ISum+Value;
  ISum2:=ISum2+Sqr(Value);
end;

class function TStdDeviationFunction.GetEditorClass: String;
begin
  result:='TRMSFuncEditor';
end;

Function TStdDeviationFunction.Calculate(SourceSeries:TChartSeries; FirstIndex,LastIndex:Integer):Double;
var t : Integer;
begin
  if FirstIndex=TeeAllValues then
  begin
    FirstIndex:=0;
    INumPoints:=SourceSeries.Count;
    LastIndex:=INumPoints-1;
  end
  else INumPoints:=LastIndex-FirstIndex+1;

  if INumPoints>1 then
  begin
    ISum2:=0;
    ISum:=0;
    With ValueList(SourceSeries) do
    for t:=FirstIndex to LastIndex do Accumulate(Value[t]);
    result:=CalculateDeviation;
  end
  else result:=0;
end;

Function TStdDeviationFunction.CalculateMany(SourceSeriesList:TList; ValueIndex:Integer):Double;
var t:Integer;
begin
  if SourceSeriesList.Count>0 then
  begin
    INumPoints:=0;
    ISum2:=0;
    ISum:=0;
    for t:=0 to SourceSeriesList.Count-1 do
    begin
      With ValueList(TChartSeries(SourceSeriesList[t])) do
      if Count>ValueIndex then
      begin
        Accumulate(Value[ValueIndex]);
        Inc(INumPoints);
      end;
    end;

    if INumPoints>1 then result:=CalculateDeviation
                    else result:=0;
  end
  else result:=0;
end;

Procedure TStdDeviationFunction.SetComplete(Value:Boolean);
begin
  if FComplete<>Value then
  begin
    FComplete:=Value;
    Recalculate;
  end;
end;

{ THistogramSeries }
Constructor THistogramSeries.Create(AOwner: TComponent);
begin
  inherited;
  FLinesPen:=TChartHiddenPen.Create(CanvasChanged);
end;

Destructor THistogramSeries.Destroy;
begin