teetrisurface.pas

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

      xd1:=XValues.Value[IP1];
      yd1:=ZValues.Value[IP1];

      // determine visible borderline segments
      ip2:=IPL[1];
      JPMN:=1;

      xd2:=XValues.Value[IP2];
      yd2:=ZValues.Value[IP2];

      DXMN:=xd2-xd1;
      DYMN:=yd2-yd1;
      DSQMN:=Sqr(DXMN)+Sqr(DYMN);

      ARMN:=DSQMN*Ratio;
      jpmx:=1;
      dxmx:=DXMN;
      dymx:=DYMN;
      dsqmx:=DSQMN;
      armx:=ARMN;

      Part1;

      if jpmx<jpmn then Inc(jpmx,FNumLines);

      NSH:=JPMN-1;
      if NSH>0 then ShiftIPLArray;

      AddTriangles;

      FNumLines:=NLN;
      NLT3:=NLNT3;
      NLF:=JWL div 2;
      if (NLF<>0) and ImprovedTriangles then
         ImproveTriangles;
    end;

  Var jp1 : Integer;
  begin
    Inc(IUpdating);
    AddXYZ(XValues[0],YValues[0],ZValues[0]);  // 7.0 first point

    try
      tmpCount:=Count;
      NDP0:=tmpCount-1;
      NDPM1:=NDP0-1;
      SetLength(IPT,6*tmpCount-15);
      SetLength(IPL,6*tmpCount);
      SetLength(IWL,18*tmpCount);
      SetLength(IWP,tmpCount);
      SetLength(WK,tmpCount);
      try

        if not FindClosestPair then
        begin
          DSQ12:=DSQMN;
          SortRest;
          CheckColinear;
          AddFirst;
          // add the remaining NDP-3 data points one by one
          for jp1:=4 to NDP0 do CalcTriangle(jp1);
          ICreated:=True;
        end
        else
        begin
          Visible:=False;  // 7.0
          raise ETriSurfaceException.Create(TeeMsg_TriSurfaceSimilar);
        end;

      finally
        IWL:=nil;
        IWP:=nil;
        WK:=nil;
      end;
    finally
      Delete(Count-1);
      Dec(IUpdating);
    end;
  end;

begin
  inherited;

  if Count<3 then
  begin
    NumTriangles:=0;
//    raise ETriSurfaceException.Create(TeeMsg_TriSurfaceLess);
  end
  else
  if (not CacheTriangles) or (not ICreated) then { 5.02 }
     CreateTriangles;
end;

Function TCustomTriSurfaceSeries.CalcPointResult(Index:Integer):TPoint3D;
begin
  with result do
  begin
    X:=CalcXPos(Index);
    Y:=CalcYPos(Index);
    Z:=CalcZPos(Index);
  end;
end;

Function TCustomTriSurfaceSeries.TrianglePoints(TriangleIndex:Integer):TTrianglePoints3D;

  Procedure CalcPoint(APoint,Index:Integer);
  begin
    With result[APoint] do
    begin
      X:=CalcXPos(Index);
      Y:=CalcYPos(Index);
      Z:=CalcZPos(Index);
    end;
  end;

var tmp : Integer;
begin
  tmp:=3*TriangleIndex;
  CalcPoint(0,IPT[tmp-2]);
  CalcPoint(1,IPT[tmp-1]);
  CalcPoint(2,IPT[tmp]);
end;

Procedure TCustomTriSurfaceSeries.TrianglePointsTo2D(const P:TTrianglePoints3D; Var Result:TeCanvas.TTrianglePoints);
begin
  with ParentChart.Canvas do
  begin
    result[0]:=Calculate3DPosition(P[0]);
    result[1]:=Calculate3DPosition(P[1]);
    result[2]:=Calculate3DPosition(P[2]);
  end;
end;

procedure TCustomTriSurfaceSeries.DrawAllValues;

  procedure AddSortedTriangles;
  var tmpForward : Boolean;

    { sort triangles by Z (draw first triangles with bigger depth) }
    Procedure AddByZ(ATriangle:PTriangle);
    var tmp  : PTriangle;
        Last : PTriangle;
    begin
      Last:=nil;
      tmp:=Triangles;

      while Assigned(tmp) do
      begin
        if (tmpForward and (ATriangle.Z>tmp.Z)) or
           ((not tmpForward) and (tmp.Z>ATriangle.Z)) then
        begin
          if Assigned(tmp.Prev) then
          begin
            ATriangle.Prev:=tmp.Prev;
            tmp.Prev.Next:=ATriangle;
          end
          else Triangles:=ATriangle;

          tmp.Prev:=ATriangle;
          ATriangle.Next:=tmp;
          Exit;
        end;

        Last:=tmp;
        tmp:=tmp.Next;
      end;

      if Assigned(Last) then
      begin
        Last.Next:=ATriangle;
        ATriangle.Prev:=Last;
      end
      else Triangles:=ATriangle;
    end;

  var t : Integer;
      tmpTriangle : PTriangle;
      tmp : Integer;
      tmpPoints : TTrianglePoints3D;
  begin
    { create a list of triangles sorted by Z }
    tmpForward:=not ParentChart.DepthAxis.Inverted;

    if ParentChart.View3D and
       (not ParentChart.View3DOptions.Orthogonal) then
            if (ParentChart.View3DOptions.Rotation>90) and
               (ParentChart.View3DOptions.Rotation<270) then
                  tmpForward:=not tmpForward; // 7.0

    for t:=1 to NumTriangles do
    begin
      tmpPoints:=TrianglePoints(t);

      {$IFDEF CLR}
      tmpTriangle:=TTriangle.Create;
      {$ELSE}
      New(tmpTriangle);
      {$ENDIF}

      with tmpTriangle{$IFNDEF CLR}^{$ENDIF} do
      begin
        Next:=nil;
        Prev:=nil;
        Index:=t;

        // Aproximate Z to the greatest of 3 triangle corners
        tmp:=3*t;
        Z:=Math.Max(ZValues.Value[IPT[tmp]],
           Math.Max(ZValues.Value[IPT[tmp-1]],ZValues.Value[IPT[tmp-2]]));

        // Calculate XY screen positions of corners
        TrianglePointsTo2D(tmpPoints,P);

        //Color
        Color:=ValueColor[IPT[tmp-2]];
      end;

      AddByZ(tmpTriangle);
    end;
  end;

var
  tmpBlend  : TTeeBlend;

  procedure DrawAllUnsorted;
  var t : Integer;
      tmpColors : TTriangleColors3D;
      tmpPoints : TTrianglePoints3D;
      tmpSmooth : Boolean;
      P         : TTrianglePoints;
  begin
    tmpSmooth:=ParentChart.Canvas.SupportsFullRotation;

    // draw all triangles, do not hide
    for t:=1 to NumTriangles do
    begin
      tmpPoints:=TrianglePoints(t);

      if Transparency>0 then
      begin
        TrianglePointsTo2D(tmpPoints,P);
        tmpBlend.SetRectangle(RectFromTriangle(P));
      end;

      tmpColors[0]:=ValueColor[IPT[3*t-2]];

      if tmpSmooth then  // 7.0
      begin
        tmpColors[1]:=ValueColor[IPT[3*t-1]];
        tmpColors[2]:=ValueColor[IPT[3*t]];
      end
      else
      begin
        tmpColors[1]:=tmpColors[0];
        tmpColors[2]:=tmpColors[0];
      end;

      ParentChart.Canvas.Triangle3D(tmpPoints,tmpColors);

      if Transparency>0 then
         tmpBlend.DoBlend(Transparency);
    end;
  end;

  procedure DrawAllSorted;
  var Triangle : PTriangle;
  begin
    {$IFNDEF CLX}
    if FastBrush then  // 7.0
    begin
      CanvasDC:=ParentChart.Canvas.Handle;
      SelectObject(CanvasDC,DCBRUSH);
    end;
    {$ENDIF}

    { draw all triangles }
    Triangle:=Triangles;

    while Assigned(Triangle) do
    begin
      {$IFNDEF CLX}
      if FastBrush then // 7.0
         TeeSetDCBrushColor(CanvasDC,Triangle.Color)
      else
      {$ENDIF}
        ParentChart.Canvas.Brush.Color:=Triangle.Color;

      if Transparency>0 then
         tmpBlend.SetRectangle(RectFromPolygon(Triangle.P,3));

      ParentChart.Canvas.Polygon(Triangle.P);

      if Transparency>0 then
         tmpBlend.DoBlend(Transparency);

      ILastTriangle:=Triangle;
      Triangle:=Triangle.Next;
    end;
  end;

var t : Integer;
begin
  ILastTriangle:=nil;  // for Clicked method

  With ParentChart.Canvas do
  begin
    if Self.Pen.Visible or (Self.Brush.Style<>bsClear) then
    begin
      AssignBrush(Self.Brush,Self.Brush.Color);
      AssignVisiblePen(Self.Pen);

      if Transparency>0 then
         tmpBlend:=BeginBlending(TeeRect(0,0,0,0),Transparency)
      else
         tmpBlend:=nil;

      if HideTriangles and (not SupportsFullRotation) and (Brush.Style=bsSolid) then
      begin
        ClearTriangles;
        AddSortedTriangles;
        DrawAllSorted;
      end
      else
        DrawAllUnsorted;

      tmpBlend.Free;  // Do not call EndBlending here...
    end;

    { draw border }
    if Self.FBorder.Visible then
    begin
      AssignVisiblePen(Self.FBorder);

      for t:=1 to FNumLines do
      begin
        MoveTo3D(CalcPointResult(IPL[3*t-2]));
        LineTo3D(CalcPointResult(IPL[3*t-1]));
      end;
    end;
  end;
end;

procedure TCustomTriSurfaceSeries.SetFastBrush(const Value: Boolean);
begin
  {$IFNDEF CLX}
  if Assigned(@TeeSetDCBrushColor) then
  begin
    FFastBrush:=Value;
    DCBRUSH:=GetStockObject(DC_BRUSH);
  end;
  {$ENDIF}
end;

Procedure TCustomTriSurfaceSeries.DrawMark( ValueIndex:Integer; Const St:String;
                                            APosition:TSeriesMarkPosition);
begin
  Marks.ZPosition:=CalcZPos(ValueIndex);
  Marks.ApplyArrowLength(APosition);
  inherited;
end;

procedure TCustomTriSurfaceSeries.Assign(Source: TPersistent);
begin
  if Source is TCustomTriSurfaceSeries then
  with TCustomTriSurfaceSeries(Source) do
  begin
    Self.Border:=Border;
    Self.ImprovedTriangles:=ImprovedTriangles;
    Self.FHide:=HideTriangles;
    Self.FTransp:=Transparency;
  end;

  inherited;
end;

class procedure TCustomTriSurfaceSeries.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_WireFrame);
  AddSubChart(TeeMsg_NoLine);
  AddSubChart(TeeMsg_Border);
end;

Procedure TCustomTriSurfaceSeries.PrepareForGallery(IsEnabled:Boolean);
begin
  inherited;
  FillSampleValues;
end;

class procedure TCustomTriSurfaceSeries.SetSubGallery(
  ASeries: TChartSeries; Index: Integer);
begin
  With TCustomTriSurfaceSeries(ASeries) do
  Case Index of
    2: Brush.Style:=bsClear;
    3: Pen.Hide;
    4: Border.Show;
  else inherited;
  end;
end;

procedure TCustomTriSurfaceSeries.Clear;
begin
  inherited;
  ICreated:=False;
end;

procedure TCustomTriSurfaceSeries.SetHide(const Value: Boolean);
begin
  SetBooleanProperty(FHide,Value);
end;

Procedure TCustomTriSurfaceSeries.SetTransp(Value:TTeeTransparency);
begin
  if FTransp<>Value then
  begin
    FTransp:=Value;
    Repaint;
  end;
end;

initialization
  RegisterTeeSeries( TTriSurfaceSeries, {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryTriSurface,
                                        {$IFNDEF CLR}@{$ENDIF}TeeMsg_Gallery3D,1);
finalization
  UnRegisterTeeSeries([TTriSurfaceSeries]);
end.