teeboxplot.pas

BCB第三方组件

{**********************************************}
{   TCustomBoxSeries                           }
{     TBoxSeries                               }
{     THorizBoxSeries                          }
{                                              }
{   Copyright (c) 2000-2007 by                 }
{   Marjan Slatinek and David Berneda          }
{**********************************************}
unit TeeBoxPlot;
{$I TeeDefs.inc}

interface

Uses {$IFDEF CLR}
     Classes,
     Graphics,
     Types,
     {$ELSE}
     {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes, SysUtils,
     {$IFDEF CLX}
     QGraphics,
     {$ELSE}
     Graphics,
     {$ENDIF}
     {$ENDIF}
     Chart, Series, TeEngine, TeCanvas;

type
   TCustomBoxSeries=class(TPointSeries)
   private
     FExtrOut       : TSeriesPointer;
     FMedianPen     : TChartPen;
     FMildOut       : TSeriesPointer;
     FPosition      : Double;
     FWhiskerLength : Double;
     FWhiskerPen    : TChartPen;
     IVertical      : Boolean;

     FUseCustomValues : Boolean;
     FMedian          : Double;
     FQuartile1       : Double;
     FQuartile3       : Double;
     FInnerFence1     : Double;
     FInnerFence3     : Double;
     FOuterFence1     : Double;
     FOuterFence3     : Double;
     FAdjacentPoint1  : Double;
     FAdjacentPoint3  : Double;

     procedure CalcValues(var R:TRect; var x,y,horiz,vert,tmp:Integer);
     Function GetBox:TSeriesPointer;
     procedure SetAdjacentPoint1(const Value: Double);
     procedure SetAdjacentPoint3(const Value: Double);
     procedure SetExtrOut(Value: TSeriesPointer);
     procedure SetInnerFence1(const Value: Double);
     procedure SetInnerFence3(const Value: Double);
     procedure SetMedian(const Value: Double);
     procedure SetMedianPen(Value: TChartPen);
     procedure SetMildOut(Value: TSeriesPointer);
     procedure SetOuterFence1(const Value: Double);
     procedure SetOuterFence3(const Value: Double);
     procedure SetPosition(Const Value: Double);
     procedure SetQuartile1(const Value: Double);
     procedure SetQuartile3(const Value: Double);
     procedure SetUseCustomValues(const Value: Boolean);
     procedure SetWhiskerLength(Const Value: Double);
     procedure SetWhiskerPen(Value: TChartPen);
     function SaveCustomValues: boolean;
   protected
     procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
     procedure DoBeforeDrawValues; override;
     procedure DrawAllValues; override;
     procedure DrawMark( ValueIndex:Integer; Const St:String;
                                    APosition:TSeriesMarkPosition); override;
     procedure DrawValue(ValueIndex: Integer); override;
     class Function GetEditorClass:String; override;
     function  GetSampleValues: TChartValueList; virtual;
     procedure PrepareForGallery(IsEnabled:Boolean); override;
     procedure SetParentChart(Const Value: TCustomAxisPanel); override;
     procedure SetSampleValues(Value: TChartValueList); virtual;
   public
     Constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;

     Procedure Assign(Source:TPersistent); override;
     function Clicked(x,y:Integer):Integer; override;
     procedure RecalcStats;

     property Box:TSeriesPointer read GetBox;
   published
     property ExtrOut: TSeriesPointer read FExtrOut write SetExtrOut;
     property MedianPen: TChartPen read FMedianPen write SetMedianPen;
     property MildOut: TSeriesPointer read FMildOut write SetMildOut;
     property Position: Double read FPosition write SetPosition;
     property SampleValues: TChartValueList read GetSampleValues write SetSampleValues;
     property UseCustomValues: Boolean read FUseCustomValues write SetUseCustomValues default false;
     property WhiskerLength: Double read FWhiskerLength write SetWhiskerLength;
     property WhiskerPen: TChartPen read FWhiskerPen write SetWhiskerPen;

     property AdjacentPoint1: Double read FAdjacentPoint1 write SetAdjacentPoint1 stored SaveCustomValues; // 7.01 - changed to Double
     property AdjacentPoint3: Double read FAdjacentPoint3 write SetAdjacentPoint3 stored SaveCustomValues; // 7.01 - changed to Double
     property InnerFence1: Double read FInnerFence1 write SetInnerFence1 stored SaveCustomValues;
     property InnerFence3: Double read FInnerFence3 write SetInnerFence3 stored SaveCustomValues;
     property Median: Double read FMedian write SetMedian stored SaveCustomValues;
     property OuterFence1: Double read FOuterFence1 write SetOuterFence1 stored SaveCustomValues;
     property OuterFence3: Double read FOuterFence3 write SetOuterFence3 stored SaveCustomValues;
     property Quartile1: Double read FQuartile1 write SetQuartile1 stored SaveCustomValues;
     property Quartile3: Double read FQuartile3 write SetQuartile3 stored SaveCustomValues;
   end;

   { Vertical Box Series }
   TBoxSeries=class(TCustomBoxSeries)
   public
     Function MinXValue:Double; override;
     Function MaxXValue:Double; override;
     Function MinYValue:Double; override;
     Function MaxYValue:Double; override;
   end;

   { Horizontal Box Series }
   THorizBoxSeries=class(TCustomBoxSeries)
   public
     Constructor Create(AOwner:TComponent); override;
     Function MinYValue:Double; override;
     Function MaxYValue:Double; override;
     Function MinXValue:Double; override;
     Function MaxXValue:Double; override;
   end;

implementation

uses
  {$IFDEF CLR}
  SysUtils,
  {$ENDIF}
  TeeProCo, Math;

{ TCustomBoxSeries }
Constructor TCustomBoxSeries.Create(AOwner: TComponent);
begin
  inherited;
  AllowSinglePoint:=False;
  CalcVisiblePoints:=False;

  XValues.Name:='';
  YValues.Name:='Samples'; // Do not localize

  Marks.Visible:=False;
  Marks.Callout.Length:=0;
  FUseCustomValues := False; { MS : added to support custom values }

  FWhiskerLength:=1.5;
  FMildOut:=TSeriesPointer.Create(Self);
  FMildOut.Style:=psCircle;
  FExtrOut:=TSeriesPointer.Create(Self);
  FExtrOut.Style:=psStar;

  With Pointer do
  begin
    Draw3D:=False;
    Pen.Width:=1;
    VertSize:=15;
    HorizSize:=15;
    Brush.Color:=clWhite;
  end;

  FWhiskerPen:=CreateChartPen;

  FMedianPen:=CreateChartPen;
  FMedianPen.Width:=1;
  FMedianPen.Style:=psDot;

  IVertical:=True;
end;

Destructor TCustomBoxSeries.Destroy;
begin
  FMedianPen.Free;
  FWhiskerPen.Free;
  FreeAndNil(FExtrOut);
  FreeAndNil(FMildOut);
  inherited;
end;

procedure TCustomBoxSeries.SetWhiskerLength(Const Value: Double);
begin
  SetDoubleProperty(FWhiskerLength,Value);
end;

function TCustomBoxSeries.GetSampleValues;
begin
  result:=MandatoryValueList;
end;

procedure TCustomBoxSeries.SetSampleValues(Value: TChartValueList);
begin
  if IVertical then YValues:=Value else XValues:=Value;
end;

procedure TCustomBoxSeries.SetPosition(Const Value: Double);
begin
  SetDoubleProperty(FPosition,Value);
end;

procedure TCustomBoxSeries.SetWhiskerPen(Value: TChartPen);
begin
  FWhiskerPen.Assign(Value);
end;

procedure TCustomBoxSeries.SetMedianPen(Value: TChartPen);
begin
  FMedianPen.Assign(Value);
end;

procedure TCustomBoxSeries.SetMildOut(Value: TSeriesPointer);
begin
  FMildOut.Assign(Value);
end;

procedure TCustomBoxSeries.SetExtrOut(Value: TSeriesPointer);
begin
  FExtrOut.Assign(Value);
end;

procedure TCustomBoxSeries.DoBeforeDrawValues; { 5.02 - new calculation algorithm }
begin
  inherited;

  { if custom values are used, or there are no points, skip the recalculation }
  if (not FUseCustomValues) and (SampleValues.Count>0) then
     RecalcStats;
end;

procedure TCustomBoxSeries.DrawMark(ValueIndex: Integer; const St: String;
  APosition: TSeriesMarkPosition);
begin
  with APosition do
  if IVertical then
  begin
    ArrowTo.X:=CalcXPosValue(FPosition);
    ArrowFrom.X:=ArrowTo.X;
    LeftTop.X:=ArrowTo.X - (Width div 2);
  end
  else
  begin
    ArrowTo.Y:=CalcYPosValue(FPosition);
    ArrowFrom.Y:=ArrowTo.Y;
    LeftTop.Y:=ArrowTo.Y - (Height div 2);
  end;

  inherited;
end;

procedure TCustomBoxSeries.DrawValue(ValueIndex:Integer);
var tmpColor : TColor;
    tmpVal   : Double;
    tmp      : TSeriesPointer;
begin
  tmpVal:=SampleValues.Value[ValueIndex];

  { inside inner fences - no point }
  if (tmpVal>=FInnerFence1) and (tmpVal<=FInnerFence3) then tmp:=nil
  { mild outlined points }
  else
  if ((tmpVal>=FInnerFence3) and (tmpVal<=FOuterFence3)) or
     ((tmpVal<=FInnerFence1) and (tmpVal>=FOuterFence1)) then
     tmp:=FMildOut
  else
    { extreme outlined points }
    tmp:=FExtrOut;

  if Assigned(tmp) then
    with tmp do
    if Visible then
    begin
      tmpColor:=ValueColor[ValueIndex];
      PrepareCanvas(ParentChart.Canvas,tmpColor);

      if IVertical then Draw(CalcXPosValue(FPosition),CalcYPos(ValueIndex),tmpColor,Style)
                   else Draw(CalcXPos(ValueIndex),CalcYPosValue(FPosition),tmpColor,Style)
    end;
end;

procedure TCustomBoxSeries.AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False);
var t : Integer;
    n : Integer;
    tmpSeries : Integer;
begin
  if Assigned(ParentChart) then
     tmpSeries:=ParentChart.SeriesCount+1
  else
     tmpSeries:=1;

  n:=tmpSeries*(3+RandomValue(10));

  Add(-n);

  for t:=2 to NumValues-2 do
      Add(n*t/NumValues);

  Add(2*n);
end;

procedure TCustomBoxSeries.PrepareForGallery(IsEnabled:Boolean);
var t : Integer;
begin
  inherited;

  { by default display 2 series}
  for t:=0 to ParentChart.SeriesCount-1 do
  if ParentChart.Series[t] is TCustomBoxSeries then
  with TCustomBoxSeries(ParentChart.Series[t]) do
  begin
    FPosition:=t+1;
    Pointer.HorizSize:=12;
    MildOut.HorizSize:=3;
    ExtrOut.VertSize:=3;
    FillSampleValues(10*(t+1));
  end;
end;

procedure TCustomBoxSeries.CalcValues(var R:TRect; var x,y,Horiz,Vert,tmp:Integer);
var tmpH,
    tmpV   : Integer;
    tmpPos : Integer;
begin
  if IVertical then
  begin
    tmp:=Pointer.HorizSize;

    R.Left:=CalcXPosValue(FPosition)-tmp;
    R.Right:=CalcXPosValue(FPosition)+tmp;
    R.Top:=CalcYPosValue(FQuartile3);
    R.Bottom:=CalcYPosValue(FQuartile1);
  end
  else
  begin
    tmp:=Pointer.VertSize;

    R.Top:=CalcYPosValue(FPosition)-tmp;
    R.Bottom:=CalcYPosValue(FPosition)+tmp;
    R.Right:=CalcXPosValue(FQuartile3);
    R.Left:=CalcXPosValue(FQuartile1);
  end;

  if GetHorizAxis.Inverted then
     SwapInteger(R.Left,R.Right);

  if GetVertAxis.Inverted then
     SwapInteger(R.Top,R.Bottom);

  if IVertical then
  begin
    tmpV:=(R.Bottom-R.Top) div 2;

    if GetHorizAxis.Inverted then tmpPos:=R.Left-tmp
                             else tmpPos:=R.Left+tmp;

    x:=tmpPos;
    y:=R.Top+tmpV;
    Horiz:=Pointer.HorizSize-1;
    Vert:=tmpV-1;