teeboxplot.pas

BCB第三方组件

  end
  else
  begin
    tmpH:=(R.Right-R.Left) div 2;

    if GetVertAxis.Inverted then tmpPos:=R.Top-tmp
                            else tmpPos:=R.Top+tmp;

    x:=R.Left+tmpH;
    y:=tmpPos;
    Horiz:=tmpH-1;
    Vert:=Pointer.VertSize-1;
  end;
end;

function TCustomBoxSeries.Clicked(x,y:Integer):Integer; // 8.01
var tmpX, tmpY, tmpHoriz, tmpVert, tmp : Integer;
    R : TRect;
begin
  result:=inherited Clicked(x,y);

  if (result=TeeNoPointClicked) and Pointer.Visible then
  begin
    CalcValues(R, tmpX,tmpY,tmpHoriz,tmpVert,tmp);

    if PointInRect(TeeRect(tmpX-tmpHoriz,tmpY-tmpVert,tmpX+tmpHoriz,tmpY+tmpVert),x,y) then
       result:=0;
  end;
end;

procedure TCustomBoxSeries.DrawAllValues;

  Function CalcPos(Const Value:Double):Integer;
  begin
    if IVertical then result:=CalcYPosValue(Value)
                 else result:=CalcXPosValue(Value);
  end;

var
  tmp : Integer;
  tmp1 : Integer;
  tmpZ : Integer;

  Procedure DrawWhisker(const AdjPos: Double; Pos:Integer);
  var tmp2 : Integer;
  begin
    tmp2:=CalcPos(AdjPos);

    With ParentChart,Canvas do
    if View3D then
    begin
      if IVertical then
      begin
        VertLine3D(tmp1,Pos,tmp2,tmpZ);
        HorizLine3D(tmp1-tmp,tmp1+tmp,tmp2,tmpZ);
      end
      else
      begin
        HorizLine3D(Pos,tmp2,tmp1,tmpZ);
        VertLine3D(tmp2,tmp1-tmp,tmp1+tmp,tmpZ);
      end;
    end
    else
    if IVertical then
    begin
      DoVertLine(tmp1,Pos,tmp2);
      DoHorizLine(tmp1-tmp,tmp1+tmp,tmp2);
    end
    else
    begin
      DoHorizLine(Pos,tmp2,tmp1);
      DoVertLine(tmp2,tmp1-tmp,tmp1+tmp);
    end;
  end;

var tmpX,
    tmpY,
    tmpV,
    tmpHoriz,
    tmpVert : Integer;
    R       : TRect;
begin
  inherited;

  CalcValues(R,tmpX,tmpY,tmpHoriz,tmpVert,tmp);

  with Pointer do (* box *)
  if Visible then
  begin
    PrepareCanvas(ParentChart.Canvas,Color);;
    DrawPointer(ParentChart.Canvas,
                ParentChart.View3D,tmpX,tmpY,tmpHoriz,tmpVert,
                Brush.Color,Style);
  end;

  (* median *)
  if FMedianPen.Visible then
  begin
    ParentChart.Canvas.AssignVisiblePen(FMedianPen);
    ParentChart.Canvas.Brush.Style:=bsClear;

    tmpV:=CalcPos(FMedian);

    with ParentChart.Canvas do
    if IVertical then
       if ParentChart.View3D then HorizLine3D(R.Left,R.Right,tmpV,StartZ)
                             else DoHorizLine(R.Left,R.Right,tmpV)
    else
       if ParentChart.View3D then VertLine3D(tmpV,R.Top,R.Bottom,StartZ)
                             else DoVertLine(tmpV,R.Top,R.Bottom);
  end;

  (* whiskers *)
  if FWhiskerPen.Visible then
  begin
    if Pointer.Visible and Pointer.Draw3D then tmpZ:=MiddleZ
                                          else tmpZ:=StartZ;

    ParentChart.Canvas.AssignVisiblePen(FWhiskerPen);

    if IVertical then
    begin
      tmp1:=(R.Left+R.Right) div 2;
      DrawWhisker(FAdjacentPoint1,R.Bottom);
      DrawWhisker(FAdjacentPoint3,R.Top);
    end
    else
    begin
      tmp1:=(R.Top+R.Bottom) div 2;
      DrawWhisker(FAdjacentPoint1,R.Left);
      DrawWhisker(FAdjacentPoint3,R.Right);
    end;
  end;
end;

procedure TCustomBoxSeries.SetParentChart(const Value: TCustomAxisPanel);
begin
  inherited;

  if not (csDestroying in ComponentState) then
  begin
    if Assigned(FExtrOut) then FExtrOut.ParentChart:=Value;
    if Assigned(FMildOut) then FMildOut.ParentChart:=Value;
  end;
end;

class function TCustomBoxSeries.GetEditorClass: String;
begin
  result:='TBoxSeriesEditor'; // Do not localize
end;

function TCustomBoxSeries.GetBox: TSeriesPointer;
begin
  result:=Pointer;
end;

procedure TCustomBoxSeries.Assign(Source: TPersistent);
begin
  if Source is TCustomBoxSeries then
  With TCustomBoxSeries(Source) do
  begin
     Self.ExtrOut        :=ExtrOut;
     Self.MedianPen      :=MedianPen;
     Self.MildOut        :=MildOut;
     Self.FPosition      :=Position;
     Self.FWhiskerLength :=FWhiskerLength;
     Self.WhiskerPen     :=WhiskerPen;
     Self.FUseCustomValues := FUseCustomValues;

     Self.FMedian        :=FMedian;
     Self.FQuartile1     :=FQuartile1;
     Self.FQuartile3     :=FQuartile3;
     Self.FInnerFence1   :=FInnerFence1;
     Self.FInnerFence3   :=FInnerFence3;
     Self.FOuterFence1   :=FOuterFence1;
     Self.FOuterFence3   :=FOuterFence3;
     Self.FAdjacentPoint1:=FAdjacentPoint1;
     Self.FAdjacentPoint3:=FAdjacentPoint3;
  end;

  inherited;
end;

procedure TCustomBoxSeries.SetUseCustomValues(const Value: Boolean);
begin
  SetBooleanProperty(FUseCustomValues,Value);
end;

procedure TCustomBoxSeries.SetMedian(const Value: Double);
begin
  SetDoubleProperty(FMedian,Value);
end;

procedure TCustomBoxSeries.SetQuartile1(const Value: Double);
begin
  SetDoubleProperty(FQuartile1,Value);
end;

procedure TCustomBoxSeries.SetQuartile3(const Value: Double);
begin
  SetDoubleProperty(FQuartile3,Value);
end;

procedure TCustomBoxSeries.SetInnerFence1(const Value: Double);
begin
  SetDoubleProperty(FInnerFence1,Value);
end;

procedure TCustomBoxSeries.SetInnerFence3(const Value: Double);
begin
  SetDoubleProperty(FInnerFence3,Value);
end;

procedure TCustomBoxSeries.SetOuterFence1(const Value: Double);
begin
  SetDoubleProperty(FOuterFence1,Value);
end;

procedure TCustomBoxSeries.SetOuterFence3(const Value: Double);
begin
  SetDoubleProperty(FOuterFence3,Value);
end;

function TCustomBoxSeries.SaveCustomValues: boolean;
begin
  Result := FUseCustomValues;
end;

procedure TCustomBoxSeries.SetAdjacentPoint1(const Value: Double);
begin
  SetDoubleProperty(FAdjacentPoint1,Value);
end;

procedure TCustomBoxSeries.SetAdjacentPoint3(const Value: Double);
begin
  SetDoubleProperty(FAdjacentPoint3,Value);
end;

procedure TCustomBoxSeries.RecalcStats;
var N    : Integer;
    i    : Integer;
    FIqr : Double;
    FMed : Integer;
    InvN : Double;

  { Calculate 1st and 3rd quartile }
  function Percentile(Const P: Double): Double;
  var QQ,
      OldQQ,
      U      : Double;
  begin
    i := 0;
    QQ := 0.0;
    OldQQ := 0.0;

    while QQ < P do
    begin
      OldQQ := QQ;
      QQ := (0.5+i)*InvN;
      Inc(i);
    end;

    U := (P-OldQQ)/(QQ-OldQQ);
    Result := SampleValues[i-2] + (SampleValues[i-1]-SampleValues[i-2])*U;
  end;

begin
  N:=SampleValues.Count;
  InvN := 1.0/N;
  { calculate median }
  FMed := N div 2;
  if Odd(N) then FMedian := SampleValues[FMed]
  else FMedian := 0.5* (SampleValues[FMed-1] + SampleValues[FMed]);

  { calculate Q1 and Q3 }
  FQuartile1 := Percentile(0.25);
  FQuartile3 := Percentile(0.75);

  { calculate IQR }
  FIqr:=FQuartile3-FQuartile1;
  FInnerFence1:=FQuartile1-FWhiskerLength*FIqr;
  FInnerFence3:=FQuartile3+FWhiskerLength*FIqr;

  { find adjacent points }
  for i := 0 to FMed do
      if SampleValues.Value[i]>FInnerFence1 then Break;

  FAdjacentPoint1:=SampleValues[i];

  for i := FMed to N-1 do
      if SampleValues.Value[i]>FInnerFence3 then Break;

  FAdjacentPoint3 := SampleValues[i-1];

  { calculate outer fences }
  FOuterFence1:=FQuartile1-2*FWhiskerLength*FIqr;
  FOuterFence3:=FQuartile3+2*FWhiskerLength*FIqr;
end;

{ TBoxSeries }
function TBoxSeries.MaxXValue: Double;
begin
  result:=FPosition;
end;

function TBoxSeries.MinXValue: Double;
begin
  result:=FPosition;
end;

function TBoxSeries.MaxYValue: Double;
begin
  Result := Max(inherited MaxYValue,Max(FAdjacentPoint1,FAdjacentPoint3));
  if FUseCustomValues then
     Result := Max(Result,Max(FOuterFence1,FOuterFence3));
end;

function TBoxSeries.MinYValue: Double;
begin
  Result := Min(inherited MinYValue,Min(FAdjacentPoint1,FAdjacentPoint3));
  if FUseCustomValues then
     Result := Min(Result,Min(FOuterFence1,FOuterFence3));
end;

{ THorizBoxSeries}
Constructor THorizBoxSeries.Create(AOwner:TComponent);
begin
  inherited;
  SetHorizontal;
  IVertical:=False;
end;

function THorizBoxSeries.MaxXValue: Double;
begin
  Result := Max(inherited MaxXValue,Max(FAdjacentPoint1,FAdjacentPoint3));
  if FUseCustomValues then
     Result := Max(Result,Max(FOuterFence1,FOuterFence3));
end;

function THorizBoxSeries.MinXValue: Double;
begin
  Result := Min(inherited MinXValue,Min(FAdjacentPoint1,FAdjacentPoint3));
  if FUseCustomValues then
     Result := Min(Result,Min(FOuterFence1,FOuterFence3));
end;

function THorizBoxSeries.MaxYValue: Double;
begin
  result:=FPosition;
end;

function THorizBoxSeries.MinYValue: Double;
begin
  result:=FPosition;
end;

initialization
  RegisterTeeSeries(TBoxSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryBoxPlot,
                                {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryStats,2);
  RegisterTeeSeries(THorizBoxSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryHorizBoxPlot,
                                     {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryStats,2);
finalization
  UnRegisterTeeSeries([TBoxSeries,THorizBoxSeries]);
end.