⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teesurfacetool.pas

📁 第三方控件:PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该
💻 PAS
字号:
{******************************************}
{   TeeChart Surface Series Nearest Tool   }
{ Copyright (c) 2003-2005 by David Berneda }
{        All Rights Reserved               }
{******************************************}
unit TeeSurfaceTool;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}
     SysUtils, Classes,
     {$IFDEF CLX}
     QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls,
     {$ELSE}
     Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
     {$ENDIF}
     TeeTools, TeCanvas, TeEngine, Chart, TeeSurfa;

type
  TSurfaceNearestTool=class(TTeeCustomToolSeries)
  private
    FCell   : TColor;
    FColumn : TColor;
    FRow    : TColor;
    FOnSelect : TNotifyEvent;
    procedure SetCell(const Value: TColor);
    procedure SetColumn(const Value: TColor);
    procedure SetRow(const Value: TColor);
  protected
    Procedure ChartMouseEvent( AEvent: TChartMouseEvent;
                               Button:TMouseButton;
                               Shift: TShiftState; X, Y: Integer); override;
    class Function GetEditorClass:String; override;
    procedure SetSeries(const Value: TChartSeries); override;
  public
    SelectedCell : Integer;

    Constructor Create(AOwner:TComponent); override;
    class Function Description:String; override;
    Procedure GetRowCol(var Row,Col:Double);
  published
    property Active;
    property CellColor:TColor read FCell write SetCell default clRed;
    property ColumnColor:TColor read FColumn write SetColumn default clGreen;
    property RowColor:TColor read FRow write SetRow default clBlue;
    property Series;

    property OnSelectCell:TNotifyEvent read FOnSelect write FOnSelect;
  end;

  TSurfaceNearest = class(TForm)
    ButtonColor1: TButtonColor;
    ButtonColor2: TButtonColor;
    ButtonColor3: TButtonColor;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    Label1: TLabel;
    CBSeries: TComboBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    procedure CheckBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure ButtonColor1Click(Sender: TObject);
    procedure ButtonColor2Click(Sender: TObject);
    procedure ButtonColor3Click(Sender: TObject);
    procedure CBSeriesChange(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
  private
    { Private declarations }
    Tool : TSurfaceNearestTool;
  public
    { Public declarations }
  end;

implementation

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

uses TeeProCo;

{ TSurfaceNearestTool }
Constructor TSurfaceNearestTool.Create(AOwner: TComponent);
begin
  inherited;
  FColumn:=clGreen;
  FRow:=clBlue;
  FCell:=clRed;
  SelectedCell:=-1;
end;

class function TSurfaceNearestTool.Description: String;
begin
  result:=TeeMsg_SurfaceNearestTool;
end;

class function TSurfaceNearestTool.GetEditorClass: String;
begin
  result:='TSurfaceNearest';
end;

procedure TSurfaceNearestTool.SetSeries(const Value: TChartSeries);
begin
  if Value is TSurfaceSeries then inherited
                             else inherited SetSeries(nil);
end;

Procedure TSurfaceNearestTool.GetRowCol(var Row,Col:Double);
var tmpO : TCellsOrientation;
begin
  if SelectedCell=-1 then
  begin
    Row:=-1;
    Col:=-1;
  end
  else
  with TSurfaceSeries(Series) do
  begin
    tmpO:=CellsOrientation;
    Row:=XValues.Value[SelectedCell];
    if tmpO.IncX=1 then Row:=Row-1;
    Col:=ZValues.Value[SelectedCell];
    if tmpO.IncZ=-1 then Col:=Col+1;
  end;
end;

procedure TSurfaceNearestTool.ChartMouseEvent(AEvent: TChartMouseEvent;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var tmp,t : Integer;
    tmpRow,tmpCol : Double;
begin
  if (AEvent=cmeMove) and Assigned(Series) then
  begin
    tmp:=Series.Clicked(x,y);

    if tmp<>SelectedCell then
    begin
      SelectedCell:=tmp;

      Series.ParentChart.AutoRepaint:=False;

      with TCustom3DSeries(Series) do
        if SelectedCell=-1 then
           for t:=0 to Count-1 do
               ValueColor[t]:=clTeeColor
        else
        begin
          GetRowCol(tmpRow,tmpCol);

          for t:=0 to Count-1 do
            if (XValues.Value[t]=tmpRow) and (ZValues.Value[t]=tmpCol) then
               ValueColor[t]:=CellColor
            else
            if XValues.Value[t]=tmpRow then
               ValueColor[t]:=RowColor
            else
            if ZValues.Value[t]=tmpCol then
               ValueColor[t]:=ColumnColor
            else
               ValueColor[t]:=clTeeColor;
        end;

      Series.ParentChart.AutoRepaint:=True;
      Series.ParentChart.Invalidate;

      if Assigned(FOnSelect) then FOnSelect(Self);
    end;
  end;
end;

procedure TSurfaceNearestTool.SetColumn(const Value: TColor);
begin
  SetColorProperty(FColumn,Value);
end;

procedure TSurfaceNearestTool.SetRow(const Value: TColor);
begin
  SetColorProperty(FRow,Value);
end;

procedure TSurfaceNearestTool.SetCell(const Value: TColor);
begin
  SetColorProperty(FCell,Value);
end;

procedure TSurfaceNearest.CheckBox1Click(Sender: TObject);
begin
  Tool.CellColor:=clTeeColor;
  ButtonColor1.Invalidate;
end;

procedure TSurfaceNearest.FormShow(Sender: TObject);

  Procedure FillSeries(AItems:TStrings);
  var t : Integer;
  begin
    With Tool.ParentChart do
    for t:=0 to SeriesCount-1 do
    if Series[t] is TSurfaceSeries then
        AItems.AddObject(SeriesTitleOrName(Series[t]),Series[t]);
  end;

begin
  Tool:=TSurfaceNearestTool({$IFDEF CLR}TObject{$ENDIF}(Tag));

  if Assigned(Tool) then
  begin
    FillSeries(CBSeries.Items);
    CBSeries.Enabled:=Tool.ParentChart.SeriesCount>0;
    CBSeries.ItemIndex:=CBSeries.Items.IndexOfObject(Tool.Series);

    ButtonColor1.LinkProperty(Tool,'CellColor');
    ButtonColor2.LinkProperty(Tool,'RowColor');
    ButtonColor3.LinkProperty(Tool,'ColumnColor');

    CheckBox1.Checked:=Tool.CellColor=clTeeColor;
    CheckBox2.Checked:=Tool.RowColor=clTeeColor;
    CheckBox3.Checked:=Tool.ColumnColor=clTeeColor;

    CheckBox4.Checked:=Tool.CellColor=clNone;
    CheckBox5.Checked:=Tool.RowColor=clNone;
    CheckBox6.Checked:=Tool.ColumnColor=clNone;
  end;

  Label1.Caption:=TeeMsg_GallerySurface;
end;

procedure TSurfaceNearest.CheckBox2Click(Sender: TObject);
begin
  Tool.RowColor:=clTeeColor;
  ButtonColor2.Invalidate;
end;

procedure TSurfaceNearest.CheckBox3Click(Sender: TObject);
begin
  Tool.ColumnColor:=clTeeColor;
  ButtonColor3.Invalidate;
end;

procedure TSurfaceNearest.ButtonColor1Click(Sender: TObject);
begin
  CheckBox1.Checked:=False;
end;

procedure TSurfaceNearest.ButtonColor2Click(Sender: TObject);
begin
  CheckBox2.Checked:=False;
end;

procedure TSurfaceNearest.ButtonColor3Click(Sender: TObject);
begin
  CheckBox3.Checked:=False;
end;

procedure TSurfaceNearest.CBSeriesChange(Sender: TObject);
begin
  if CBSeries.ItemIndex=-1 then
     Tool.Series:=nil
  else
     Tool.Series:=TChartSeries(CBSeries.Items.Objects[CBSeries.ItemIndex]);
end;

procedure TSurfaceNearest.CheckBox4Click(Sender: TObject);
begin
  Tool.CellColor:=clNone;
end;

procedure TSurfaceNearest.CheckBox5Click(Sender: TObject);
begin
  Tool.RowColor:=clNone;
end;

procedure TSurfaceNearest.CheckBox6Click(Sender: TObject);
begin
  Tool.ColumnColor:=clNone;
end;

initialization
  RegisterClass(TSurfaceNearest);
  RegisterTeeTools([TSurfaceNearestTool]);
finalization
  UnRegisterTeeTools([TSurfaceNearestTool]);
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -