teesurfa.pas

BCB第三方组件

    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 EndColor;
    property MidColor;
    property LegendEvery;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property TimesZOrder;
    property XValues;
    property YValues;
    property ZValues;
    { events }
    property OnGetColor;

    property ArrowHeight:Integer read FArrowHeight write SetArrowHeight default 4;
    property ArrowWidth:Integer read FArrowWidth write SetArrowWidth default 4;
    property EndArrow:TChartPen read FEndArrow write SetEndArrow;
    property EndXValues:TChartValueList read FEndXValues write SetEndXValues;
    property EndYValues:TChartValueList read FEndYValues write SetEndYValues;
    property EndZValues:TChartValueList read FEndZValues write SetEndZValues;
    property StartArrow:TChartHiddenPen read FStartArrow write SetStartArrow;
  end;

  TTowerStyle=(tsCube,tsRectangle,tsCover,tsCylinder,tsArrow,tsCone,tsPyramid,
               tsSlantCube);

  TTowerSeries=class(TCustom3DGridSeries)
  private
    FDark3D       : Boolean;
    FOrigin       : Double;
    FPercDepth    : Integer;
    FPercWidth    : Integer;
    FTowerStyle   : TTowerStyle;
    FTransparency : TTeeTransparency;
    FUseOrigin    : Boolean;

    IOffW  : Double;
    IOffD  : Double;
    Function CalcCell(var AIndex,ATop,ABottom,Z0,Z1:Integer):TRect;
    procedure SetDark3D(const Value: Boolean);
    Procedure SetOrigin(Const Value:Double);
    procedure SetPercDepth(const Value: Integer);
    procedure SetPercWidth(const Value: Integer);
    procedure SetTransparency(const Value: TTeeTransparency);
    Procedure SetUseOrigin(Value:Boolean);
    procedure SetTowerStyle(const Value: TTowerStyle);
  protected
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    Procedure DrawMark( ValueIndex:Integer; Const St:String;
                        APosition:TSeriesMarkPosition); override;
    procedure DrawAllValues; override;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
  public
    Constructor Create(AOwner:TComponent); override;

    Procedure Assign(Source:TPersistent); override;

    Function Clicked(X,Y:Integer):Integer; override; { 5.01 }
    Function MinXValue:Double; override;
    Function MaxXValue:Double; override;
    Function MinZValue:Double; override;
    Function MaxZValue:Double; override;
  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;

    property Dark3D:Boolean read FDark3D write SetDark3D default True;
    property PercentDepth:Integer read FPercDepth write SetPercDepth default 100;
    property Origin:Double read FOrigin write SetOrigin;
    property TowerStyle:TTowerStyle read FTowerStyle write SetTowerStyle default tsCube;
    property Transparency:TTeeTransparency read FTransparency write SetTransparency default 0;
    property PercentWidth:Integer read FPercWidth write SetPercWidth default 100;
    property UseOrigin:Boolean read FUseOrigin write SetUseOrigin default False;

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

    property Brush;
    property EndColor;
    property IrregularGrid;
    property MidColor;
    property NumXValues;
    property NumZValues;
    property LegendEvery;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property TimesZOrder;
    property XValues;
    property YValues;
    property ZValues;

    { events }
    property OnGetYValue;
    property OnGetColor;
  end;

  TSurfaceSides=class(TPersistent)
  private
    FLevels : Boolean;
    FPen    : TChartHiddenPen;

    ISeries : TSurfaceSeries;
    Procedure CanvasChanged(Sender:TObject);
    function GetBrush:TChartBrush;
    Procedure SetBrush(const Value:TChartBrush);
    Procedure SetLevels(const Value:Boolean);
    Procedure SetPen(const Value:TChartHiddenPen);
  public
    Constructor Create(Series:TSurfaceSeries);
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
  published
    property Brush:TChartBrush read GetBrush write SetBrush;
    property Levels:Boolean read FLevels write SetLevels default True;
    property Pen:TChartHiddenPen read FPen write SetPen;
  end;

  TIsoSurfaceSeries=class(TSurfaceSeries)
  private
    FBandPen : TChartPen;
    FSides   : TSurfaceSides;
    FUseY    : Boolean;
    FYPosition : TChartValue;

    xv : TChartValues;
    zv : TChartValues;
    v  : TChartValues;
    HasImage : Boolean;
    ITransp  : Boolean;
    PaletteLength : Integer;
    IPoints2D     : TPointArray;
    ICalcYPos     : Integer;

    procedure SetBandPen(const Value: TChartPen);
    procedure SetSides(const Value: TSurfaceSides);
    procedure SetUseY(const Value: Boolean);
    procedure SetYPosition(const Value: TChartValue);
  protected
    Procedure DrawAllValues; override;
    Procedure DrawCell(x,z:Integer); override;
    Procedure DrawSidePortion(var P:TFourPoints; Z0,Z1:Integer); override;
    class function GetEditorClass: String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    function ShouldDrawFast:Boolean; override;
    function ShouldDrawSides:Boolean; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
  published
    property BandPen:TChartPen read FBandPen write SetBandPen;
    property Sides:TSurfaceSides read FSides write SetSides;
    property UseColorRange default False;
    property UsePalette default True;
    property UseYPosition:Boolean read FUseY write SetUseY default False;
    property YPosition:TChartValue read FYPosition write SetYPosition;
  end;

implementation

uses
  Math, Chart, TeeSpline, TeeProCo, TeeConst;

{$IFNDEF D6}
// From Math.pas
const
  FuzzFactor = 1000;
  DoubleResolution   = 1E-15 * FuzzFactor;

function SameValue(const A, B: Double; Epsilon: Double=0): Boolean;
begin
  if Epsilon = 0 then
    Epsilon := Max(Min(Abs(A), Abs(B)) * DoubleResolution, DoubleResolution);
  if A > B then
    Result := (A - B) <= Epsilon
  else
    Result := (B - A) <= Epsilon;
end;
{$ENDIF}

{ TCustom3DSeries }
Constructor TCustom3DSeries.Create(AOwner: TComponent);
Begin
  inherited;
  HasZValues:=True;
  CalcVisiblePoints:=False;
  FZValues:=TChartValueList.Create(Self,'Z'); { <-- dont translate ! }
  XValues.Order:=loNone;
  FTimesZOrder:=3;
end;

Procedure TCustom3DSeries.SetZValues(Const Value:TChartValueList);
Begin
  SetChartValueList(FZValues,Value); { standard method }
End;

Procedure TCustom3DSeries.CalcZOrder;
Begin
  inherited;
  ParentChart.MaxZOrder:=FTimesZOrder;
end;

Procedure TCustom3DSeries.DrawMark( ValueIndex:Integer; Const St:String;
                                    APosition:TSeriesMarkPosition);
begin
  if ValueIndex<>-1 then
     Marks.ZPosition:=CalcZPos(ValueIndex);
     
  inherited;
end;

Procedure TCustom3DSeries.AddArray(Const Values:TArrayGrid);
var x : Integer;
    z : Integer;
begin
  BeginUpdate;
  try
    for x:=Low(Values) to High(Values) do
        for z:=Low(Values[x]) to High(Values[x]) do
            AddXYZ(x,Values[x,z],z);
  finally
    EndUpdate;
  end;
end;

Function TCustom3DSeries.AddXYZ(Const AX,AY,AZ:TChartValue):Integer;
begin
  ZValues.TempValue:=AZ;
  result:=AddXY(AX,AY);
end;

Function TCustom3DSeries.AddXYZ(Const AX,AY,AZ:TChartValue;
                                Const AXLabel:String; AColor:TColor):Integer;
Begin
  ZValues.TempValue:=AZ;
  result:=AddXY(AX,AY,AXLabel,AColor);
end;

Function TCustom3DSeries.IsValidSourceOf(Value:TChartSeries):Boolean;
begin
  result:=Value is TCustom3DSeries;
end;

Procedure TCustom3DSeries.SetTimesZOrder(Const Value:Integer);
Begin
  SetIntegerProperty(FTimesZOrder,Value);
End;

Function TCustom3DSeries.MaxZValue:Double;
begin
  result:=FZValues.MaxValue;
end;

Function TCustom3DSeries.MinZValue:Double;
begin
  result:=FZValues.MinValue;
end;

Procedure TCustom3DSeries.Assign(Source:TPersistent);
begin
  if Source is TCustom3DSeries then
  With TCustom3DSeries(Source) do
  begin
    Self.FZValues.Assign(FZValues);
    Self.FTimesZOrder  :=FTimesZOrder;
  end;

  inherited;
end;

Procedure TCustom3DSeries.SetZValue(Index:Integer; Const Value:TChartValue);
Begin
  ZValues.Value[Index]:=Value;
End;

Function TCustom3DSeries.GetZValue(Index:Integer):TChartValue;
Begin
  result:=ZValues.Value[Index];
End;

function TCustom3DSeries.CalcZPos(ValueIndex: Integer): Integer;
begin
  result:=ParentChart.DepthAxis.CalcYPosValue(ZValues.Value[ValueIndex]);
end;

procedure TCustom3DSeries.PrepareLegendCanvas(ValueIndex: Integer;
  var BackColor: TColor; var BrushStyle: TBrushStyle);
begin
  inherited;
  
  if TCustomChart(ParentChart).Legend.Symbol.Continuous then
     ParentChart.Canvas.Pen.Style:=psClear;
end;

function TCustom3DSeries.BackFaced: Boolean;
begin
  result:=ParentChart.DepthAxis.Inverted;

  with ParentChart.View3DOptions do
    if (Rotation>90) and (Rotation<270) then
       result:=not result;
end;

function TCustom3DSeries.AssociatedToAxis(Axis: TChartAxis): Boolean;
begin
  result:=Axis.IsDepthAxis or inherited AssociatedToAxis(Axis);
end;

Function TCustom3DSeries.ValueListOfAxis(Axis:TChartAxis):TChartValueList;
begin
  if Axis.IsDepthAxis then result:=ZValues
                      else result:=inherited ValueListOfAxis(Axis);
end;

{ TCustom3DPaletteSeries }
Constructor TCustom3DPaletteSeries.Create(AOwner: TComponent);
Begin
  inherited;
  FUseColorRange:=True;
  FPaletteSteps:=32;
  FLegendEvery:=1;
  FStartColor:=clNavy;
  FEndColor:=clWhite;
  FMidColor:=clNone;

  { Palette Modifiers }
  RedFactor:=2.0;
  GreenFactor:=1;
  BlueFactor:=1;
  CalcColorRange;
End;

Destructor TCustom3DPaletteSeries.Destroy;
begin
  ClearPalette;
  inherited;
end;

Procedure TCustom3DPaletteSeries.CalcColorRange;
Begin
  IEndRed    :=GetRValue(EndColor);
  IEndGreen  :=GetGValue(EndColor);
  IEndBlue   :=GetBValue(EndColor);

  if MidColor<>clNone then
  begin
    IMidRed    :=GetRValue(MidColor);
    IMidGreen  :=GetGValue(MidColor);
    IMidBlue   :=GetBValue(MidColor);
    IRangeMidRed  :=Integer(GetRValue(StartColor))-IMidRed;
    IRangeMidGreen:=Integer(GetGValue(StartColor))-IMidGreen;
    IRangeMidBlue :=Integer(GetBValue(StartColor))-IMidBlue;
    IRangeRed  :=IMidRed-IEndRed;
    IRangeGreen:=IMidGreen-IEndGreen;
    IRangeBlue :=IMidBlue-IEndBlue;
  end
  else
  begin
    IRangeRed  :=Integer(GetRValue(StartColor))-IEndRed;
    IRangeGreen:=Integer(GetGValue(StartColor))-IEndGreen;
    IRangeBlue :=Integer(GetBValue(StartColor))-IEndBlue;
  end;