teesurfa.pas

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

    property StartColor;
    property UseColorRange;
    property UsePalette;
    property UsePaletteMin;
    property TimesZOrder;
    property XValues;
    property YValues;
    property ZValues;

    { events }
    property OnGetYValue;
    property OnGetColor;
  end;

implementation

Uses {$IFDEF CLR}
     SysUtils,
     Math,
     {$ELSE}
     {$IFDEF CLX}
     Qt,
     {$ELSE}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     {$ENDIF}
     Math,
     {$ENDIF}
     TeeSpline, TeeProCo, TeeConst;

{ 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
  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;

  CalcValueRange;
end;

Procedure TCustom3DPaletteSeries.SetStartColor(Const Value:TColor);
Begin
  SetColorProperty(FStartColor,Value);
  CalcColorRange;
End;

Procedure TCustom3DPaletteSeries.SetMidColor(Const Value:TColor);
Begin
  SetColorProperty(FMidColor,Value);
  CalcColorRange;
End;

Procedure TCustom3DPaletteSeries.SetEndColor(Const Value:TColor);
Begin
  SetColorProperty(FEndColor,Value);
  CalcColorRange;
End;

Function TCustom3DPaletteSeries.AddPalette(Const AValue:TChartValue; AColor:TColor):Integer;
var t   : Integer;
    tt  : Integer;
Begin
  for t:=0 to Length(FPalette)-1 do
  begin
    if AValue<FPalette[t].UpToValue then
    begin
      SetLength(FPalette,Length(FPalette)+1);
      for tt:=Length(FPalette)-1 downto t+1 do
          FPalette[tt]:=FPalette[tt-1];
      With FPalette[t] do
      begin
        UpToValue:=AValue;
        Color:=AColor;
      end;
      result:=t;
      exit;
    end;
  end;

  result:=Length(FPalette);
  SetLength(FPalette,result+1);
  With FPalette[result] do
  begin
    UpToValue:=AValue;
    Color:=AColor;
  end;
End;

Procedure TCustom3DPaletteSeries.ClearPalette;
Begin
  FPalette:=nil;
end;

Procedure TCustom3DPaletteSeries.CreateDefaultPalette(NumSteps:Integer);
var tmpMin     : Double;
    ScaleValue : Double;

  procedure SetRainbowPalette;
  var t : Integer;
      {$IFDEF CLR}
      tmp : Array of TColor;
      tmpParent : TCustomAxisPanel;
      {$ENDIF}
  begin
    // Wish: Instead of using "Length(RainbowPalette)" here use: NumSteps.
    //
    // ie: Needs to calculate "middle" colors in between
    // if the NumSteps is bigger than 25.
    {$IFDEF CLR}
    SetLength(tmp,Length(RainbowPalette));
    System.Array.Copy(RainbowPalette,tmp,Length(RainbowPalette));
    tmpParent:=ParentChart;  // ugly CLR trick
    tmpParent.ColorPalette:=tmp;
    tmp:=nil;
    {$ELSE}
        SetLength(ParentChart.ColorPalette,Length(RainbowPalette));
    for t:=0 to Length(RainbowPalette)-1 do
        ParentChart.ColorPalette[t]:=RainbowPalette[t];
    {$ENDIF}

    // Default:
    for t:=0 to NumSteps-1 do
      AddPalette(tmpMin+ScaleValue*t,ParentChart.GetDefaultColor(t));

    {$IFNDEF CLR}
    ParentChart.ColorPalette:=nil; // should be OLD palette !!
    {$ENDIF}
  end;

Const Delta=127.0;
var t          : Integer;
    tmp        : Double;
    tmpColor   : TColor;
    Scale      : Double;
Begin
  ClearPalette;

  if PaletteStep=0 then // 5.03
  begin
    if PaletteRange=0 then
       ScaleValue:=MandatoryValueList.Range/Math.Max(1,NumSteps-1)
    else
       ScaleValue:=PaletteRange/NumSteps;
  end
  else ScaleValue:=PaletteStep;

  // 5.03
  if UsePaletteMin then tmpMin:=PaletteMin
                   else tmpMin:=MandatoryValueList.MinValue;

  if PaletteStyle=psRainbow then   // 7.0
     SetRainbowPalette
  else
  begin
    case PaletteStyle of
        psPale: Scale:=Pi/NumSteps;
      psStrong: Scale:=2.0*Pi/NumSteps;
    else
      Scale:=255.0/NumSteps;
    end;

    for t:=0 to NumSteps-1 do
    begin
      tmp:=Scale*t;

      case PaletteStyle of
        psGrayScale: begin
                       tmpColor:=Round(tmp);
                       tmpColor:=RGB(tmpColor,tmpColor,tmpColor);
                     end;
        psInvGray:   begin
                       tmpColor:=255-Round(tmp);
                       tmpColor:=RGB(tmpColor,tmpColor,tmpColor);
                     end;

      else
        tmpColor:=RGB( Trunc(Delta * (Sin(tmp/RedFactor)+1)) ,
                       Trunc(Delta * (Sin(tmp/GreenFactor)+1)),
                       Trunc(Delta * (Cos(tmp/BlueFactor)+1)));
      end;

      AddPalette(tmpMin+ScaleValue*t,tmpColor);
    end;
  end;

  Repaint;
end;

Procedure TCustom3DPaletteSeries.SetUseColorRange(Const Value:Boolean);
Begin
  SetBooleanProperty(FUseColorRange,Value);
  if Value then ColorEachPoint:=False;
End;

Procedure TCustom3DPaletteSeries.SetUsePalette(Const Value:Boolean);
Begin
  SetBooleanProperty(FUsePalette,Value);
  if Value then
  begin
    ColorEachPoint:=False;
    CheckPaletteEmpty;
  end;
end;

Function TCustom3DPaletteSeries.GetSurfacePaletteColor(Const Y:TChartValue):TColor;
Var t        : Integer;
    tmpCount : Integer;
Begin
  tmpCount:=Length(FPalette)-1;

  for t:=0 to tmpCount do
  With FPalette[t] do
  if UpToValue>Y then
  begin
    result:=Color;
    exit;
  end;

  result:=FPalette[tmpCount].Color; { return max }
end;

// Note: The Round function is very slow.
Function TCustom3DPaletteSeries.RangePercent(Const Percent:Double):TColor;
begin
  if MidColor=clNone then
     result:=RGB( IEndRed  +Round(Percent*IRangeRed),
                  IEndGreen+Round(Percent*IRangeGreen),
                  IEndBlue +Round(Percent*IRangeBlue))
  else
  if Percent<0.5 then
     result:=RGB( IEndRed  +Round((2.0*Percent)*IRangeRed),
                  IEndGreen+Round((2.0*Percent)*IRangeGreen),
                  IEndBlue +Round((2.0*Percent)*IRangeBlue))
  else
     result:=RGB( IMidRed  +Round(2.0*(Percent-0.5)*IRangeMidRed),
                  IMidGreen+Round(2.0*(Percent-0.5)*IRangeMidGreen),
                  IMidBlue +Round(2.0*(Percent-0.5)*IRangeMidBlue))
end;

Function TCustom3DPaletteSeries.GetValueColorValue(Const AValue:TChartValue):TColor;
var tmp : Double;
begin
  if UseColorRange then
  begin
    if IValueRangeInv=0 then
       result:=EndColor
    else
    begin
      tmp:=AValue-MandatoryValueList.MinValue;
      if tmp<0 then result:=EndColor
      else
      if AValue>MandatoryValueList.MaxValue then
         result:=StartColor
      else
         result:=RangePercent(tmp*IValueRangeInv);
    end;
  end
  else
  if UsePalette and (Length(FPalette)>0) then
     result:=GetSurfacePaletteColor(AValue)
  else
     result:=SeriesColor;
end;

Function TCustom3DPaletteSeries.GetValueColor(ValueIndex:Integer):TColor;
Begin
  result:=InternalColor(ValueIndex);
  if result=clTeeColor then
  begin
    if (not ColorEachPoint) and (FUseColorRange or FUsePalette) then
       result:=GetValueColorValue(MandatoryValueList.Value[ValueIndex])
    else
       result:=inherited GetValueColor(ValueIndex);
  end;
  {