teeshape.pas

TeeChart7Source 控件

{******************************************}
{ TChartShape Series Component             }
{ Copyright (c) 1995-2004 by David Berneda }
{******************************************}
unit TeeShape;
{$I TeeDefs.inc}

interface

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

type
  TChartShapeXYStyle=( xysPixels, xysAxis, xysAxisOrigin );

  TChartShapeStyle=( chasRectangle,
                     chasCircle,
                     chasVertLine,
                     chasHorizLine,
                     chasTriangle,
                     chasInvertTriangle,
                     chasLine,
                     chasDiamond,
                     chasCube,
                     chasCross,
                     chasDiagCross,
                     chasStar,
                     chasPyramid,
                     chasInvertPyramid );

  TTeeVertAlign=(vaTop,vaCenter,vaBottom);

  TChartShape = class(TChartSeries)
  private
    FAlignment      : TAlignment;
    FFont           : TTeeFont;
    FGradient       : TChartGradient;
    FRoundRectangle : Boolean;
    FStyle          : TChartShapeStyle;
    FText           : TStrings;
    FTransparent    : Boolean;
    FVertAlign      : TTeeVertAlign;
    FXYStyle        : TChartShapeXYStyle;
    Procedure AddDefaultPoints;
    Function GetX0:Double;
    Function GetX1:Double;
    Function GetY0:Double;
    Function GetY1:Double;
    procedure SetAlignment(Value: TAlignment);
    procedure SetFont(Value: TTeeFont);
    procedure SetRoundRectangle(Value: Boolean);
    Procedure SetShapeRectangle(Const ARect:TRect);
    procedure SetStyle(Value : TChartShapeStyle);
    procedure SetTransparent(Value: Boolean);
    procedure SetVertAlign(Value: TTeeVertAlign);
    Procedure SetX0(Const Value:Double);
    Procedure SetX1(Const Value:Double);
    procedure SetXYStyle(Value: TChartShapeXYStyle);
    Procedure SetY0(Const Value:Double);
    Procedure SetY1(Const Value:Double);
    procedure SetGradient(const Value: TChartGradient);
  protected
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    Procedure CalcZOrder; override;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DrawLegendShape(ValueIndex:Integer; Const Rect:TRect); override;
    procedure DrawShape(Is3D:Boolean; Const R:TRect);
    procedure DrawText(Const R:TRect);
    procedure DrawValue(ValueIndex:Integer); override;
    Function  GetAdjustedRectangle:TRect;
    class Function GetEditorClass:String; override;
    Function  GetShapeRectangle:TRect; virtual;
    Function  MoreSameZOrder:Boolean; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    Procedure SetSeriesColor(AColor:TColor); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
    procedure SetText(Value : TStrings); virtual;
  public
    Constructor Create(AOwner : TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Function Clicked(x,y:Integer):Integer; override;
    Function IsValidSourceOf(Value:TChartSeries):Boolean; override;
    Function UseAxis:Boolean; override;

    property Bounds:TRect read GetShapeRectangle write SetShapeRectangle;
  published
    property Active;
    property Cursor;
    property Depth;
    property HorizAxis;
    property Marks; { 5.01 }
    property ParentChart;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property VertAxis;
    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnClick;
    property OnDblClick;

    property Alignment: TAlignment read FAlignment write SetAlignment
                                   default taCenter;
    property Brush;
    property Font:TTeeFont read FFont write SetFont;
    property Gradient:TChartGradient read FGradient write SetGradient;
    property Text:TStrings read FText write SetText;
    property Pen;
    property RoundRectangle: Boolean read FRoundRectangle
                                     write SetRoundRectangle default False;
    property Style : TChartShapeStyle Read FStyle write SetStyle
                                      default chasCircle;
    property Transparent:Boolean read FTransparent
                                 write SetTransparent default False;
    property VertAlign: TTeeVertAlign read FVertAlign write SetVertAlign
                                      default vaCenter;
    property XYStyle:TChartShapeXYStyle read FXYStyle
                                        write SetXYStyle default xysAxis;
    property X0:Double read GetX0 write SetX0;
    property X1:Double read GetX1 write SetX1;
    property Y0:Double read GetY0 write SetY0;
    property Y1:Double read GetY1 write SetY1;
    property XValues;
    property YValues;
  end;

implementation

Uses SysUtils, TeeConst;

{ TChartShape }
Constructor TChartShape.Create(AOwner : TComponent);
Begin
  inherited;
  FAlignment:=taCenter;
  FVertAlign:=vaCenter;
  CalcVisiblePoints:=False;
  Brush.Color:=clWhite;
  FStyle:=chasCircle;
  FFont:=TTeeFont.Create(CanvasChanged);
  FGradient:=TChartGradient.Create(CanvasChanged);
  FText:=TStringList.Create;
  TStringList(FText).OnChange:=CanvasChanged;
  SeriesColor:=Brush.Color;
  FXYStyle:=xysAxis;
  AddDefaultPoints;
End;

Destructor TChartShape.Destroy;
Begin
  FText.Free;
  FGradient.Free;
  FFont.Free;
  inherited;
End;

Procedure TChartShape.DrawLegendShape(ValueIndex:Integer; Const Rect:TRect);
begin
  DrawShape(False,Rect);
end;

Function TChartShape.GetX0:Double;
Begin
  result:=XValues.Value[0]
End;

Procedure TChartShape.SetX0(Const Value:Double);
Begin
  XValues.Value[0]:=Value;
  Repaint;
End;

Function TChartShape.GetY0:Double;
Begin
  result:=YValues.Value[0]
End;

Procedure TChartShape.SetY0(Const Value:Double);
Begin
  YValues.Value[0]:=Value;
  Repaint;
End;

Function TChartShape.GetX1:Double;
Begin
  result:=XValues.Value[1]
End;

Procedure TChartShape.SetX1(Const Value:Double);
Begin
  XValues.Value[1]:=Value;
  Repaint;
End;

Function TChartShape.GetY1:Double;
Begin
  result:=YValues.Value[1]
End;

Procedure TChartShape.SetY1(Const Value:Double);
Begin
  YValues.Value[1]:=Value;
  Repaint;
End;

procedure TChartShape.SetStyle(Value : TChartShapeStyle);
Begin
  if Value<>FStyle then
  begin
    FStyle:=Value;
    Repaint;
  end;
End;

Procedure TChartShape.SetSeriesColor(AColor:TColor);
Begin
  inherited;
  Brush.Color:=AColor;
end;

procedure TChartShape.DrawShape(Is3D:Boolean; Const R:TRect);

  Procedure DrawDiagonalCross2D;
  begin
    With ParentChart.Canvas,R do
    Begin
      Line(Left,Top,Right+1,Bottom+1);
      Line(Left,Bottom,Right+1,Top-1);
    end;
  end;

  Procedure DrawDiagonalCross3D;
  begin
    With ParentChart.Canvas,R do
    Begin
      LineWithZ(TopLeft,BottomRight,MiddleZ);
      LineWithZ(Left,Bottom,Right,Top,MiddleZ);
    end;
  end;

var tmpMidX : Integer;
    tmpMidY : Integer;

  Procedure DrawCross3D;
  begin
    With ParentChart.Canvas,R do
    Begin
      VertLine3D(tmpMidX,Top,Bottom,MiddleZ);
      HorizLine3D(Left,Right,tmpMidY,MiddleZ);
    end;
  end;

  Procedure DrawCross2D;
  begin
    With ParentChart.Canvas,R do
    Begin
      DoVertLine(tmpMidX,Top,Bottom+1);
      DoHorizLine(Left,Right+1,tmpMidY);
    end;
  end;

  Procedure DoGradient;
  var tmpR : TRect;
  begin
    if (not Transparent) and Gradient.Visible then
    begin
      if Is3D then tmpR:=ParentChart.Canvas.CalcRect3D(R,MiddleZ)
              else tmpR:=R;
      if FStyle=chasCircle then
         ParentChart.Canvas.ClipEllipse(tmpR);
      Gradient.Draw(ParentChart.Canvas,tmpR);
      if FStyle=chasCircle then
         ParentChart.Canvas.UnClipRectangle;
      ParentChart.Canvas.Brush.Style:=bsClear;
    end;
  end;

begin
  With ParentChart.Canvas do
  Begin
    AssignVisiblePen(Self.Pen);
    if FTransparent then Brush.Style:=bsClear
                    else AssignBrush(Self.Brush,Self.SeriesColor);

    if Self.Brush.Color=clNone then { 5.02 }
       BackMode:=cbmTransparent
    else
       BackMode:=cbmOpaque;

    RectCenter(R,tmpMidX,tmpMidY);

    With R do
    if Is3D then
    Case Self.FStyle of
     chasRectangle      : begin
                            DoGradient;
                            RectangleWithZ(R,MiddleZ);
                          end;
     chasCircle         : begin
                            DoGradient;
                            EllipseWithZ(Left,Top,Right,Bottom,MiddleZ);
                          end;
     chasVertLine       : VertLine3D(tmpMidX,Top,Bottom,MiddleZ);
     chasHorizLine      : HorizLine3D(Left,Right,tmpMidY,MiddleZ);
     chasTriangle       : TriangleWithZ( TeePoint(Left,Bottom),
                                         TeePoint(tmpMidX,Top),
                                         BottomRight, MiddleZ );
     chasInvertTriangle : TriangleWithZ( TopLeft,
                                         TeePoint(tmpMidX,Bottom),
                                         TeePoint(Right,Top), MiddleZ);
     chasLine           : LineWithZ(TopLeft,BottomRight,MiddleZ);
     chasDiamond        : PlaneWithZ( TeePoint(Left,tmpMidY),
                                      TeePoint(tmpMidX,Top),
                                      TeePoint(Right,tmpMidY),
                                      TeePoint(tmpMidX,Bottom), MiddleZ );
     chasCube           : Cube(R,StartZ,EndZ,not FTransparent);
     chasCross          : DrawCross3D;
     chasDiagCross      : DrawDiagonalCross3D;
     chasStar           : begin DrawCross3D; DrawDiagonalCross3D; end;
     chasPyramid        : Pyramid(True,Left,Top,Right,Bottom,StartZ,EndZ,not FTransparent);
     chasInvertPyramid  : Pyramid(True,Left,Bottom,Right,Top,StartZ,EndZ,not FTransparent);
    end
    else
    Case Self.FStyle of
     chasRectangle      : if FRoundRectangle then
                             RoundRect(Left,Top,Right,Bottom,12,12)
                          else
                          begin
                            DoGradient;
                            Rectangle(TeeRect(R.Left,R.Top,R.Right+1,R.Bottom+1));
                          end;
     chasCircle         : begin
                            DoGradient;
                            Ellipse(R);
                          end;
     chasVertLine       : DoVertLine(tmpMidX,Top,Bottom);
     chasHorizLine      : DoHorizLine(Left,Right+1,tmpMidY);