teeboxplot.pas

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

procedure TCustomBoxSeries.DrawAllValues;
Var tmp  : Integer;
    tmp1 : Integer;
    tmpZ : Integer;

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

  Procedure DrawWhisker(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 AL,AT,AR,AB,
    tmpH,tmpV,
    tmpA1,tmpA2 : Integer;
begin
  inherited;

  if IVertical then
  begin
    tmp:=Pointer.HorizSize; // 6.0
    AL:=CalcXPosValue(FPosition)-tmp;
    AR:=CalcXPosValue(FPosition)+tmp;
    AT:=CalcYPosValue(FQuartile3);
    AB:=CalcYPosValue(FQuartile1);
    tmpA1:=AB;
    tmpA2:=AT;
  end
  else
  begin
    tmp:=Pointer.HorizSize; // 6.0
    AT:=CalcYPosValue(FPosition)-tmp;
    AB:=CalcYPosValue(FPosition)+tmp;
    AR:=CalcXPosValue(FQuartile3);
    AL:=CalcXPosValue(FQuartile1);
    tmpA1:=AL;
    tmpA2:=AR;
  end;

  if GetHorizAxis.Inverted then SwapInteger(AL,AR);
  if GetVertAxis.Inverted then SwapInteger(AT,AB);

  With ParentChart,Canvas do
  begin
    with Pointer do (* box *)
    if Visible then
    begin
      PrepareCanvas(ParentChart.Canvas,Color);;
      if IVertical then
      begin
        tmpV:=(AB-AT) div 2;
        DrawPointer(Canvas,View3D,AL+tmp-1,AT+tmpV,HorizSize-1,tmpV-1,Brush.Color,Style);
      end
      else
      begin
        tmpH:=(AR-AL) div 2;
        DrawPointer(Canvas,View3D,AL+tmpH,AT+tmp-1,tmpH-1,VertSize-1,Brush.Color,Style);
      end;
    end;

    (* median *)
    if FMedianPen.Visible then
    begin
      AssignVisiblePen(FMedianPen);
      Brush.Style:=bsClear;
      tmpV:=CalcPos(FMedian);
      if IVertical then
         if View3D then HorizLine3D(AL,AR,tmpV,StartZ)
                   else DoHorizLine(AL,AR,tmpV)
      else
         if View3D then VertLine3D(tmpV,AT,AB,StartZ)
                   else DoVertLine(tmpV,AT,AB);
    end;

    (* whiskers *)
    if FWhiskerPen.Visible then
    begin
      if Pointer.Visible and Pointer.Draw3D then tmpZ:=MiddleZ else tmpZ:=StartZ;
      AssignVisiblePen(FWhiskerPen);
      if IVertical then tmp1:=(AL+AR) div 2
                   else tmp1:=(AT+AB) div 2;
      DrawWhisker(FAdjacentPoint1,tmpA1);
      DrawWhisker(FAdjacentPoint3,tmpA2);
    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';
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;
  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;

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;

{ THorizBoxSeries}
Constructor THorizBoxSeries.Create(AOwner:TComponent);
begin
  inherited;
  SetHorizontal;
  IVertical:=False;
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.