teeboxplot.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

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

interface

Uses {$IFDEF CLR}
     Classes,
     Graphics,
     {$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;
     Function GetBox:TSeriesPointer;
     procedure SetExtrOut(Value: TSeriesPointer);
     procedure SetMedianPen(Value: TChartPen);
     procedure SetMildOut(Value: TSeriesPointer);
     procedure SetPosition(Const Value: Double);
     procedure SetWhiskerLength(Const Value: Double);
     procedure SetWhiskerPen(Value: TChartPen);
     procedure SetUseCustomValues(const Value: boolean);
     procedure SetMedian(const Value: double);
     procedure SetQuartile1(const Value: double);
     procedure SetQuartile3(const Value: double);
     procedure SetInnerFence1(const Value: double);
     procedure SetInnerFence3(const Value: double);
     procedure SetOuterFence1(const Value: double);
     procedure SetOuterFence3(const Value: double);
     procedure SetAdjacentPoint1(const Value: double);
     procedure SetAdjacentPoint3(const Value: double);
   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;
     procedure RecalcStats; // 7.01

     property Box:TSeriesPointer read GetBox;
     { MS : Added to support custom values }
     property Median: double read FMedian write SetMedian;
     property Quartile1: double read FQuartile1 write SetQuartile1;
     property Quartile3: double read FQuartile3 write SetQuartile3;
     property InnerFence1: double read FInnerFence1 write SetInnerFence1;
     property InnerFence3: double read FInnerFence3 write SetInnerFence3;
     property OuterFence1: double read FOuterFence1 write SetOuterFence1;
     property OuterFence3: double read FOuterFence3 write SetOuterFence3;
     property AdjacentPoint1 : double read FAdjacentPoint1 write SetAdjacentPoint1; // 7.01 - changed to double
     property AdjacentPoint3 : double read FAdjacentPoint3 write SetAdjacentPoint3; // 7.01 - changed to double
   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 WhiskerLength : Double read FWhiskerLength write SetWhiskerLength;
     property WhiskerPen    : TChartPen read FWhiskerPen write SetWhiskerPen;
     property UseCustomValues : boolean read FUseCustomValues write SetUseCustomValues default false;
   end;

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

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

implementation

Uses {$IFDEF CLR}
     SysUtils,
     {$ENDIF}
     TeeProCo;

{ TCustomBoxSeries }
Constructor TCustomBoxSeries.Create(AOwner: TComponent);
begin
  inherited;
  AllowSinglePoint:=False;
  CalcVisiblePoints:=False;
  XValues.Name:='';
  YValues.Name:='Samples';   { <- do not translate }
  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;
begin
  t:=ParentChart.SeriesCount+1;
  n:=t*(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;