teesurfa.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

Begin
  CreateValues(FNumXValues,FNumZValues);
end;

Procedure TCustom3DGridSeries.SetNumXValues(Value:Integer);
Begin
  if Value<>FNumXValues then
  begin
    FNumXValues:=Value;
    Clear;
    ReCreateValues;
  end;
End;

Procedure TCustom3DGridSeries.SetNumZValues(Value:Integer);
Begin
  if Value<>FNumZValues then
  begin
    FNumZValues:=Value;
    Clear;
    ReCreateValues;
  end;
End;

Procedure TCustom3DGridSeries.AddValues(Source:TChartSeries);
Begin
  if Source is TCustom3DGridSeries then
  With TCustom3DGridSeries(Source) do
  begin
    Self.FNumXValues:=FNumXValues;
    Self.FNumZValues:=FNumZValues;
  end;

  inherited;
  
  FillGridIndex;
  Repaint;
end;

Procedure TCustom3DGridSeries.Assign(Source:TPersistent);
begin
  if Source is TCustom3DGridSeries then
  With TCustom3DGridSeries(Source) do
  begin
    Self.FNumXValues   :=FNumXValues;
    Self.FNumZValues   :=FNumZValues;
    Self.FIrregularGrid:=FIrregularGrid;
  end;
  inherited;
end;

Procedure TCustom3DGridSeries.SetIrregularGrid(Const Value:Boolean);
begin
  SetBooleanProperty(FIrregularGrid,Value);
end;

Function TCustom3DGridSeries.CanCreateValues:Boolean;
begin
  result:= Assigned(FOnGetYValue) or (csDesigning in ComponentState)
           or IInGallery;
end;

Procedure TCustom3DGridSeries.CreateValues(NumX,NumZ:Integer);
var x           : Integer;
    z           : Integer;
    OldCapacity : Integer;
Begin
  if CanCreateValues then
  begin
    FNumXValues:=NumX;
    FNumZValues:=NumZ;

    OldCapacity:=TeeDefaultCapacity;
    TeeDefaultCapacity:=NumX*NumZ;
    try
      Clear;
      BeginUpdate;
      for z:=1 to NumZ do
          for x:=1 to NumX do AddXYZ(X,GetXZValue(X,Z),Z);
      EndUpdate;
    finally
      TeeDefaultCapacity:=OldCapacity;
    end;

    CreateDefaultPalette(FPaletteSteps);
  end;
End;

Procedure TCustom3DGridSeries.AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False);
var OldGallery : Boolean;
Begin
  if NumValues>0 then
  begin
    OldGallery:=IInGallery;
    IInGallery:=True;
    try
      CreateValues(NumValues,NumValues);
    finally
      IInGallery:=OldGallery;
    end;
  end;
End;

Procedure TCustom3DGridSeries.DoBeforeDrawChart;
begin
  inherited;
  if (not ReuseGridIndex) and (Count>0) then  // 7.0
     FillGridIndex;
end;

Function TCustom3DGridSeries.ExistFourGridIndex(X,Z:Integer):Boolean;
begin
  ValueIndex0:=GridIndex[x,z];
  if ValueIndex0>-1 then
  begin
    ValueIndex1:=GridIndex[x+INextXCell,z];
    if ValueIndex1>-1 then
    begin
      ValueIndex2:=GridIndex[x+INextXCell,z+INextZCell];
      if ValueIndex2>-1 then
      begin
        ValueIndex3:=GridIndex[x,z+INextZCell];
        result:=ValueIndex3>-1;
        exit;
      end;
    end;
  end;

  result:=False;
end;

function TCustom3DGridSeries.IsValidSeriesSource(Value:TChartSeries):Boolean;
begin
  result:=Value is TCustom3DGridSeries;
end;

function TCustom3DGridSeries.GetValue(X, Z: Integer): TChartValue;
var tmp : Integer;
begin
  tmp:=GridIndex[x,z];
  if tmp<>-1 then result:=YValues.Value[tmp]
             else Raise Exception.CreateFmt('No value found at XZ: %d %d',[x,z]);
end;

procedure TCustom3DGridSeries.SetValue(X, Z: Integer;
  const Value: TChartValue);
var tmp : Integer;
begin
  tmp:=GridIndex[x,z];
  if tmp<>-1 then YValues.Value[tmp]:=Value
             else GridIndex[x,z]:=AddXYZ(x,Value,z);
end;

{ TSurfaceSeries }
Constructor TSurfaceSeries.Create(AOwner: TComponent);
Begin
  inherited;
  INextXCell:=-1;
  INextZCell:=-1;
  FSideBrush:=TChartBrush.Create(CanvasChanged);
  FSideBrush.Style:=bsClear;
  FSideLines:=TChartHiddenPen.Create(CanvasChanged);
  FWaterLines:=CreateChartPen;
End;

Destructor TSurfaceSeries.Destroy;
Begin
  FSideLines.Free;
  FSideBrush.Free;
  FWaterLines.Free;
  inherited;
End;

class Function TSurfaceSeries.GetEditorClass:String;
Begin
  result:='TSurfaceSeriesEditor'; { <-- dont translate ! }
end;

Procedure TSurfaceSeries.PrepareForGallery(IsEnabled:Boolean);
begin
  inherited;
  IInGallery:=True;
  CreateValues(10,10);
end;

Function TSurfaceSeries.CalcPointPos(Index:Integer):TPoint;
begin
  {$IFNDEF TEEOPTCALCPOS}
  result.x:=ICalcX(IXValue[Index]);
  result.y:=ICalcY(IYValue[Index]);
  {$ELSE}
  result.x:=GetHorizAxis.CalcXPosValue(XValues.Value[Index]);
  result.y:=GetVertAxis.CalcYPosValue(YValues.Value[Index]);
  {$ENDIF}
end;

Function TSurfaceSeries.FourGridIndex(x,z:Integer):Boolean;
begin
  result:=ExistFourGridIndex(x,z);
  if result then
  begin
    Points[0]:=CalcPointPos(ValueIndex0);
    Points[1]:=CalcPointPos(ValueIndex1);
    Points[2]:=CalcPointPos(ValueIndex2);
    Points[3]:=CalcPointPos(ValueIndex3);
  end;
end;

Function TSurfaceSeries.CellsOrientation:TCellsOrientation;
var tmp : Integer;
begin
  if FWaterFall then tmp:=0 else tmp:=1;

  with result do
  begin
    if BackFaced then
    begin
      INextZCell:=1;
      InitZ:=1;
      EndZ:=FNumZValues-tmp+1;
      IncZ:=1;
    end
    else
    begin
      INextZCell:=-1;
      InitZ:=FNumZValues;
      EndZ:=1+tmp-1;
      IncZ:=-1;
    end;

    if DrawValuesForward then
    begin
      INextXCell:=-1;
      InitX:=2;
      EndX:=FNumXValues+1;
      IncX:=1;
    end
    else
    begin
      INextXCell:=1;
      InitX:=FNumXValues-1;
      EndX:=0;
      IncX:=-1;
    end;
  end;
end;

Function TSurfaceSeries.Clicked(x,y:Integer):Integer;
var tmpX : Integer;
    tmpZ : Integer;
    tmpPoint : TPoint;
    tmpPoints : TFourPoints;
    tmpO      : TCellsOrientation;
begin
  if Count>0 then
  begin
    INextXCell:=-1;
    INextZCell:=-1;
    tmpPoint:=TeePoint(x,y);

    PrepareCalcPos;
    
    tmpO:=CellsOrientation;

    with tmpO do
    begin
      INextZCell:=-INextZCell;
      IncZ:=-IncZ;
      tmpZ:=EndZ;

      while tmpZ<>InitZ do
      begin
        tmpX:=InitX;
        while tmpX<>EndX do
        begin
          if FourGridIndex(tmpX,tmpZ) then
          begin
            PointsTo2D(CalcZPos(ValueIndex0),CalcZPos(ValueIndex2),tmpPoints);
            if PointInPolygon(tmpPoint,tmpPoints) then
            begin
              result:=ValueIndex0;
              Exit;
            end;
          end;

          Inc(tmpX,IncX);
        end;

        Inc(tmpZ,IncZ); // front to back
      end;
    end;
  end;

  result:=TeeNoPointClicked;
end;

procedure TSurfaceSeries.SetSideBrush(Value:TChartBrush);
begin
  FSideBrush.Assign(Value);
end;

procedure TSurfaceSeries.SetSideLines(Value:TChartHiddenPen);
begin
  FSideLines.Assign(Value);
end;

type TChartAccess=class(TCustomChart);

Procedure TSurfaceSeries.DrawAllValues;

  Procedure DrawAllCells;

    Function PerspectiveCorrection:Boolean;  // 7.0
    const AngleRange=11;
    var tmp:Integer;
    begin
      result:=(not ParentChart.Canvas.SupportsFullRotation) and
              (ParentChart.View3DOptions.Perspective>0);

      if result then
      begin
        tmp:=ParentChart.View3DOptions.Rotation mod 360;
        result:= (tmp=360) or (tmp=180) or (tmp=0);

// Perspective correction:
//        result:=(Abs(360-tmp)<AngleRange) or
//                (Abs(tmp)<AngleRange) or (Abs(180-tmp)<AngleRange);
      end;
    end;

  var tmpZ : Integer;
      tmpO : TCellsOrientation;
      tmpXInit,
      tmpXEnd,
      tmpX     : Integer;
      tmpPosInit : Boolean;
  begin
    tmpO:=CellsOrientation;

    with tmpO do
    if PerspectiveCorrection then
    begin
      tmpXInit:=InitX;
      tmpXEnd:=EndX;
      tmpPosInit:=True;
      tmpX:=tmpXInit;

      repeat
        tmpZ:=InitZ;

        while tmpZ<>EndZ do
        begin
          DrawCell(tmpX,tmpZ);
          Inc(tmpZ,IncZ);
        end;

        if tmpPosInit then
        begin
          Dec(tmpXEnd,IncX);
          tmpX:=tmpXEnd;
        end
        else
        begin
          Inc(tmpXInit,IncX);
          tmpX:=tmpXInit;
        end;

        tmpPosInit:=not tmpPosInit;

      until tmpXInit=tmpXEnd;
    end
    else
      while InitX<>EndX do
      begin
        tmpZ:=InitZ;

        while tmpZ<>EndZ do
        begin
          DrawCell(InitX,tmpZ);
          Inc(tmpZ,IncZ);
        end;

        Inc(InitX,IncX);
      end;
  end;

  Procedure FastDraw;
  var tmpStyle : TTeeCanvasSurfaceStyle;
  begin
    if FWireFrame or (Brush.Style=bsClear) then  // 7.02
       tmpStyle:=tcsWire
    else
    if FDotFrame then
       tmpStyle:=tcsDot
    else
       tmpStyle:=tcsSolid;

    if Transparency>0 then
       IBlender:=ParentChart.Canvas.BeginBlending(TeeRect(0,0,0,0),Transparency);

    ParentChart.Canvas.Surface3D(tmpStyle,FSameBrush,FNumXValues,
                                 FNumZValues,FastCalcPoints);

    if Transparency>0 then
       ParentChart.Canvas.EndBlending(IBlender);
  end;

  Procedure DrawSides(BeforeCells:Boolean);
  Var tmpYOrigin : Integer;

    Function DrawFrontSideFirst:Boolean;
    var P : TFourPoints;
        tmpBottom : Integer;
        tmpChart  : TCustomChart;  // CLR needs this
    begin
      tmpChart:=ParentChart as TCustomChart;

      with tmpChart,ChartRect do
      begin
        P[0]:=Canvas.Calculate3DPosition(Right,Top,0);
        tmpBottom:=Bottom+TChartAccess(tmpChart).CalcWallSize(BottomAxis);
        P[1]:=Canvas.Calculate3DPosition(Right,tmpBottom,0);
        P[2]:=Canvas.Calculate3DPosition(Left,tmpBottom,0);
      end;
      
      result:=not TeeCull(P);
    end;

    Function CalcOnePoint(tmpRow,t:Integer; Var P0,P1:TPoint):Integer;
    Var tmpIndex : Integer;
    begin
      tmpIndex:=GridIndex[tmpRow,t];
      if tmpIndex<>-1 then
      begin
        P0:=CalcPointPos(tmpIndex);
        P1.x:=P0.x;
        P1.y:=tmpYOrigin;
        result:=CalcZPos(tmpIndex);
      end
      else result:=0;
    end;

  var tmpPoints  : TFourPoints;
      t          : Integer;
      z0         : Integer;
      z