teesurfa.pas

BCB第三方组件

  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;

// Duplicate AddPalette methods to skip "TColorArray <> Array of TColor"
// compiler limitation.
{$IFNDEF CLR}
procedure TCustom3DPaletteSeries.AddPalette(Const APalette:Array of TColor);
var t : Integer;
    l : Integer;
begin
  CreateDefaultPalette;

  l:=Length(APalette);
  for t:=0 to PaletteSteps-1 do
      Palette[t].Color:=APalette[t mod l];

  Repaint;
end;
{$ENDIF}

procedure TCustom3DPaletteSeries.AddPalette(Const APalette:TColorArray);
var t : Integer;
    l : Integer;
begin
  l:=Length(APalette);

  if l>0 then
  begin
    CreateDefaultPalette;

    for t:=0 to PaletteSteps-1 do
        Palette[t].Color:=APalette[t mod l];

    Repaint;
  end;
end;

Function TCustom3DPaletteSeries.AddPalette(Const AValue:TChartValue; AColor:TColor):Integer;
var t   : Integer;
    tt  : Integer;
Begin
  // Try to search place to fit
  for t:=0 to Length(FPalette)-1 do
  begin
    if AValue<FPalette[t].UpToValue then
    begin
      // Insert
      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;

  // Append
  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=0);
var tmpMin     : Double;
    ScaleValue : Double;

  procedure SetRainbowPalette;
  var t : Integer;
      {$IFDEF CLR}
      tmp : Array of TColor;
      tmpParent : TCustomAxisPanel;
      {$ENDIF}
  begin
    if Assigned(ParentChart) then
    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;
  end;

Const Delta=127.0;
var t          : Integer;
    tmp        : Double;
    tmpColor   : TColor;
    Scale      : Double;
    tmpL       : Integer;
Begin
  if NumSteps=0 then
     NumSteps:=PaletteSteps;

  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=psCustom then
  begin
    // Expand or contract current custom palette with new UpToValues
    tmpL:=Length(FPalette);
    SetLength(FPalette,NumSteps);

    for t:=0 to NumSteps-1 do
    with Palette[t] do
    begin
      UpToValue:=tmpMin+ScaleValue*t;

      if (t>=tmpL) and (tmpL>0) then
         Color:=Palette[t mod tmpL].Color;
    end;
  end
  else
  begin
    ClearPalette;

    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;
  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(Min(1.0,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;

  if Assigned(FOnGetColor) then
     FOnGetColor(Self,ValueIndex,result);
End;

Function TCustom3DPaletteSeries.CountLegendItems:Integer;
begin
  if (Count>0) and (UseColorRange or UsePalette) then
  begin
    result:=Length(FPalette);
    if FLegendEvery>1 then result:=(result div FLegendEvery)+1;
  end
  else
     result:=inherited CountLegendItems;
end;

Function TCustom3DPaletteSeries.LegendString( LegendIndex:Integer;
                                              LegendTextStyle:TLegendTextStyle
                                              ):String;
var tmp : TChartValue;
begin
  if UseColorRange or UsePalette then
  begin
    if CountLegendItems>LegendIndex then
    begin
      tmp:=FPalette[LegendPaletteIndex(LegendIndex)].UpToValue;
      result:=FormatFloat(ValueFormat,tmp);
    end
    else
       result:='';
  end
  else
    result:=inherited LegendString(LegendIndex,LegendTextStyle);
end;

Function TCustom3DPaletteSeries.LegendPaletteIndex(LegendIndex:Integer):Integer;
begin
  result:=Length(FPalette)-(FLegendEvery*LegendIndex)-1;
end;

Function TCustom3DPaletteSeries.LegendItemColor(LegendIndex:Integer):TColor;
var tmp : Integer;
begin
  tmp:=LegendPaletteIndex(LegendIndex);  // 7.0

  if UseColorRange then
     result:=GetValueColorValue(FPalette[tmp].UpToValue)
  else
  if UsePalette and (Length(FPalette)>tmp) then
     result:=FPalette[tmp].Color
  else
     result:=inherited LegendItemColor(LegendIndex);
end;

Procedure TCustom3DPaletteSeries.SetPaletteSteps(Const Value:Integer);
Begin
  FPaletteSteps:=Value;
  CreateDefaultPalette;
End;

Procedure TCustom3DPaletteSeries.SetGalleryPalette;
begin
  if Assigned(ParentChart) and
     ((ParentChart as TCustomChart).ColorPaletteIndex<>0) then
  begin
    PaletteStyle:=psCustom;
    AddPalette(ParentChart.ColorPalette);
  end
  else
     PaletteStyle:=psRainbow;
end;

Procedure TCustom3DPaletteSeries.PrepareForGallery(IsEnabled:Boolean);
begin
  inherited;

  UseColorRange:=False;

  if IsEnabled then Pen.Color:=clBlack
               else Pen.Color:=clGray;

  UsePalette:=IsEnabled;

  SetGalleryPalette;
end;

Procedure TCustom3DPaletteSeries.Assign(Source:TPersistent);
begin
  if Source is TCustom3DPaletteSeries then
  With TCustom3DPaletteSeries(Source) do
  begin
    Self.FUsePalette   :=FUsePalette;
    Self.FUseColorRange:=FUseColorRange;
    Self.FStartColor   :=FStartColor;
    Self.FEndColor     :=FEndColor;
    Self.FMidColor     :=FMidColor;
    Self.FLegendEvery  :=FLegendEvery;
    Self.FPaletteSteps :=FPaletteSteps;
    Self.FPalette      :=FPalette;
    Self.FUsePaletteMin:=FUsePaletteMin;
    Self.FPaletteStep  :=FPaletteStep;
    Self.FPaletteMin   :=FPaletteMin;
    Self.FPaletteStyle :=FPaletteStyle;  // 6.02
  end;
  inherited;
end;

Procedure TCustom3DPaletteSeries.CheckPaletteEmpty;
begin
  if (Count>0) and (Length(FPalette)=0) then
     CreateDefaultPalette;
end;

{ internal }
procedure TCustom3DPaletteSeries.CalcValueRange;
begin
  IValueRangeInv:=MandatoryValueList.Range;
  if IValueRangeInv<>0 then IValueRangeInv:=1/IValueRangeInv;