statchar.pas

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

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);
  CalcVisiblePoints:=False;
end;

Destructor THistogramSeries.Destroy;
begin
  FLinesPen.Free;
  inherited;
end;

procedure THistogramSeries.SetLinesPen(const Value: TChartHiddenPen);
begin
  FLinesPen.Assign(Value);
end;

class Function THistogramSeries.GetEditorClass:String;
begin
  result:='THistogramSeriesEditor';
end;

Function THistogramSeries.VisiblePoints:Integer;
begin
  result:=ParentChart.MaxPointsPerPage;
  if result=0 then result:=Count;
end;

Procedure THistogramSeries.CalcVerticalMargins(Var TopMargin,BottomMargin:Integer);
begin
  inherited;
  if Pen.Visible then Inc(TopMargin,Pen.Width);
end;

Procedure THistogramSeries.CalcHorizMargins(Var LeftMargin,RightMargin:Integer);
var tmp : Integer;
begin
  inherited;
  tmp:=VisiblePoints;
  if tmp>0 then tmp:=(GetHorizAxis.IAxisSize div VisiblePoints) div 2;
  Inc(LeftMargin,tmp);
  Inc(RightMargin,tmp);
  if Pen.Visible then Inc(RightMargin,Pen.Width);
end;

Procedure THistogramSeries.Assign(Source:TPersistent);
begin
  if Source is THistogramSeries then
  With THistogramSeries(Source) do
  begin
    Self.Pen:=Pen;
    Self.LinesPen:=LinesPen;
    Self.Brush:=Brush;
    Self.FTransparency:=Transparency;
  end;
  inherited;
end;

function THistogramSeries.CalcRect(ValueIndex:Integer):TRect;
var tmp : Integer;
begin
  tmp:=(GetHorizAxis.IAxisSize div VisiblePoints) div 2;

  With result do
  begin
    if ValueIndex=FirstValueIndex then
    begin
      Left:=CalcXPos(ValueIndex)-tmp+1;
      Right:=Left+2*tmp;
    end
    else
    begin
      Left:=IPrevious;
      Right:=CalcXPos(ValueIndex)+tmp+1;
    end;

    IPrevious:=Right-1;

    Top:=CalcYPos(ValueIndex);

    With GetVertAxis do
    if Inverted then Bottom:=IStartPos
                else Bottom:=IEndPos;
  end;
end;

procedure THistogramSeries.DrawValue(ValueIndex:Integer);

  Procedure VerticalLine(X,Y0,Y1:Integer);
  begin
    if ParentChart.View3D then
       ParentChart.Canvas.VertLine3D(X,Y0,Y1,MiddleZ)
    else
       ParentChart.Canvas.DoVertLine(X,Y0,Y1);
  end;

  Procedure HorizLine(X0,X1,Y:Integer);
  begin
    if ParentChart.View3D then
       ParentChart.Canvas.HorizLine3D(X0,X1,Y,MiddleZ)
    else
       ParentChart.Canvas.DoHorizLine(X0,X1,Y);
  end;

var R        : TRect;
    tmp      : Integer;
    tmpR     : TRect;
    tmpBlend : TTeeBlend;
begin
  R:=CalcRect(ValueIndex);

  With ParentChart.Canvas do
  begin
    Pen.Style:=psClear;

    // rectangle
    if Self.Brush.Style<>bsClear then
    begin
      AssignBrush(Self.Brush,ValueColor[ValueIndex]);

      if GetVertAxis.Inverted then Inc(R.Top);

      if Transparency>0 then
      begin
        if ParentChart.View3D then tmpR:=CalcRect3D(R,MiddleZ)
                              else tmpR:=R;
        tmpBlend:=BeginBlending(tmpR,Transparency);
      end
      else tmpBlend:=nil;

      if ParentChart.View3D then
         RectangleWithZ(TeeRect(R.Left,R.Top,R.Right-1,R.Bottom),MiddleZ)
      else
         Rectangle(R);

      if Transparency>0 then EndBlending(tmpBlend);

      if GetVertAxis.Inverted then Dec(R.Top);
    end;

    // border
    if Self.Pen.Visible then
    begin
      AssignVisiblePen(Self.Pen);
      With R do
      begin
        if ValueIndex=FirstValueIndex then VerticalLine(Left,Bottom,Top)
                                      else VerticalLine(Left,Top,CalcYPos(ValueIndex-1));
        HorizLine(Left,Right,Top);
        if ValueIndex=LastValueIndex then VerticalLine(Right-1,Top,Bottom);
      end;
    end;

    // dividing line
    if (ValueIndex>FirstValueIndex) and LinesPen.Visible then
    begin
      tmp:=CalcYPos(ValueIndex-1);

      if GetVertAxis.Inverted then
         tmp:=Math.Min(R.Top,tmp)
      else
         tmp:=Math.Max(R.Top,tmp);

      if not Self.Pen.Visible then Dec(tmp);

      AssignVisiblePen(LinesPen);
      VerticalLine(R.Left,R.Bottom,tmp);
    end;
  end;
end;

procedure THistogramSeries.SetTransparency(const Value: TTeeTransparency);
begin
  if Value<>FTransparency then
  begin
    FTransparency:=Value;
    Repaint;
  end;
end;

class procedure THistogramSeries.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_Hollow);
  AddSubChart(TeeMsg_NoBorder);
  AddSubChart(TeeMsg_Lines);
  AddSubChart(TeeMsg_Transparency); { 5.02 }
end;

class procedure THistogramSeries.SetSubGallery(ASeries: TChartSeries;
  Index: Integer);
begin
  with THistogramSeries(ASeries) do
  Case Index of
    1: Brush.Style:=bsClear;
    2: Pen.Visible:=False;
    3: LinesPen.Visible:=True;
    4: Transparency:=30;
  else inherited;
  end;
end;

function THistogramSeries.Clicked(x, y: Integer): Integer;
var t : Integer;
    R : TRect;
begin
  result:=TeeNoPointClicked;
  if Assigned(ParentChart) then ParentChart.Canvas.Calculate2DPosition(X,Y,MiddleZ);

  for t:=FirstValueIndex to LastValueIndex do
  begin
    R:=CalcRect(t);
    if PointInRect(R,x,y) then
    begin
      result:=t;
      break;
    end;
  end;
end;

{ TStochasticFunction }
constructor TStochasticFunction.Create(AOwner: TComponent);
begin
  inherited;
  SingleSource:=True;
  HideSourceList:=True;
end;

Destructor TStochasticFunction.Destroy;
begin
  FNums:=nil;
  FDens:=nil;
  inherited;
end;

procedure TStochasticFunction.AddPoints(Source: TChartSeries);
begin
  FNums:=nil;
  FDens:=nil;
  SetLength(FNums,Source.Count);
  SetLength(FDens,Source.Count);
  inherited;
end;

function TStochasticFunction.Calculate(Series: TChartSeries; FirstIndex,
  LastIndex: Integer): Double;
var Lows    : TChartValueList;
    Highs   : TChartValueList;
    tmpLow  : Double;
    tmpHigh : Double;
    t       : Integer;
begin
  result:=0;
  With Series do
  Begin
    Lows   :=GetYValueList('LOW');
    Highs  :=GetYValueList('HIGH');
    tmpLow :=Lows.Value[FirstIndex];
    tmpHigh:=Highs.Value[FirstIndex];
    for t:=FirstIndex to LastIndex do
    begin
      if Lows.Value[t] <tmpLow  then tmpLow :=Lows.Value[t];
      if Highs.Value[t]>tmpHigh then tmpHigh:=Highs.Value[t];
    end;
    FNums[LastIndex]:=ValueList(Series).Value[LastIndex]-tmpLow;
    FDens[LastIndex]:=tmpHigh-tmpLow;
    if tmpHigh<>tmpLow then result:=100.0*(FNums[LastIndex]/FDens[LastIndex]);
  end;
end;

{ TRMSFunction }
class function TRMSFunction.GetEditorClass: String;
begin
  result:='TRMSFuncEditor';
end;

procedure TRMSFunction.Accumulate(const Value: Double);
begin
  ISum2:=ISum2+Sqr(Value);
end;

function TRMSFunction.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;
    With ValueList(SourceSeries) do
    for t:=FirstIndex to LastIndex do Accumulate(Value[t]);
    result:=CalculateRMS;
  end
  else result:=0;
end;

function TRMSFunction.CalculateMany(SourceSeriesList: TList;
  ValueIndex: Integer): Double;
var t:Integer;
begin
  if SourceSeriesList.Count>0 then
  begin
    INumPoints:=0;
    ISum2:=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:=CalculateRMS
                    else result:=0;
  end
  else result:=0;
end;

function TRMSFunction.CalculateRMS: Double;
Var Divisor : Double;
begin
  if Complete then Divisor:=INumPoints
              else Divisor:=INumPoints-1;
  { safeguard against only one point }
  Result:=Sqrt(ISum2 / Divisor );
end;

procedure TRMSFunction.SetComplete(const Value: Boolean);
begin
  if FComplete<>Value then
  begin
    FComplete:=Value;
    Recalculate;
  end;
end;

{ TMACDFunction }

type TChartSeriesAccess=class(TChartSeries);

Constructor TMACDFunction.Create(AOwner: TComponent);

  Procedure HideSeries(ASeries:TChartSeries);
  begin
    ASeries.ShowInLegend:=False;
    TChartSeriesAccess(ASeries).InternalUse:=True;
  end;

begin
  inherited;
  SingleSource:=True;

  IMoving1:=TExpMovAveFunction.Create(nil);
  IMoving1.Period:=12;
  ISeries1:=TChartSeries.Create(nil);
  ISeries1.SetFunction(IMoving1);
  IMoving2:=TExpMovAveFunction.Create(nil);