teemapseries.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 684 行 · 第 1/2 页

{******************************************}
{    TeeChart Map Series                   }
{ Copyright (c) 2000-2003 by David Berneda }
{    All Rights Reserved                   }
{******************************************}
unit TeeMapSeries;
{$I TeeDefs.inc}

interface

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

type
  TPolygonSeries=class(TChartSeries)
  protected
    Procedure DrawLegendShape(ValueIndex:Integer; Const Rect:TRect); override;
    Procedure NotifyValue(ValueEvent:TValueEvent; ValueIndex:Integer); override;
    procedure PrepareLegendCanvas(ValueIndex:Integer; Var BackColor:TColor;
                                Var BrushStyle:TBrushStyle); override;
    Procedure SetActive(Value:Boolean); override;
    Procedure SetSeriesColor(AColor:TColor); override;
  public
    Procedure FillSampleValues(NumValues:Integer); override;
  end;

  TMapSeries=class;

  TTeePolygon=class(TCollectionItem)
  private
    FGradient    : TChartGradient;
    FParentBrush : Boolean;
    FParentPen   : Boolean;
    FPoints      : TPolygonSeries;
    function GetBrush: TChartBrush;
    function GetColor: TColor;
    function GetPen: TChartPen;
    Function GetSeries:TMapSeries;
    Function GetText:String;
    function GetZ: Double;
    procedure SetBrush(const Value: TChartBrush);
    procedure SetColor(const Value: TColor);
    procedure SetGradient(const Value: TChartGradient);
    procedure SetParentBrush(const Value: Boolean);
    procedure SetParentPen(const Value: Boolean);
    procedure SetPen(const Value: TChartPen);
    Procedure SetText(Const Value:String);
    procedure SetZ(const Value: Double);
  public
    Constructor Create(Collection:TCollection); override;
    Destructor Destroy; override;

    Function AddXY(Const X,Y:Double):Integer;
    Procedure Draw(ACanvas:TCanvas3D);
    Function GetBounds(Const P:TPointArray):TRect;
    Function GetPoints:TPointArray;
    property ParentSeries:TMapSeries read GetSeries;
    property Points:TPolygonSeries read FPoints;
  published
    property Brush:TChartBrush read GetBrush write SetBrush;
    property Color:TColor read GetColor write SetColor default clWhite;
    property Gradient:TChartGradient read FGradient write SetGradient;
    property ParentBrush:Boolean read FParentBrush write SetParentBrush default True;
    property ParentPen:Boolean read FParentPen write SetParentPen default True;
    property Pen:TChartPen read GetPen write SetPen;
    property Text:String read GetText write SetText;
    property Z:Double read GetZ write SetZ;
  end;

  TTeePolygonList=class(TOwnedCollection)
  private
    Procedure Delete(Start,Quantity:Integer); overload;
    Function Get(Index:Integer):TTeePolygon;
    Procedure Put(Index:Integer; Const Value:TTeePolygon);
  public
    Function Add:TTeePolygon;
    Function Owner:TMapSeries;
    property Polygon[Index:Integer]:TTeePolygon read Get write Put; default;
  end;

  TMapSeries=class(TCustom3DPaletteSeries)
  private
    FShapes : TTeePolygonList;
    procedure SetShapes(const Value: TTeePolygonList);
  protected
    Procedure AddSampleValues(NumValues:Integer); override;
    Procedure CalcHorizMargins(Var LeftMargin,RightMargin:Integer); override;
    Procedure CalcVerticalMargins(Var TopMargin,BottomMargin:Integer); override;
    class procedure CreateSubGallery(AddSubChart: TChartSubGalleryProc); override;
    Procedure DrawMark( ValueIndex:Integer; Const St:String;
                        APosition:TSeriesMarkPosition); override;
    Procedure DrawValue(ValueIndex:Integer); override;
    Procedure GalleryChanged3D(Is3D:Boolean); override;
    class Function GetEditorClass:String; override;
    procedure PrepareForGallery(IsEnabled:Boolean); override;
    class procedure SetSubGallery(ASeries: TChartSeries; Index: Integer); override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Clear; override;
    Function Clicked(x,y:Integer):Integer; override;
    Procedure Delete(ValueIndex:Integer); overload; override;
    Procedure Delete(Start,Quantity:Integer); overload; override;
    Function MaxXValue:Double; override;
    Function MaxYValue:Double; override;
    Function MinXValue:Double; override;
    Function MinYValue:Double; override;
    procedure SwapValueIndex(a,b:Integer); override;
  published
    { Published declarations }
    property Active;
    property ColorSource;
    property Cursor;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    property Brush;
    property EndColor;
    property MidColor;
    property LegendEvery;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property Shapes:TTeePolygonList read FShapes write SetShapes stored False;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property TimesZOrder;
    property XValues;
    property YValues;
    property ZValues;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetColor;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;
  end;

implementation

Uses Math, TeeConst, TeeProCo, Chart;

Type TSeriesAccess=class(TChartSeries);

{ TTeePolygon }
constructor TTeePolygon.Create(Collection: TCollection);
begin
  inherited;
  FGradient:=TChartGradient.Create(TSeriesAccess(ParentSeries).CanvasChanged);
  FPoints:=TPolygonSeries.Create(ParentSeries);
  FPoints.Tag:=Integer(Self);
  FPoints.XValues.Order:=loNone;
  FPoints.ShowInLegend:=False;
  FParentPen:=True;
  FParentBrush:=True;
  ParentSeries.AddXY(0,0);
end;

Destructor TTeePolygon.Destroy;
begin
  FPoints.Free;
  FGradient.Free;
  inherited;
end;

function TTeePolygon.AddXY(const X,Y: Double): Integer;
begin
  result:=FPoints.AddXY(X,Y);
end;

{ return the array of Points in screen (pixel) coordinates }
Function TTeePolygon.GetPoints:TPointArray;
var t : Integer;
begin
  SetLength(result,FPoints.Count);
  With ParentSeries do
  for t:=0 to FPoints.Count-1 do
  With result[t] do
  begin
    X:=GetHorizAxis.CalcPosValue(FPoints.XValues.Value[t]);
    Y:=GetVertAxis.CalcPosValue(FPoints.YValues.Value[t]);
  end;
end;

{ return the minimum left / top and the maximum right / bottom
  for all the points in "P" }
Function TTeePolygon.GetBounds(Const P:TPointArray):TRect;
var t : Integer;
begin
  result:=TeeRect(0,0,0,0);
  if Length(P)>0 then
  With result do
  begin
    TopLeft:=P[0];
    BottomRight:=TopLeft;
    for t:=0 to Length(P)-1 do
    begin
      if P[t].X<Left then Left:=P[t].X
      else
      if P[t].X>Right then Right:=P[t].X;
      if P[t].Y<Top then Top:=P[t].Y
      else
      if P[t].Y>Bottom then Bottom:=P[t].Y;
    end;
  end;
end;

{ draw the polygon... }
procedure TTeePolygon.Draw(ACanvas: TCanvas3D);
Var P     : TPointArray;
    P2    : Array[0..1000] of TPoint;
    t     : Integer;
    tmpZ  : Integer;
begin
  P:=nil;
  if FPoints.Active and (FPoints.Count>0) then
  With ACanvas do
  begin
    tmpZ:=ParentSeries.CalcZPos(Index);

    { set pen and brush... }
    if ParentPen then AssignVisiblePen(ParentSeries.Pen)
                 else AssignVisiblePen(Self.Pen);
    if ParentBrush then AssignBrush(ParentSeries.Brush,Self.Color)
                   else AssignBrush(Self.Brush,Self.Color);

    P:=GetPoints;
    try
      { draw a gradient... }
      if Self.Gradient.Visible and ParentSeries.ParentChart.CanClip then
      begin
        for t:=0 to Length(P)-1 do
            P2[t]:=Calculate3DPosition(P[t],tmpZ);

        ClipPolygon(ACanvas,P2,Length(P));
        Self.Gradient.Draw(ACanvas,CalcRect3D(GetBounds(P),tmpZ));
        ACanvas.UnClipRectangle;
        Brush.Style:=bsClear;
      end;

      { draw the shape... }
      PolygonWithZ(P,tmpZ);

    finally
      P:=nil;
    end;
  end;
end;

function TTeePolygon.GetBrush: TChartBrush;
begin
  result:=FPoints.Brush;
end;

function TTeePolygon.GetColor: TColor;
begin
  result:=ParentSeries.ValueColor[Index];
end;

function TTeePolygon.GetPen: TChartPen;
begin
  result:=FPoints.Pen;
end;

function TTeePolygon.GetSeries: TMapSeries;
begin
  result:=TTeePolygonList(Collection).Owner as TMapSeries;
end;

procedure TTeePolygon.SetBrush(const Value: TChartBrush);
begin
  FPoints.Brush:=Value;
end;

procedure TTeePolygon.SetColor(const Value: TColor);
begin
  Points.SeriesColor:=Value;
end;

procedure TTeePolygon.SetGradient(const Value: TChartGradient);
begin
  FGradient.Assign(Value);
end;

procedure TTeePolygon.SetPen(const Value: TChartPen);
begin
  FPoints.Pen:=Value;
end;

procedure TTeePolygon.SetZ(const Value: Double);
begin
  ParentSeries.ZValues[Index]:=Value;
end;

function TTeePolygon.GetZ: Double;
begin
  result:=ParentSeries.ZValues[Index];
end;

function TTeePolygon.GetText: String;
begin
  result:=ParentSeries.Labels[Index];
end;

procedure TTeePolygon.SetText(const Value: String);
begin
  ParentSeries.Labels[Index]:=Value;
end;

procedure TTeePolygon.SetParentBrush(const Value: Boolean);
begin