teepolargrid.pas

BCB第三方组件

{**********************************************}
{   TPolarGridSeries                           }
{   Copyright (c) 2006-2007 by David Berneda   }
{**********************************************}
unit TeePolarGrid;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows,
  {$ENDIF}
  Classes, SysUtils,
  {$IFDEF CLX}
  QGraphics, QStdCtrls, QComCtrls, QControls, QExtCtrls,
  {$ELSE}
  Graphics, StdCtrls, ComCtrls, Controls, ExtCtrls,
  {$ENDIF}
  TeCanvas, TeeProcs, TeEngine, Chart, Series, TeePolar, TeeSurfa,
  TeePolarEditor, TeePenDlg;

type
  // Wrapper class around Custom3DPalette series properties.
  // This is just to publish the "Palette" property of TPolarGridSeries
  TGridColorPalette=class(TPersistent)
  private
    IPalette : TCustom3DPaletteSeries;
    function GetEndColor: TColor;
    function GetLegendEvery: Integer;
    function GetMidColor: TColor;
    function GetPalette: TCustom3DPalette;
    function GetPaletteMin: Double;
    function GetPaletteStep: Double;
    function GetPaletteSteps: Integer;
    function GetPaletteStyle: TTeePaletteStyle;
    function GetStartColor: TColor;
    function GetUseColorRange: Boolean;
    function GetUsePalette: Boolean;
    function GetUsePaletteMin: Boolean;
    procedure SetEndColor(const Value: TColor);
    procedure SetLegendEvery(const Value: Integer);
    procedure SetMidColor(const Value: TColor);
    procedure SetPalette(const Value: TCustom3DPalette);
    procedure SetPaletteMin(const Value: Double);
    procedure SetPaletteStep(const Value: Double);
    procedure SetPaletteSteps(const Value: Integer);
    procedure SetPaletteStyle(const Value: TTeePaletteStyle);
    procedure SetStartColor(const Value: TColor);
    procedure SetUseColorRange(const Value: Boolean);
    procedure SetUsePalette(const Value: Boolean);
    procedure SetUsePaletteMin(const Value: Boolean);
  public
    // Palette should not be published.
    property Palette:TCustom3DPalette read GetPalette write SetPalette;
  published
    property EndColor:TColor read GetEndColor write SetEndColor default clWhite;
    property MidColor:TColor read GetMidColor write SetMidColor default clNone;
    property LegendEvery:Integer read GetLegendEvery write SetLegendEvery default 1;
    property PaletteMin:Double read GetPaletteMin write SetPaletteMin;
    property PaletteStep:Double read GetPaletteStep write SetPaletteStep;
    property PaletteSteps:Integer read GetPaletteSteps write SetPaletteSteps default 32;
    property PaletteStyle:TTeePaletteStyle read GetPaletteStyle write SetPaletteStyle default psPale;
    property StartColor:TColor read GetStartColor write SetStartColor default clNavy;
    property UseColorRange:Boolean read GetUseColorRange write SetUseColorRange default True;
    property UsePalette:Boolean read GetUsePalette write SetUsePalette default False;
    property UsePaletteMin:Boolean read GetUsePaletteMin write SetUsePaletteMin default False;
  end;

  TPolarGridSeries=class(TCustomPolarSeries)
  private
    FCentered   : Boolean;
    FNumSectors : Integer;
    FNumTracks  : Integer;
    FPalette    : TGridColorPalette;
    FValues     : TChartValueList;

    IChart    : TCustomChart;
    I3D       : TCustom3DPaletteSeries;

    function InternalX(ValueIndex:Integer):TChartValue;
    procedure SetCentered(const Value: Boolean);
    procedure SetPalette(const Value: TGridColorPalette);
    procedure SetValues(const Value: TChartValueList);
  protected
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    procedure CellPolygon(ValueIndex:Integer; var P:TFourPoints);
    Procedure DoAfterDrawValues; override;
    Procedure DoBeforeDrawChart; override;
    Procedure DrawPolarCircle(HalfWidth,HalfHeight,Z:Integer); override;
    procedure DrawValue(ValueIndex:Integer); override;
    Function GetCircleLabel(Const Angle:Double; Index:Integer):String; override;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;

    Function AddCell(const Sector,Track:Integer; const Value:TChartValue):Integer;
    Function CalcXPos(ValueIndex:Integer):Integer; override;
    Function CalcYPos(ValueIndex:Integer):Integer; override;
    Function Clicked(x,y:Integer):Integer; override;
    Function CountLegendItems:Integer; override;
    function GetCellColor(const Value:TChartValue):TColor;
    Function IsValidSourceOf(Value:TChartSeries):Boolean; override;
    Function LegendItemColor(LegendIndex:Integer):TColor; override;
    Function LegendString( LegendIndex:Integer;
                           LegendTextStyle:TLegendTextStyle ):String; override;

    // Palette should not be published.
    property Palette:TGridColorPalette read FPalette write SetPalette;
  published
    property CellValues:TChartValueList read FValues write SetValues;
    property Centered:Boolean read FCentered write SetCentered default True;
    property NumSectors:Integer read FNumSectors write FNumSectors default 10;
    property NumTracks:Integer read FNumTracks write FNumTracks default 10;

    { Published declarations }
    property Active;
    property ColorEachPoint;
    property HorizAxis;
    property SeriesColor;
    property VertAxis;

    property AngleIncrement;
    property AngleValues;
    property Brush;
    property CircleBackColor;
    property CircleGradient;
    property CircleLabels;
    property CircleLabelsFont;
    property CircleLabelsInside;
    property CircleLabelsRotated;
    property CirclePen;
    property ClockWiseLabels;
    property LabelsMargin;
    property Pen;
    property RadiusIncrement;
    property RadiusValues;
    property RotationAngle default 90;
    property Transparency;
    property TreatNulls;

    { events }
    property OnGetCircleLabel;
  end;

  TPolarGridEditor = class(TPolarSeriesEditor)
    TabPalette: TTabSheet;
    CBCentered: TCheckBox;
    procedure FormShow(Sender: TObject);
    procedure CBCenteredClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses
  Math, TeeProCo, TeeGriEd;

type
  // Links the internal Palette series with an external Chart, to enable
  // "invalidate".
  TSpecialChart=class(TCustomChart)
  private
    ILink : TChartSeries;
  public
    procedure Invalidate; override;
  end;

  // Internal class with published properties so the TGrid3DSeriesEditor
  // can find them via reflection (RTTI).
  TPaletteSeries=class(TCustom3DPaletteSeries)
  published
    property EndColor;
    property MidColor;
    property LegendEvery;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
  end;

{ TPolarGridSeries }

Constructor TPolarGridSeries.Create(AOwner: TComponent);
begin
  inherited;
  FValues:=TChartValueList.Create(Self,'Values'); { <-- dont translate ! }

  RotationAngle:=90;

  FCentered:=True;
  FNumSectors:=10;
  FNumTracks:=10;

  CalcVisiblePoints:=False;
  XValues.Name:='Sectors';
  XValues.Order:=loNone;
  YValues.Name:='Tracks';

  I3D:=TPaletteSeries.Create(nil);
  IChart:=TSpecialChart.Create(nil);
  TSpecialChart(IChart).ILink:=Self;
  I3D.ParentChart:=IChart;

  FPalette:=TGridColorPalette.Create;
  FPalette.IPalette:=I3D;

  Pen.Color:=clBlack;
  Brush.Style:=bsSolid;

  Pointer.Hide;
end;

function TPolarGridSeries.AddCell(const Sector, Track: Integer;
  const Value: TChartValue): Integer;
begin
  FValues.TempValue:=Value;
  result:=AddXY(Sector,Track);
end;

procedure TPolarGridSeries.Assign(Source: TPersistent);
begin
  if Source is TPolarGridSeries then
  with TPolarGridSeries(Source) do
  begin
    Self.CellValues:=CellValues;
    Self.FCentered:=FCentered;
    Self.FNumSectors:=FNumSectors;
    Self.FNumTracks:=FNumTracks;
    Self.Palette:=Palette;
  end;

  inherited;
end;

function TPolarGridSeries.IsValidSourceOf(Value: TChartSeries): Boolean;
begin
  result:=Value is TPolarGridSeries;
end;

Destructor TPolarGridSeries.Destroy;
begin
  FPalette.Free;
  I3D.Free;
  IChart.Free;
  inherited;
end;

procedure TPolarGridSeries.AddSampleValues(NumValues: Integer;
  OnlyMandatory: Boolean);
var Sector : Integer;
    Track  : Integer;
    tmp    : TChartValue;
begin
  NumSectors:=NumValues;
  NumTracks:=NumValues;

  BeginUpdate;

  for Sector:=0 to NumSectors-1 do
      for Track:=0 to NumTracks-1 do
      begin
        tmp:=0.5*Sqr(Cos(Sector/(NumSectors*0.2)))+
                 Sqr(Cos(Track/(NumTracks*0.2)))-
                 Cos(Track/(NumTracks*0.5));

        AddCell(Sector,Track,tmp);
      end;

  EndUpdate;
end;

Procedure TPolarGridSeries.PrepareForGallery(IsEnabled:Boolean);
Begin
  inherited;
  FillSampleValues(8);
end;

function TPolarGridSeries.InternalX(ValueIndex:Integer):TChartValue;
begin
  if Centered then result:=XValue[ValueIndex]-0.5
              else result:=XValue[ValueIndex];

  result:=result*360.0/NumSectors;

  if ClockWiseLabels then
     result:=360-result;
end;

Function TPolarGridSeries.CalcXPos(ValueIndex:Integer):Integer;
var tmp : Integer;
begin
  CalcXYPosition(InternalX(ValueIndex),YValues[ValueIndex],XRadius,result,tmp);
end;

Function TPolarGridSeries.CalcYPos(ValueIndex:Integer):Integer;
var tmp : Integer;
begin
  CalcXYPosition(InternalX(ValueIndex),YValues[ValueIndex],YRadius,tmp,result);
end;

procedure TPolarGridSeries.CellPolygon(ValueIndex:Integer; var P:TFourPoints);
var xx,yy : Integer;
    tmpInc,
    tmpX : TChartValue;
    tmpY : TChartValue;
    tmpOff : TChartValue;
begin
  P[0].x:=CalcXPos(ValueIndex);
  P[0].y:=CalcYPos(ValueIndex);

  tmpInc:=360.0/NumSectors;
  tmpY:=YValues[ValueIndex];

  if Centered then
     tmpOff:=0.5
  else
     tmpOff:=0;

  tmpX:=(XValues[ValueIndex]-tmpOff+1)*tmpInc;
  if ClockWiseLabels then
     tmpX:=360-tmpX;

  CalcXYPosition(tmpX,tmpY,XRadius,P[1].x,yy);
  CalcXYPosition(tmpX,tmpY,YRadius,xx,P[1].y);

  if tmpY>0 then
  begin
    tmpY:=tmpY-1;
    tmpX:=(XValues[ValueIndex]-tmpOff)*tmpInc;

    if ClockWiseLabels then