teetrisurface.pas

TeeChart7Source 控件

{******************************************}
{     TeeChart Pro Charting Library        }
{           TriSurface Series              }
{ Copyright (c) 1995-2004 by David Berneda }
{         All Rights Reserved              }
{******************************************}
unit TeeTriSurface;
{$I TeeDefs.inc}

// Adapted from Andre Bester's algorithm ([e-mail])

{ This unit implements the "Tri-Surface" charting series.

  A Tri-Surface is a 3D surface of triangles, automatically
  calculated from all XYZ points.

  All XYZ coordinates can have floating point decimals and
  can be expressed in any range.

  This series inherits all formatting properties like Pen,
  Brush, ColorRange and Palette from its ancestor class.

  Special properties:

    HideTriangles : Boolean ( default True )

      Triangles are ordered by Z position (hidding algorithm).
      When False, display speed might be faster but incorrect.

    CacheTriangles : Boolean ( default False )

      When True, triangles from XYZ data are just recalculated once
      instead of at every redraw.
      Set CacheTriangles to False after clearing or modifying XYZ data
      to force recalculating triangles.
}

interface

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

Type
  {$IFNDEF CLR}
  PTriangle=^TTriangle;
  {$ELSE}
  TTriangle=class;
  PTriangle=TTriangle;
  {$ENDIF}
  TTriangle={$IFDEF CLR}class{$ELSE}packed record{$ENDIF}
    Index : Integer;
    Color : TColor;
    Next  : PTriangle;
    Prev  : PTriangle;
    P     : TTrianglePoints;
    Z     : Double;
  end;

  ETriSurfaceException=class(ChartException);

  TCustomTriSurfaceSeries=class(TCustom3DPaletteSeries)
  private
    { Private declarations }
    FBorder    : TChartHiddenPen;
    FFastBrush : Boolean;
    FHide      : Boolean;
    FTransp    : TTeeTransparency;

    FNumLines  : Integer;
    ICreated   : Boolean;
    IPT        : Array of Integer;
    IPL        : Array of Integer;
    Triangles  : PTriangle;
    ILastTriangle : PTriangle;

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

    Function CalcPointResult(Index:Integer):TPoint3D;
    Procedure ClearTriangles; // 7.0
    function IDxchg(I1,I2,I3,I4:Integer):Integer;
    Procedure SetBorder(Value:TChartHiddenPen);
    procedure SetFastBrush(const Value: Boolean);
    procedure SetHide(const Value: Boolean);
    Procedure SetTransp(Value:TTeeTransparency);
    Procedure TrianglePointsTo2D(const P:TTrianglePoints3D; Var Result:TeCanvas.TTrianglePoints);
  protected
    ImprovedTriangles : Boolean;

    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    procedure DoBeforeDrawValues; override;
    procedure DrawAllValues; override;
    Procedure DrawMark(ValueIndex:Integer; Const St:String;
                       APosition:TSeriesMarkPosition); override;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;

  public
    { Public declarations }
    CacheTriangles    : Boolean;
    NumTriangles      : Integer;

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

    Procedure Assign(Source:TPersistent); override;
    Procedure Clear; override;
    Function Clicked(x,y:Integer):Integer; override;  // 7.0
    Function NumSampleValues:Integer; override;
    Function TrianglePoints(TriangleIndex:Integer):TTrianglePoints3D;  // 7.0

    property Border:TChartHiddenPen read FBorder write SetBorder;
    property Brush;
    property FastBrush:Boolean read FFastBrush write SetFastBrush default False;  // 7.0
    property HideTriangles:Boolean read FHide write SetHide default True;
    property Pen;
    property Transparency:TTeeTransparency read FTransp write SetTransp default 0;
  end;

  TTriSurfaceSeries=class(TCustomTriSurfaceSeries)
  published
    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 Border;
    property Brush;
    property EndColor;
    property FastBrush;
    property HideTriangles;
    property LegendEvery;
    property MidColor;
    property Pen;
    property PaletteMin;
    property PaletteStep;
    property PaletteSteps;
    property PaletteStyle;
    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property TimesZOrder;
    property Transparency;
    property XValues;
    property YValues;
    property ZValues;

    { events }
    property OnGetColor;
  end;

implementation

Uses Math, TeeConst, TeeProCo;

{ TTriSurfaceSeries }
Constructor TCustomTriSurfaceSeries.Create(AOwner:TComponent);
begin
  inherited;
  FBorder:=TChartHiddenPen.Create(CanvasChanged);
  FBorder.Color:=clWhite;
  FHide:=True; { 5.02 }
  ImprovedTriangles:=True;
end;

Destructor TCustomTriSurfaceSeries.Destroy;
begin
  FBorder.Free;
  IPL:=nil;
  IPT:=nil;
  ClearTriangles;
  inherited;
end;

Procedure TCustomTriSurfaceSeries.ClearTriangles;
var Triangle : PTriangle;
    {$IFNDEF CLR}
    tmpTriangle : PTriangle;
    {$ENDIF}
begin
  Triangle:=Triangles;
  while Assigned(Triangle) do
  begin
    { free triangle memory }
    {$IFNDEF CLR}
    tmpTriangle:=Triangle;
    {$ENDIF}
    Triangle:=Triangle.Next;
    {$IFNDEF CLR}
    Dispose(tmpTriangle);
    {$ENDIF}
  end;
  Triangles:=nil;
end;

Function TCustomTriSurfaceSeries.Clicked(x,y:Integer):Integer; // 7.0
var t : Integer;
    tmp : TPoint;
    Triangle : PTriangle;
    P : TTrianglePoints;
begin
  result:=TeeNoPointClicked;
  tmp:=TeePoint(x,y);

  // If "hide triangles" mode, then use the list of calculated
  // triangles, from Last to First.
  if Assigned(ILastTriangle) then
  begin
    Triangle:=ILastTriangle;
    while Assigned(Triangle) do
    begin
      if PointInPolygon(tmp,Triangle.P) then
      begin
        result:=Triangle.Index;
        break;
      end;

      Triangle:=Triangle.Prev;
    end;
  end
  else
  // Search across 3D non-Z sorted list of triangles...
  begin
    for t:=1 to NumTriangles do
    begin
      TrianglePointsTo2D(TrianglePoints(t),P);

      if PointInPolygon(tmp,P) then
      begin
        result:=t;
        break;
      end;
    end;
  end;
end;

Function TCustomTriSurfaceSeries.NumSampleValues:Integer;
begin
  result:=15;
end;

Procedure TCustomTriSurfaceSeries.AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False);
Const tmpRange  =    0.001;
      tmpRandom = 1000;
var t    : Integer;
    tmpX : Double;
    tmpZ : Double;
begin
  NumValues:=Max(NumValues,3);

  for t:=1 to NumValues do
  begin
    tmpX:=RandomValue(tmpRandom)*tmpRange;
    tmpZ:=RandomValue(tmpRandom)*tmpRange;
    AddXYZ(tmpX,Sqr(Exp(tmpZ))*Cos(tmpX*tmpZ),tmpZ);
  end;
end;

class Function TCustomTriSurfaceSeries.GetEditorClass:String;
begin
  result:='TTriSurfaceSeriesEditor'; { <-- dont translate ! }
end;

Procedure TCustomTriSurfaceSeries.SetBorder(Value:TChartHiddenPen);
begin
  FBorder.Assign(Value);
end;

function TCustomTriSurfaceSeries.IDxchg(I1,I2,I3,I4:Integer):Integer;
var x1,x2,x3,x4 : Double;
    y1,y2,y3,y4 : Double;
    u1,u2,u3,u4 : Double;
    A1,A2,B1,B2,
    C1,C2       : Double;
    S1,S2,S3,S4 : Double;
begin
  result:=0;
  x1:=XValues.Value[I1];
  y1:=ZValues.Value[I1];
  x2:=XValues.Value[I2];
  y2:=ZValues.Value[I2];
  x3:=XValues.Value[I3];
  y3:=ZValues.Value[I3];
  x4:=XValues.Value[I4];
  y4:=ZValues.Value[I4];

  u3:=(y2-y3)*(x1-x3)-(x2-x3)*(y1-y3);
  u4:=(y1-y4)*(x2-x4)-(x1-x4)*(y2-y4);
  if (u3*u4)>0 then
  begin
    u1:=(y3-y1)*(x4-x1)-(x3-x1)*(y4-y1);
    u2:=(y4-y2)*(x3-x2)-(x4-x2)*(y3-y2);

    A1:=sqr(x1-x3)+sqr(y1-y3);
    B1:=sqr(x4-x1)+sqr(y4-y1);
    C1:=sqr(x3-x4)+sqr(y3-y4);
    A2:=sqr(x2-x4)+sqr(y2-y4);
    B2:=sqr(x3-x2)+sqr(y3-y2);
    C2:=sqr(x2-x1)+sqr(y2-y1);

    S1:=Sqr(u1)/(C1*Math.Max(A1,B1));
    S2:=Sqr(u2)/(C1*Math.Max(A2,B2));
    S3:=Sqr(u3)/(C2*Math.Max(B2,A1));
    S4:=Sqr(u4)/(C2*Math.Max(B1,A2));

    if Math.Min(S1,S2) < Math.Min(S3,S4) then
          result:=1;
  end;
end;

procedure TCustomTriSurfaceSeries.DoBeforeDrawValues;

  Procedure CreateTriangles;
  Var NLT3 : Integer;
      ITF  : Array[1..2] of Integer;
      ipl1 : Integer;
      ipl2 : Integer;
      IPTI1: Integer;
      IPTI2: Integer;

    Procedure CalcBorder;
    var i    : Integer;
        JLT3 : Integer;
        IPLJ1: Integer;
        IPLJ2: Integer;
    begin
      for i:=1 to NLT3 div 3 do
      begin
        JLT3:=i*3;
        IPLJ1:=IPL[JLT3-2];
        IPLJ2:=IPL[JLT3-1];
        if ((IPLJ1=ipl1) and (IPLJ2=IPTI2)) or
           ((IPLJ2=ipl1) and (IPLJ1=IPTI2)) then
           IPL[JLT3]:=ITF[1];
        if ((IPLJ1=ipl2) and (IPLJ2=IPTI1)) or
           ((IPLJ2=ipl2) and (IPLJ1=IPTI1)) then
           IPL[JLT3]:=ITF[2];
      end;
    end;

    Var DSQMN : TChartValue;
        IPMN1 : Integer;
        IPMN2 : Integer;
        ip1   : Integer;
        ip2   : Integer;
        NDPM1 : Integer;
        xd1   : TChartValue;
        xd2   : TChartValue;
        yd1   : TChartValue;
        yd2   : TChartValue;
        NDP0  : Integer;
        DSQI  : Double;
     tmpCount : Integer;

    { find closest pair and their midpoint }
    Function FindClosestPair:Boolean;
    begin
      result:=False;
      DSQMN:=Sqr(XValues.Value[1]-XValues.Value[0])+Sqr(ZValues.Value[1]-ZValues.Value[0]);

      IPMN1:=1;
      IPMN2:=2;
      ip1:=1;
      while (not result) and (ip1<=NDPM1) do
      begin
        xd1:=XValues.Value[IP1];
        yd1:=ZValues.Value[IP1];

        ip2:=ip1+1;
        while (not result) and (ip2<=NDP0) do
        begin
          xd2:=XValues.Value[IP2];
          yd2:=ZValues.Value[IP2];
          DSQI:=Sqr(xd2-xd1)+Sqr(yd2-yd1);

          if DSQI=0.0 then
          begin
            XValues.Value[ip2]:=XValues.Value[NDP0];
            YValues.Value[ip2]:=YValues.Value[NDP0];
            ZValues.Value[ip2]:=ZValues.Value[NDP0];

            Dec(tmpCount);
            Dec(NDP0);
            Dec(NDPM1);
            Dec(ip2);
//            result:=True;  7.0 removed.
          end
          else
          if DSQI<DSQMN then
          begin
            DSQMN:=DSQI;
            IPMN1:=ip1;
            IPMN2:=ip2;
          end;