teesurfa.pas

Delphi TeeChartPro.6.01的源代码

{**********************************************}
{  TeeChart Pro                                }
{                                              }
{   TCustom3DSeries                            }
{    TCustom3DPaletteSeries                    }
{     TVector3DSeries                          }
{     TCustom3DGridSeries                      }
{      TSurfaceSeries                          }
{      TContourSeries                          }
{      TWaterFallSeries                        }
{      TColorGridSeries                        }
{      TTowerSeries                            }
{                                              }
{  Functions:                                  }
{                                              }
{   TSmoothPoints                              }
{                                              }
{  Copyright (c) 1995-2003 by David Berneda    }
{**********************************************}
unit TeeSurfa;
{$I TeeDefs.inc}

interface

{$DEFINE LEVELSEGMENTS} { <--- For TContourSeries only. }

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

// Const MaxAllowedCells=2000; { max 2000 x 2000 cells }

type
  TChartSurfaceGetColor=Procedure( Sender:TChartSeries;
                                   ValueIndex:Integer;
                                   Var Color:TColor) of object;

  TArrayGrid=Array of Array of TChartValue;

  TCustom3DSeries=class(TChartSeries)
  private
    FTimesZOrder : Integer;
    FZValues     : TChartValueList;
    Function GetZValue(Index:Integer):TChartValue; { 5.02 }
    Procedure SetTimesZOrder(Const Value:Integer);
    Procedure SetZValue(Index:Integer; Const Value:TChartValue); { 5.02 }
    Procedure SetZValues(Const Value:TChartValueList);
  protected
    Procedure CalcZOrder; override;
    Procedure DrawMark( ValueIndex:Integer; Const St:String;
                        APosition:TSeriesMarkPosition); override;
    Procedure PrepareLegendCanvas( ValueIndex:Integer; Var BackColor:TColor;
                                   Var BrushStyle:TBrushStyle); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Procedure Assign(Source:TPersistent); override;

    Procedure AddArray(Const Values:TArrayGrid); overload;
    Function AddXYZ(Const AX,AY,AZ:TChartValue):Integer; overload;
    Function AddXYZ(Const AX,AY,AZ:TChartValue;
                    Const AXLabel:String; AColor:TColor):Integer; overload; virtual;

    Function CalcZPos(ValueIndex:Integer):Integer;
    Function IsValidSourceOf(Value:TChartSeries):Boolean; override;
    Function MaxZValue:Double; override;
    Function MinZValue:Double; override;
    property ZValue[Index:Integer]:TChartValue read GetZValue write SetZValue;

    { to be published }
    property TimesZOrder:Integer read FTimesZOrder write SetTimesZOrder default 3;
    property ZValues:TChartValueList read FZValues write SetZValues;
  end;

  TGridPalette=packed record
    UpToValue : TChartValue;
    Color     : TColor;
  end;

  TCustom3DPalette=Array of TGridPalette;

  TTeePaletteStyle=(psPale,psStrong,psGrayScale);

  TCustom3DPaletteSeries=class(TCustom3DSeries)
  private
    FEndColor     : TColor;
    FMidColor     : TColor;

    FPalette      : TCustom3DPalette;
    FLegendEvery  : Integer;
    FPaletteMin   : Double;    // overrides automatic palette generation
    FPaletteStep  : Double;    // overrides automatic palette generation
    FPaletteSteps : Integer;
    FPaletteStyle : TTeePaletteStyle;

    FStartColor   : TColor;
    FUseColorRange: Boolean;
    FUsePalette   : Boolean;
    FUsePaletteMin: Boolean;   // overrides automatic palette generation

    FOnGetColor   : TChartSurfaceGetColor;

    { internal }
    IRangeRed    : Integer;
    IEndRed      : Integer;
    IMidRed      : Integer;
    IRangeMidRed : Integer;
    IRangeGreen  : Integer;
    IEndGreen    : Integer;
    IMidGreen    : Integer;
    IRangeMidGreen: Integer;
    IRangeBlue   : Integer;
    IEndBlue     : Integer;
    IMidBlue     : Integer;
    IRangeMidBlue: Integer;
    IValueRangeInv: Double;

    Procedure CalcColorRange;
    Procedure CheckPaletteEmpty;
    Function LegendPaletteIndex(LegendIndex:Integer):Integer;
    Function RangePercent(Const Percent:Double):TColor;
    Procedure SetEndColor(Const Value:TColor);
    Procedure SetMidColor(Const Value:TColor);
    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 SetPaletteMin(const Value: Double);
    procedure SetPaletteStep(const Value: Double);
    procedure SetUsePaletteMin(const Value: Boolean);
    procedure SetLegendEvery(const Value: Integer);
  protected
    PaletteRange : Double;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DoBeforeDrawChart; override;
    Procedure DrawLegendShape(ValueIndex:Integer; Const Rect:TRect); override;
    Procedure GalleryChanged3D(Is3D:Boolean); override;
    class Function GetEditorClass:String; override;
    Function GetValueColor(ValueIndex:Integer):TColor; override;
    Function GetValueColorValue(Const AValue:TChartValue):TColor;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
  public
    RedFactor    : Double;
    GreenFactor  : Double;
    BlueFactor   : Double;

    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Function AddPalette(Const AValue:TChartValue; AColor:TColor):Integer;
    Procedure Assign(Source:TPersistent); override;
    Procedure Clear; override;
    Procedure ClearPalette;
    Function CountLegendItems:Integer; override;
    Procedure CreateDefaultPalette(NumSteps:Integer);
    Procedure CreateRangePalette;
    Function GetSurfacePaletteColor(Const Y:TChartValue):TColor;
    Function LegendItemColor(LegendIndex:Integer):TColor; override;
    Function LegendString( LegendIndex:Integer;
                           LegendTextStyle:TLegendTextStyle ):String; override;

    property EndColor:TColor read FEndColor write SetEndColor default clWhite;
    property MidColor:TColor read FMidColor write SetMidColor default clNone;
    property LegendEvery:Integer read FLegendEvery write SetLegendEvery default 1;
    property Palette:TCustom3DPalette read FPalette;
    property PaletteMin:Double read FPaletteMin write SetPaletteMin; // 5.03
    property PaletteStep:Double read FPaletteStep write SetPaletteStep; // 5.03
    property PaletteSteps:Integer read FPaletteSteps write SetPaletteSteps default 32;
    property PaletteStyle:TTeePaletteStyle read FPaletteStyle write SetPaletteStyle default psPale;
    property StartColor:TColor read FStartColor write SetStartColor default clNavy;
    property UseColorRange:Boolean read FUseColorRange write SetUseColorRange default True;
    property UsePalette:Boolean read FUsePalette write SetUsePalette default False;
    property UsePaletteMin:Boolean read FUsePaletteMin write SetUsePaletteMin default False; // 5.03
    { events }
    property OnGetColor:TChartSurfaceGetColor read FOnGetColor write FOnGetColor;
  end;

  { Grid 3D series }
  TChartSurfaceGetY=Function(Sender:TChartSeries; X,Z:Integer):Double of object;

  TCustom3DGridSeries=class(TCustom3DPaletteSeries)
  private
    FIrregularGrid : Boolean;
    FNumXValues    : Integer;
    FNumZValues    : Integer;
    FOnGetYValue   : TChartSurfaceGetY;

    { internal }
    ValueIndex0    : Integer;
    ValueIndex1    : Integer;
    ValueIndex2    : Integer;
    ValueIndex3    : Integer;

    INextXCell : Integer;
    INextZCell : Integer;

    //Procedure ClearGridIndex;
    Function ExistFourGridIndex(X,Z:Integer):Boolean;
    //Function GetGridIndex(X,Z:Integer):Integer;
    //Procedure InternalSetGridIndex(X,Z,Value:Integer);
    //Procedure SetGridIndex(X,Z,Value:Integer);
    Procedure InitGridIndex(XCount,ZCount:Integer);
    Procedure SetIrregularGrid(Const Value:Boolean);
    Procedure SetNumXValues(Value:Integer);
    Procedure SetNumZValues(Value:Integer);
    function GetValue(X, Z: Integer): TChartValue;
    procedure SetValue(X, Z: Integer; const Value: TChartValue);
  protected
    IInGallery : Boolean;
    Procedure AddSampleValues(NumValues:Integer); override;
    Procedure AddValues(Source:TChartSeries); override;
    Function CanCreateValues:Boolean;
    Procedure DoBeforeDrawChart; override;
  public
    GridIndex: packed Array of Array of Integer; //TTeeCellsRow;

    Constructor Create(AOwner: TComponent); override;

    Procedure Assign(Source:TPersistent); override;
    Procedure Clear; override;
    Procedure CreateValues(NumX,NumZ:Integer); virtual;
    Procedure FillGridIndex;
    Function GetXZValue(X,Z:Integer):TChartValue; virtual;
    Function IsValidSeriesSource(Value:TChartSeries):Boolean; override;
    Function NumSampleValues:Integer; override;
    Procedure ReCreateValues;

    //property GridIndex[X,Z:Integer]:Integer read GetGridIndex write SetGridIndex;
    property IrregularGrid:Boolean read FIrregularGrid write SetIrregularGrid default False;

    property NumXValues:Integer read FNumXValues write SetNumXValues default 10;
    property NumZValues:Integer read FNumZValues write SetNumZValues default 10;
    property Value[X,Z:Integer]:TChartValue read GetValue write SetValue;

    { events }
    property OnGetYValue:TChartSurfaceGetY read FOnGetYValue write FOnGetYValue;
  end;

  TSurfaceSeries=class(TCustom3DGridSeries)
  private
    { Private declarations }
    FDotFrame       : Boolean;
    FSideBrush      : TChartBrush;
    FSideLines      : TChartHiddenPen;
    FSmoothPalette  : Boolean;
    FTransparency   : TTeeTransparency; // 5.03
    FWaterFall      : Boolean;
    FWaterLines     : TChartPen;
    FWireFrame      : Boolean;

    { internal }
    FSameBrush      : Boolean;
    IBlender        : TTeeBlend;
    Function FourGridIndex(x,z:Integer):Boolean;
    Procedure SetDotFrame(Value:Boolean);
    Procedure SetSideBrush(Value:TChartBrush);
    Procedure SetSideLines(Value:TChartHiddenPen);
    Procedure SetSmoothPalette(Value:Boolean);
    procedure SetTransparency(const Value: TTeeTransparency);
    Procedure SetWaterFall(Value:Boolean);
    Procedure SetWireFrame(Value:Boolean);
    procedure SetWaterLines(const Value: TChartPen);
  protected
    { Protected declarations }
    Points : TFourPoints;
    Function CalcPointPos(Index:Integer):TPoint;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DrawAllValues; override;
    Procedure DrawCell(x,z:Integer); virtual;
    Function FastCalcPoints( x,z:Integer;
                             Var P0,P1:TPoint3D;
                             Var Color0,Color1:TColor):Boolean;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Function Clicked(x,y:Integer):Integer; override;
    property WaterFall:Boolean read FWaterFall write SetWaterFall default False;
    property WaterLines:TChartPen read FWaterLines write SetWaterLines;
  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;

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

    property Brush;
    property DotFrame:Boolean read FDotFrame write SetDotFrame default False;
    property EndColor;
    property IrregularGrid;
    property MidColor;
    property NumXValues;
    property NumZValues;
    property LegendEvery;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property SideBrush:TChartBrush read FSideBrush write SetSideBrush;
    property SideLines:TChartHiddenPen read FSideLines write SetSideLines;
    property SmoothPalette:Boolean read FSmoothPalette write SetSmoothPalette default False;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property WireFrame:Boolean read FWireFrame write SetWireFrame default False;
    property TimesZOrder;
    property Transparency:TTeeTransparency read FTransparency write SetTransparency default 0;
    property XValues;
    property YValues;
    property ZValues;
    { events }
    property OnGetYValue;
    property OnGetColor;
  end;

  TContourSeries=class;

  TOnBeforeDrawLevelEvent=procedure( Sender:TContourSeries;
                                     LevelIndex:Integer) of object;

  TOnGetLevelEvent=procedure( Sender:TContourSeries; LevelIndex:Integer;
                            Var Value:Double; Var Color:TColor) of object;

  {$IFDEF LEVELSEGMENTS}
  TLevelPoint=packed record
     X,Y: TChartValue;
  end;

  TLevelSegment=packed record
    Points : Array of TLevelPoint;
  end;

  TLevelSegments=Array of TLevelSegment;
  {$ENDIF}

  TContourLevel=class(TCollectionItem)
  private
    FColor  : TColor;
    FPen    : TChartPen;
    FUpTo   : Double;

    ISeries : TContourSeries;

    {$IFDEF LEVELSEGMENTS}
    FSegments : TLevelSegments;
    {$ENDIF}

    Procedure CheckAuto;
    procedure SetColor(const Value: TColor);
    procedure SetUpTo(const Value: Double);
    function GetPen: TChartPen;
    function IsPenStored: Boolean;
    procedure SetPen(const Value: TChartPen);
  protected
    {$IFDEF LEVELSEGMENTS}
    Function GetSegmentPoints(SegmentIndex:Integer):TPointArray;
    {$ENDIF}
    function InternalPen:TChartPen;
  public
    Constructor Create(Collection:TCollection); override;
    Destructor Destroy; override;
    Procedure Assign(Source:TPersistent); override; { 5.01 }
    {$IFDEF LEVELSEGMENTS}
    Procedure ClearSegments;
    Function Clicked(x,y:Integer; Var SegmentIndex,PointIndex:Integer):Boolean;
    Function ClickedSegment(x,y,SegmentIndex:Integer; Var PointIndex:Integer):Boolean;
    {$ENDIF}

    Function DefaultPen:Boolean;

    {$IFDEF LEVELSEGMENTS}
    Function SegmentCount:Integer;
    property Segments:TLevelSegments read FSegments;
    {$ENDIF}
  published
    property Color:TColor read FColor write SetColor;
    property Pen:TChartPen read GetPen write SetPen stored IsPenStored; // 5.03
    property UpToValue:Double read FUpTo write SetUpTo;
  end;

  TContourLevels=class(TOwnedCollection)
  private
    Function Get(Index:Integer):TContourLevel;
    Procedure Put(Index:Integer; Const Value:TContourLevel);
  public
    {$IFDEF LEVELSEGMENTS}
    Function Clicked(x,y:Integer; Var SegmentIndex,PointIndex:Integer):Integer;
    {$ENDIF}
    property Items[Index:Integer]:TContourLevel read Get write Put; default;
  end;

  TSmoothPoints=class(TPersistent)
  private
    FActive : Boolean;
    ISeries : TChartSeries;
    FInterpolate: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetInterpolate(const Value: Boolean);
  public
    Factor : Integer;
    Constructor Create(Parent:TChartSeries);