⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teesurfa.pas

📁 Delphi TeeChartPro.6.01的源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
//      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;

//      end;
//    end
//    else result:=False;
//  end
//  else result:=False;

  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
  result.x:=GetHorizAxis.CalcXPosValue(XValues.Value[Index]);
  result.y:=GetVertAxis.CalcYPosValue(YValues.Value[Index]);
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.Clicked(x,y:Integer):Integer;
var tmpX : Integer;
    tmpZ : Integer;
begin
  if Count>0 then
  begin
    INextXCell:=-1;
    INextZCell:=-1;
    for tmpX:=2 to FNumXValues do
      for tmpZ:=2 to FNumZValues do { front to back... }
        if FourGridIndex(tmpX,tmpZ) and
           PointInPolygon(TeePoint(x,y),Points) then
        begin
          result:=ValueIndex0;
          exit;
        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 DrawCells;
  var x   : Integer;
      z   : Integer;
      tmp : Integer;
  begin
    if FWaterFall then tmp:=0 else tmp:=1;

    if ParentChart.DepthAxis.Inverted then
    begin
      INextZCell:=1;
      if not DrawValuesForward then
      begin
        INextXCell:=1;
        for x:=FNumXValues-1 downto 1 do
            for z:=1 to FNumZValues-tmp do DrawCell(x,z)
      end
      else
      begin
        INextXCell:=-1;
        for x:=2 to FNumXValues do
            for z:=1 to FNumZValues-tmp do DrawCell(x,z);
      end;
    end
    else
    begin
      INextZCell:=-1;
      if not DrawValuesForward then
      begin
        INextXCell:=1;
        for x:=FNumXValues-1 downto 1 do
            for z:=FNumZValues downto 1+tmp do DrawCell(x,z)
      end
      else
      begin
        INextXCell:=-1;
        for x:=2 to FNumXValues do
            for z:=FNumZValues downto 1+tmp do DrawCell(x,z);
      end;
    end;
  end;

  Procedure FastDraw;
  var tmpStyle : TTeeCanvasSurfaceStyle;
  begin
    if FWireFrame then 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;
    begin
      With TChartAccess(ParentChart),ChartRect do
      begin
        P[0]:=Canvas.Calculate3DPosition(Right,Top,0);
        tmpBottom:=Bottom+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;
      z1         : Integer;
      tmpRow     : Integer;
      tmpP       : TPoint;
      tmpLeft    : Boolean;
      tmpFront   : Boolean;
      tmpRight   : Boolean;
  begin
    With ParentChart.Canvas do
    begin
      AssignBrush(FSideBrush,FSideBrush.Color);
      AssignVisiblePen(FSideLines);
    end;

    With GetVertAxis do
    if Inverted then tmpYOrigin:=CalcYPosValue(YValues.MaxValue)
                else tmpYOrigin:=CalcYPosValue(YValues.MinValue);

    with TChartAccess(ParentChart) do
    begin
      tmpLeft:=DrawLeftWallFirst;
      tmpRight:=DrawRightWallAfter;
    end;

    if (tmpLeft and (not BeforeCells)) or
       ((not tmpLeft) and BeforeCells) then
    begin
      if GetHorizAxis.Inverted then tmpRow:=FNumXValues
                               else tmpRow:=1;
      for t:=FNumZValues downto 2 do
      begin
        Z0:=CalcOnePoint(tmpRow,t,tmpPoints[0],tmpPoints[1]);
        Z1:=CalcOnePoint(tmpRow,t-1,tmpPoints[3],tmpPoints[2]);
        ParentChart.Canvas.PlaneFour3D(tmpPoints,Z0,Z1);
      end;
    end;

    if (tmpRight and (not BeforeCells)) or
       ((not tmpRight) and BeforeCells) then
    begin
      if GetHorizAxis.Inverted then tmpRow:=1
                               else tmpRow:=FNumXValues;
      for t:=FNumZValues downto 2 do
      begin
        Z0:=CalcOnePoint(tmpRow,t,tmpPoints[0],tmpPoints[1]);
        Z1:=CalcOnePoint(tmpRow,t-1,tmpPoints[3],tmpPoints[2]);
        ParentChart.Canvas.PlaneFour3D(tmpPoints,Z0,Z1);
      end;
    end;

    tmpFront:=not DrawFrontSideFirst;

    if (tmpFront and (not BeforeCells)) or
       ((not tmpFront) and BeforeCells) then
    begin
      if ParentChart.DepthAxis.Inverted then tmpRow:=FNumZValues
                                        else tmpRow:=1;
      z0:=0;
      for t:=2 to FNumXValues do
      begin
        Z0:=CalcOnePoint(t,tmpRow,tmpPoints[0],tmpPoints[1]);
        Z1:=CalcOnePoint(t-1,tmpRow,tmpPoints[3],tmpPoints[2]);
        if t=FNumXValues then tmpP:=tmpPoints[0];
        ParentChart.Canvas.PlaneFour3D(tmpPoints,Z0,Z1);
      end;

      with ParentChart.Canvas do
      begin
        Pen.Style:=psSolid;
        VertLine3D(tmpP.X,tmpP.Y,tmpYOrigin,Z0);
      end;
    end;
  end;

  Procedure PrepareCanvas;
  begin
    With ParentChart.Canvas do
    begin
      if (not Self.Pen.Visible) and
         (not FWireFrame)   and
         (not FDotFrame) then Pen.Style:=psClear
                         else AssignVisiblePen(Self.Pen);
      AssignBrush(Self.Brush,SeriesColor);
      FSameBrush:=((not FUseColorRange) and (not FUsePalette)) or
                  Assigned(Self.Brush.Image.Graphic);
      if FWireFrame or FDotFrame then Brush.Style:=bsClear;
    end;
  end;

var tmpSides : Boolean;
begin
  if Count>0 then
  begin
    PrepareCanvas;

    tmpSides:=(FSideBrush.Style<>bsClear) or FSideLines.Visible;

    if ParentChart.Canvas.SupportsFullRotation then
       FastDraw
    else
    begin
      if tmpSides then DrawSides(True);

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

      DrawCells;

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

    if tmpSides then DrawSides(False);
  end;
end;

Function TSurfaceSeries.FastCalcPoints( x,z:Integer;
                                        Var P0,P1:TPoint3D;
                                        Var Color0,Color1:TColor):Boolean;
var tmp0 : TChartValue;
    tmp1 : TChartValue;
begin
  result:=False;

  ValueIndex0:=GridIndex[x-1,z];
  if ValueIndex0<>-1 then
  begin
    ValueIndex1:=GridIndex[x,z];
    if ValueIndex1<>-1 then
    begin
      With GetHorizAxis do
      begin
        P0.x:=CalcXPosValue(XValues.Value[ValueIndex0]);
        P1.x:=CalcXPosValue(XValues.Value[ValueIndex1]);
      end;

      P0.z:=CalcZPos(ValueIndex0);
      P1.z:=CalcZPos(ValueIndex1);
      tmp0:=YValues.Value[ValueIndex0];
      tmp1:=YValues.Value[ValueIndex1];

      With GetVertAxis do
      begin
        P0.y:=CalcYPosValue(tmp0);
        P1.y:=CalcYPosValue(tmp1);
      end;

      if not FSameBrush then
      begin
        Color0:=GetValueColorValue(tmp0);
        Color1:=GetValueColorValue(tmp1);
      end;

      result:=True;
    end;
  end;
end;

Procedure TSurfaceSeries.DrawCell(X,Z:Integer);
var tmpColor : TColor;
    Z0       : Integer;
    Z1       : Integer;

  Procedure DrawTheCell;
  var tmp      : Integer;
      IPoints  : TFourPoints;
  begin
    With ParentChart.Canvas do
    begin
      if FWaterFall then
      begin
        tmp:=GetVertAxis.IEndPos;
        if not FWireFrame then
        begin
          Pen.Style:=psClear;

          if Transparency>0 then
          begin
            IPoints[0]:=Calculate3DPosition(Points[0],Z0);
            IPoints[1]:=Calculate3DPosition(Points[1],Z0);
            IPoints[2]:=Calculate3DPosition(TeePoint(Points[1].X,tmp),Z0);
            IPoints[3]:=Calculate3DPosition(TeePoint(Points[0].X,tmp),Z0);

            if not SupportsFullRotation then
               IBlender.SetRectangle(RectFromPolygon(IPoints,4));

            Polygon(IPoints);

            if not SupportsFullRotation then
               IBlender.DoBlend(Transparency); // 5.03
          end
          else
            PlaneWithZ(Points[0],Points[1],
                       TeePoint(Points[1].X,tmp),
                       TeePoint(Points[0].X,tmp),
                       Z0);
        end;

        AssignVisiblePen(Self.Pen);
        LineWithZ(Points[0],Points[1],Z0);

        if WaterLines.Visible then
        begin
          AssignVisiblePen(WaterLines);
          VertLine3D(Points[0].X,Points[0].Y,tmp,Z0);
          VertLine3D(Points[1].X,Points[1].Y,tmp,Z0);
        end;
      end
      else
      if FDotFrame then
      begin
        With Points[0] do Pixels3D[X,Y,Z0]:=Valu

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -