teelegendpalette.pas

BCB第三方组件

{********************************************}
{   TeeChart Legend Palette tool             }
{   Copyright (c) 2006-2007 by David Berneda }
{********************************************}
unit TeeLegendPalette;
{$I TeeDefs.inc}

interface

// This tool displays a legend made with colors from a 3D series palette.

uses
  {$IFNDEF LINUX}
  Windows,
  {$ENDIF}
  Classes, SysUtils,
  {$IFDEF CLX}
  QControls, QForms, QExtCtrls, QStdCtrls, QComCtrls, QGraphics,
  {$ELSE}
  Controls, Forms, ExtCtrls, StdCtrls, ComCtrls, Graphics,
  {$ENDIF}
  {$IFDEF D6}
  Types,
  {$ENDIF}
  TeCanvas, TeeProcs, TeEngine, Chart, TeeTools, TeeSurfa, TeePenDlg,
  TeeToolSeriesEdit, TeeEdiPane, TeeEdiAxis;

const
  DefaultPanelColor=clWhite;

type
  TLegendPaletteAxis=(laDefault,laOther,laBoth);

  TLegendPaletteTool=class(TTeeCustomToolSeries)
  private
    FChart    : TCustomChart;
    FHeight   : Integer;
    FLeft     : Integer;
    FPositionUnits: TTeeUnits;
    FSmooth   : Boolean;
    FTop      : Integer;
    FVertical : Boolean;
    FWidth    : Integer;

    function GetAxis: TLegendPaletteAxis;
    function GetBorder: TChartHiddenPen;
    function GetColor: TColor;
    function GetGradient: TChartGradient;
    function GetInverted: Boolean;
    function GetShadow: TTeeShadow;
    function GetTransp: Boolean;
    procedure SetAxis(const Value: TLegendPaletteAxis);
    procedure SetBorder(const Value: TChartHiddenPen);
    procedure SetColor(const Value: TColor);
    procedure SetGradient(const Value: TChartGradient);
    procedure SetHeight(const Value: Integer);
    procedure SetInverted(const Value: Boolean);
    procedure SetLeft(const Value: Integer);
    procedure SetPositionUnits(const Value: TTeeUnits);
    procedure SetShadow(const Value: TTeeShadow);
    procedure SetSmooth(const Value: Boolean);
    procedure SetTop(const Value: Integer);
    procedure SetTransp(const Value: Boolean);
    procedure SetVertical(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
  protected
    procedure ChartEvent(AEvent:TChartToolEvent); override;
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class function GetEditorClass: String; override;
    procedure SetParentChart(const Value: TCustomAxisPanel); override;
    procedure SetSeries(const Value: TChartSeries); override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    procedure Assign(Source:TPersistent); override;

    class Function Description:String; override;
    class Function LongDescription:String; override; // 8.0

    property Chart:TCustomChart read FChart;
  published
    property Active;
    property Axis:TLegendPaletteAxis read GetAxis write SetAxis default laBoth;
    property Border:TChartHiddenPen read GetBorder write SetBorder;
    property Color:TColor read GetColor write SetColor default DefaultPanelColor;
    property Gradient:TChartGradient read GetGradient write SetGradient;
    property Height:Integer read FHeight write SetHeight default 200;
    property Inverted:Boolean read GetInverted write SetInverted default False;
    property Left:Integer read FLeft write SetLeft default 10;
    property Pen;
    property PositionUnits:TTeeUnits read FPositionUnits write SetPositionUnits
                                                         default muPixels;
    property Series;
    property Shadow:TTeeShadow read GetShadow write SetShadow;
    property Smooth:Boolean read FSmooth write SetSmooth default False;
    property Top:Integer read FTop write SetTop default 10;
    property Transparent:Boolean read GetTransp write SetTransp default False;
    property Vertical:Boolean read FVertical write SetVertical default True;
    property Width:Integer read FWidth write SetWidth default 100;
  end;

  TLegendPaletteEditor = class(TSeriesToolEditor)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabPanel: TTabSheet;
    ButtonPen1: TButtonPen;
    RGAxis: TRadioGroup;
    CBTransp: TCheckBox;
    CBSmooth: TCheckBox;
    CBVertical: TCheckBox;
    TabAxes: TTabSheet;
    CBInverted: TCheckBox;
    TabSheet4: TTabSheet;
    Label4: TLabel;
    Label5: TLabel;
    Label13: TLabel;
    ECustLeft: TEdit;
    UDLeft: TUpDown;
    ECustTop: TEdit;
    UDTop: TUpDown;
    CBUnits: TComboFlat;
    TabSheet5: TTabSheet;
    Label14: TLabel;
    Label15: TLabel;
    ECustWidth: TEdit;
    ECustHeight: TEdit;
    UDWidth: TUpDown;
    UDHeight: TUpDown;
    BBorder: TButtonPen;
    procedure FormShow(Sender: TObject);
    procedure RGAxisClick(Sender: TObject);
    procedure CBTranspClick(Sender: TObject);
    procedure CBSmoothClick(Sender: TObject);
    procedure CBVerticalClick(Sender: TObject);
    procedure CBInvertedClick(Sender: TObject);
    procedure ECustLeftChange(Sender: TObject);
    procedure ECustTopChange(Sender: TObject);
    procedure CBUnitsChange(Sender: TObject);
    procedure ECustWidthChange(Sender: TObject);
    procedure ECustHeightChange(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

    IAxes  : TFormTeeAxis;
    IPanel : TFormTeePanel;

    CreatingForm : Boolean;

    function LegendTool:TLegendPaletteTool;
  public
    { Public declarations }
  end;

implementation

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

uses
  // Referencing TeePolarGrid here is not ideal.
  // This usage should be removed, adding an interface ISupportsPalette or similar
  // to TPolarGridSeries.
  // Then discovering this interface at TLegendPaletteTool.ChartEvent.
  TeePolarGrid, TeeProCo, TypInfo;

type
  TPaletteSeries=class(TChartSeries)
  private
    IGradient : TTeeGradient;
    ITool     : TLegendPaletteTool;
  protected
    procedure DrawValue(ValueIndex:Integer); override;
  end;

  TPaletteChart=class(TChart)
  private
    IParent : TCustomAxisPanel;
  public
    procedure Invalidate; override;
  end;

{ TPaletteChart }

procedure TPaletteChart.Invalidate;
begin
  if Assigned(IParent) then
     IParent.Invalidate;
end;

{ TLegendPaletteTool }

Constructor TLegendPaletteTool.Create(AOwner: TComponent);

  procedure PrepareAxis(Axis:TChartAxis);
  begin
    Axis.Axis.Width:=1;
    Axis.Axis.EndStyle:=esSquare;
    Axis.Grid.Hide;
  end;

const
  DefaultMargin=8;

var tmp : TPaletteSeries;
begin
  inherited;

  FChart:=TPaletteChart.Create(nil);
  with FChart do
  begin
    BufferedDisplay:=False;
    Zoom.Allow:=False;
    AllowPanning:=pmNone;
    View3D:=False;
    ClipPoints:=False;
    Color:=DefaultPanelColor;
    BevelOuter:=bvNone;
//    Border.Visible:=True;

    MarginLeft:=DefaultMargin;
    MarginRight:=DefaultMargin;
    MarginTop:=DefaultMargin;
    MarginBottom:=DefaultMargin;

    PrepareAxis(Axes.Left);
    PrepareAxis(Axes.Top);
    PrepareAxis(Axes.Right);
    PrepareAxis(Axes.Bottom);

    with Axes do
    begin
      Bottom.Visible:=False;
      Top.Visible:=False;
    end;

    Legend.Hide;
    //Walls.Visible:=False;

    tmp:=TPaletteSeries.Create(Self);
    tmp.CalcVisiblePoints:=False;
    tmp.ITool:=Self;
    tmp.VertAxis:=aBothVertAxis;
    tmp.HorizAxis:=aBothHorizAxis;
    AddSeries(tmp);
  end;

  FPositionUnits:=muPixels;
  FTop:=10;
  FLeft:=10;
  FWidth:=100;
  FHeight:=200;

  FVertical:=True;
end;

Destructor TLegendPaletteTool.Destroy;
begin
  FreeAndNil(FChart);
  inherited;
end;

procedure TLegendPaletteTool.Assign(Source: TPersistent);
begin
  if Source is TLegendPaletteTool then
  with TLegendPaletteTool(Source) do
  begin
    Self.FLeft:=FLeft;
    Self.FTop:=FTop;
    Self.FWidth:=FWidth;
    Self.FHeight:=FHeight;
    Self.FChart.Assign(FChart);
    Self.FSmooth:=FSmooth;
    Self.Inverted:=Inverted;
    Self.Vertical:=FVertical;
  end;

  inherited;
end;

type
  TCustom3DAccess=class(TCustom3DPaletteSeries);
  TLevelAccess=class(TContourLevel);

procedure TLegendPaletteTool.ChartEvent(AEvent: TChartToolEvent);
var tmp      : TCustom3DPaletteSeries;
    t        : Integer;
    tmpValue : TChartValue;
    tmpColor : TColor;
    tmpR     : TRect;
begin
  inherited;

  if AEvent=cteAfterDraw then
  begin
    FChart[0].BeginUpdate;

    FChart[0].Clear;

    if Assigned(Series) then
    begin
      if Series is TCustom3DPaletteSeries then
      begin
        tmp:=TCustom3DPaletteSeries(Series);

        // Special case. Pending to avoid checking for TContourSeries.
        if Series is TContourSeries then
          for t:=0 to TContourSeries(tmp).Levels.Count-1 do
          begin
            tmpValue:=TContourSeries(tmp).Levels[t].UpToValue;
            tmpColor:=TLevelAccess(TContourSeries(tmp).Levels[t]).InternalColor;

            with FChart[0] do
            if Self.Vertical then
               AddXY(t,tmpValue,'',tmpColor)
            else
               AddXY(tmpValue,t,'',tmpColor);
          end
        else
        for t:=0 to Length(tmp.Palette)-1 do
        begin
          tmpValue:=tmp.Palette[t].UpToValue;
          tmpColor:=TCustom3DAccess(tmp).GetValueColorValue(tmpValue);

          with FChart[0] do
          if Self.Vertical then
             AddXY(t,tmpValue,'',tmpColor)
          else
             AddXY(tmpValue,t,'',tmpColor);
        end;
      end
      else
      if Series is TPolarGridSeries then
         for t:=0 to Length(TPolarGridSeries(Series).Palette.Palette)-1 do
         begin
           tmpValue:=TPolarGridSeries(Series).Palette.Palette[t].UpToValue;
           tmpColor:=TPolarGridSeries(Series).GetCellColor(tmpValue);

           with FChart[0] do
           if Self.Vertical then
              AddXY(t,tmpValue,'',tmpColor)
           else
              AddXY(tmpValue,t,'',tmpColor);
         end;
    end;

    ParentChart.Canvas.UnClipRectangle;
    FChart[0].Pen.Assign(Pen);

    if FPositionUnits=muPercent then
    begin
      tmpR.Left:=Round(FLeft*ParentChart.Width*0.01);
      tmpR.Top:=Round(FTop*ParentChart.Width*0.01);
    end
    else
    begin
      tmpR.Left:=FLeft;
      tmpR.Top:=FTop;
    end;

    tmpR.Right:=tmpR.Left+FWidth;
    tmpR.Bottom:=tmpR.Top+FHeight;

    FChart[0].EndUpdate;

    FChart.Draw(ParentChart.Canvas.ReferenceCanvas,tmpR);
  end;
end;

class function TLegendPaletteTool.Description: String;
begin
  result:=TeeMsg_LegendPalette;
end;

class function TLegendPaletteTool.LongDescription: String;
begin
  result:=TeeMsg_LegendPaletteDesc;
end;

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

type
  TChartAccess=class(TCustomChart);
  TCanvasAccess=class(TTeeCanvas3D);

procedure TLegendPaletteTool.ChartMouseEvent(AEvent: TChartMouseEvent;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var tmpR : TRect;
begin
  inherited;

  case AEvent of
    cmeMove: TChartAccess(FChart).MouseMove(Shift,X,Y);
    cmeDown: TChartAccess(FChart).MouseDown(Button,Shift,X,Y);
    cmeUp  : TChartAccess(FChart).MouseUp(Button,Shift,X,Y);
  end;

  tmpR:=TeeRect(Left,Top,Left+Width,Top+Height);

  if PtInRect(tmpR,TeePoint(X,Y)) then