teesurfa.pas

BCB第三方组件

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

interface

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

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

type
  TArrayGrid=Array of TChartValues;

  TCustom3DSeries=class(TChartSeries)
  private
    FTimesZOrder : Integer;
    FZValues     : TChartValueList;
    Function BackFaced:Boolean;
    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;
    Function ValueListOfAxis(Axis:TChartAxis):TChartValueList; 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 AssociatedToAxis(Axis:TChartAxis):Boolean; override;

    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,psInvGray,psRainbow,psCustom);

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

  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 CalcValueRange;
    Procedure CheckPaletteEmpty;
    Function LegendPaletteIndex(LegendIndex:Integer):Integer;
    Function RangePercent(const Percent:Double):TColor;
    procedure ReadPalette(Stream: TStream);
    Procedure SetEndColor(Const Value:TColor);
    Procedure SetGalleryPalette;
    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);
    procedure WritePalette(Stream: TStream);
  protected
    PaletteRange : Double;

    Procedure AddValues(Source:TChartSeries); override;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DefineProperties(Filer:TFiler); override;
    Procedure DoBeforeDrawChart; override;
    Procedure DrawLegendShape(ValueIndex:Integer; Const Rect:TRect); override;
    Procedure GalleryChanged3D(Is3D:Boolean); override;
    procedure GeneratePalette;
    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; overload;
    procedure AddPalette(Const APalette:TColorArray); overload;

    {$IFNDEF CLR}
    procedure AddPalette(Const APalette:Array of TColor); overload;
    {$ENDIF}

    Procedure Assign(Source:TPersistent); override;
    Procedure Clear; override;
    Procedure ClearPalette;
    Function CountLegendItems:Integer; override;
    Procedure CreateDefaultPalette(NumSteps:Integer=0);
    Procedure CreateRangePalette;
    Function GetSurfacePaletteColor(Const Y:TChartValue):TColor;
    procedure InvertPalette; // 8.0
    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 write SetPalette;
    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 }
    INextXCell : Integer;
    INextZCell : Integer;

    Function ExistFourGridIndex(X,Z:Integer):Boolean;
    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
    ValueIndex0    : Integer;
    ValueIndex1    : Integer;
    ValueIndex2    : Integer;
    ValueIndex3    : Integer;

    IInGallery : Boolean;
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    Procedure AddValues(Source:TChartSeries); override;
    Procedure DoBeforeDrawChart; override;

  {$IFDEF CLR}
  public
  {$ENDIF}
    Function CanCreateValues:Boolean;
  public
    GridIndex      : packed Array of Array of Integer;

    // 7.0  When True, the slow "FillGridIndex" method is not called and it is
    // the programmer's responsability to fill the GridIndex array correctly.
    ReuseGridIndex : Boolean;

    Constructor Create(AOwner: TComponent); override;

    Procedure Assign(Source:TPersistent); override;

    Procedure Clear; override;
    Procedure CreateValues(NumX,NumZ:Integer); virtual;

    Procedure FillGridIndex; overload;
    Procedure FillGridIndex(StartIndex:Integer); overload;

    Function GetXZValue(X,Z:Integer):TChartValue; virtual;
    Function IsValidSeriesSource(Value:TChartSeries):Boolean; override;
    Function NumSampleValues:Integer; override;
    Procedure ReCreateValues;

    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;

  TCellsOrientation=packed record
       InitX,
       EndX,
       IncX,
       InitZ,
       EndZ,
       IncZ : Integer;
  end;

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

    { internal }
    FSameBrush      : Boolean;

    {$IFNDEF TEEOPTCALCPOS}
    ICalcX          : TAxisCalcPos;
    ICalcY          : TAxisCalcPos;
    IXValue         : TChartValues;
    IYValue         : TChartValues;
    {$ENDIF}

    Procedure PrepareCalcPos;
    Procedure SetDotFrame(Value:Boolean);
    procedure SetFastBrush(const Value: Boolean);
    procedure SetHideCells(const 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;

    {$IFNDEF CLX}
    IsFastBrush : Boolean;
    DCBRUSH     : HGDIOBJ;
    CanvasDC    : TTeeCanvasHandle;
    {$ENDIF}

    IBlender    : TTeeBlend;

    Function CalcPointPos(const Index:Integer):TPoint;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DrawAllValues; override;
    Procedure DrawCell(x,z:Integer); virtual;
    Procedure DrawSidePortion(var P:TFourPoints; z0,z1:Integer); virtual;
    Function FastCalcPoints( x,z:Integer;
                             Var P0,P1:TPoint3D;
                             Var Color0,Color1:TColor):Boolean;
    Function FourGridIndex(x,z:Integer):Boolean;
    class Function GetEditorClass:String; override;

    Procedure PointsTo2D(Z0,Z1:Integer; var P:TFourPoints);

    {$IFNDEF CLX}
    procedure PrepareFastBrush;
    {$ENDIF}

    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    Procedure SetBrushColor(const AColor:TColor);
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
    function ShouldDrawFast:Boolean; virtual;
    function ShouldDrawSides:Boolean; virtual;
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Function CellsOrientation:TCellsOrientation;
    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 FastBrush:Boolean read FFastBrush write SetFastBrush default False;  // 7.0
    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 HideCells:Boolean read FHideCells write SetHideCells default False;
    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;