teesurfa.pas

TeeChart 7.0 With Source在Delphi 7.0中的安装

  result:=inherited GetValueColor(ValueIndex);
  if (result<>clNone) and (not ColorEachPoint) then
     if (FUseColorRange or FUsePalette) and (result=clTeeColor) then
        result:=GetValueColorValue(MandatoryValueList.Value[ValueIndex])
     else
     if result=clTeeColor then result:=SeriesColor;
  }
  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(FPaletteSteps);
End;

Procedure TCustom3DPaletteSeries.PrepareForGallery(IsEnabled:Boolean);
begin
  inherited;
  UseColorRange:=False;
  if IsEnabled then Pen.Color:=clBlack
               else Pen.Color:=clGray;
  UsePalette:=IsEnabled;
  PaletteStyle:=psRainbow;
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(FPaletteSteps);
end;

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

Procedure TCustom3DPaletteSeries.DoBeforeDrawChart;
begin
  inherited;
  CheckPaletteEmpty;
  CalcValueRange;
end;

Procedure TCustom3DPaletteSeries.DrawLegendShape(ValueIndex:Integer;
                                                 Const Rect:TRect);
var R : TRect;
begin
  if (ValueIndex=-1) and UseColorRange then
  begin
    ParentChart.Canvas.Brush.Style:=bsClear;
    ParentChart.Canvas.Rectangle(Rect);  { <-- rectangle }

    with TTeeGradient.Create(nil) do
    try
      // set inverted colors
      StartColor:=Self.EndColor;
      MidColor:=Self.MidColor;
      EndColor:=Self.StartColor;
      // draw
      R:=Rect;
      InflateRect(R,-1,-1);
      Draw(ParentChart.Canvas,R);
    finally
      Free;
    end;
  end
  else inherited;
end;

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

Procedure TCustom3DPaletteSeries.Clear;
begin
  inherited;
  if FUsePalette then ClearPalette;
end;

class procedure TCustom3DPaletteSeries.CreateSubGallery(
  AddSubChart: TChartSubGalleryProc);
begin
  inherited;
  AddSubChart(TeeMsg_ColorRange);
end;

class procedure TCustom3DPaletteSeries.SetSubGallery(ASeries: TChartSeries;
  Index: Integer);
begin
  With TCustom3DPaletteSeries(ASeries) do
  Case Index of
    1: begin UseColorRange:=True; UsePalette:=False; end;
  else inherited;
  end;
end;

procedure TCustom3DPaletteSeries.CreateRangePalette;
var tmp     : Double;
    Delta   : Double;
    t       : Integer;
begin
  Delta:=MandatoryValueList.Range;
  ClearPalette;
  tmp:=Delta/PaletteSteps;
  for t:=1 to PaletteSteps do
    if Delta>0 then
      AddPalette(MandatoryValueList.MinValue+tmp*t,RangePercent(tmp*t/Delta))
    else
      AddPalette(MandatoryValueList.MinValue,RGB(IEndRed,IEndGreen,IEndBlue));
end;

Procedure TCustom3DPaletteSeries.GalleryChanged3D(Is3D:Boolean);
Const Rots:Array[Boolean] of Integer=(0,335);
      Elev:Array[Boolean] of Integer=(270,340);
      Pers:Array[Boolean] of Integer=(0,160);
begin
  ParentChart.View3D:=True;
  With ParentChart.View3DOptions do
  begin
    Zoom:=60;
    VertOffset:=-2;
    Rotation:=Rots[Is3D];
    Elevation:=Elev[Is3D];
    Perspective:=Pers[Is3D];
  end;
end;

procedure TCustom3DPaletteSeries.SetPaletteStyle(
  const Value: TTeePaletteStyle);
begin
  if FPaletteStyle<>Value then
  begin
    FPaletteStyle:=Value;
    ClearPalette;
    Repaint;
  end;
end;

procedure TCustom3DPaletteSeries.SetPaletteMin(const Value: Double);
begin
  FPaletteMin:=Value;
  CreateDefaultPalette(FPaletteSteps);
end;

procedure TCustom3DPaletteSeries.SetPaletteStep(const Value: Double);
begin
  FPaletteStep:=Value;
  CreateDefaultPalette(FPaletteSteps);
end;

procedure TCustom3DPaletteSeries.SetUsePaletteMin(const Value: Boolean);
begin
  FUsePaletteMin:=Value;
  CreateDefaultPalette(FPaletteSteps);
end;

procedure TCustom3DPaletteSeries.SetLegendEvery(const Value: Integer);
begin
  SetIntegerProperty(FLegendEvery,Value);
end;

{ TCustom3DGridSeries }
Constructor TCustom3DGridSeries.Create(AOwner: TComponent);
Begin
  inherited;
  FNumXValues:=10;
  FNumZValues:=10;
  Clear;
End;

Procedure TCustom3DGridSeries.Clear;
begin
  inherited;
  XValues.Order:=loNone;
  InitGridIndex(NumXValues,NumZValues);
end;

Procedure TCustom3DGridSeries.InitGridIndex(XCount,ZCount:Integer);
var x : Integer;
    z : Integer;
begin
  {$IFDEF CLR}  // CLR NET RTL bug
  GridIndex:=nil;
  {$ENDIF}

  SetLength(GridIndex,XCount+1,ZCount+1);

  if not ReuseGridIndex then  // 7.0 speed optimization
     for x:=0 to XCount do
         for z:=0 to ZCount do GridIndex[x,z]:=-1;
end;

Procedure TCustom3DGridSeries.FillGridIndex;
begin
  FillGridIndex(0);
end;

// StartIndex means the first point to start
Procedure TCustom3DGridSeries.FillGridIndex(StartIndex:Integer);
Var XCount : Integer;
    ZCount : Integer;

  Procedure FillIrregularGrid;
  Const MaxAllowedCells=3000; { max 3000 x 3000 cells }
  type TIrregValues=packed Array[0..MaxAllowedCells-1] of TChartValue;

    // Adds unique values of "AValue" to "Values" array.
    // Repeated values aren't allowed.
    Procedure SearchValue(Var ACount:Integer; Var Values:TIrregValues; Const AValue:TChartValue);
    var t : Integer;
    begin
      t:=0;
      while t<ACount do
        if Values[t]=AValue then Break
        else
        begin
          Inc(t);
          if t=ACount then
          begin
            Values[t]:=AValue;
            Inc(ACount);
            Break;
          end;
        end;
    end;

    Procedure SortValues(ACount:Integer; Var Values:TIrregValues);
    var t        : Integer;
        tt       : Integer;
        tmpMin   : TChartValue;
        tmpIndex : Integer;
    begin
      for t:=1 to ACount-2 do {min already at 0}
      begin
        tmpMin:=Values[t];
        tmpIndex:=t;

        for tt:=t+1 to ACount-1 do  {get minimum }
        begin
          if Values[tt]<tmpMin then
          begin
            tmpMin:=Values[tt];
            tmpIndex:=tt;

          end;
        end; // 7.0

        if tmpIndex<>t then
        begin
          Values[tmpIndex]:=Values[t];
          Values[t]:=tmpMin;
        end;
      end;
     end;

     Function FindValue(ACount:Integer; Var Values:TIrregValues; Const Value:TChartValue):Integer;
     var tmpV : TChartValue;
     begin
       result:=-1;

       repeat
         tmpV:=Values[result+1];
         if tmpV=Value then
         begin
           Inc(result);
           Exit;
         end;

         Inc(result);
       until result>=ACount;

       raise Exception.Create('Cannot find value irregular grid: '+Name);
     end;

  var
    XVals : TIrregValues;
    ZVals : TIrregValues;

    procedure SetGridIndex(Index:Integer);
    var tmpX : Integer;
        tmpZ : Integer;
    begin
      tmpX:=0;
      repeat
        if XVals[tmpX]=XValues.Value[Index] then
        begin
          tmpZ:=0;
          repeat
            if ZVals[tmpZ]=ZValues.Value[Index] then
            begin
              GridIndex[1+tmpX,1+tmpZ]:=Index;
              exit;
            end;

            Inc(tmpZ);
          until tmpZ>=ZCount;

          exit;
        end;

        Inc(tmpX);
      until tmpX>=XCount;
    end;

  var t : Integer;
  begin
    XCount:=1;
    XVals[0]:=XValues.MinValue;
    ZCount:=1;
    ZVals[0]:=ZValues.MinValue;

    // Adds all unique X and Z values to XVals and ZVals arrays
    // XCount and ZCount are updated to maximum number of non-repeated values
    for t:=StartIndex to Count-1 do
    begin
      SearchValue(XCount,XVals,XValues.Value[t]);
      SearchValue(ZCount,ZVals,ZValues.Value[t]);
    end;

    // Sort X and Z array values in ascending order
    SortValues(XCount,XVals);
    SortValues(ZCount,ZVals);

    InitGridIndex(XCount,ZCount);

    // Use sorted xvals and zvals to index Mandatory ValueList in grid
    for t:=StartIndex to Count-1 do SetGridIndex(t);
  end;

  Procedure FillRegularGrid;
  var t : Integer;
      tmpMinX,
      tmpMinZ : Integer;
  begin
    tmpMinX:=Round(XValues.MinValue)-1;
    tmpMinZ:=Round(ZValues.MinValue)-1;

    XCount:=Round(XValues.MaxValue)-tmpMinX;
    ZCount:=Round(ZValues.MaxValue)-tmpMinZ;

    InitGridIndex(XCount,ZCount);

    for t:=StartIndex to Count-1 do
        GridIndex[ Round(XValues.Value[t])-tmpMinX,
                   Round(ZValues.Value[t])-tmpMinZ  ]:=t;
  end;

begin
  if FIrregularGrid then FillIrregularGrid
                    else FillRegularGrid;

  if XCount<>FNumXValues then FNumXValues:=XCount;  { 5.01 }
  if ZCount<>FNumZValues then FNumZValues:=ZCount;  { 5.01 }
end;

Function TCustom3DGridSeries.GetXZValue(X,Z:Integer):TChartValue;
Begin
  if Assigned(FOnGetYValue) then result:=FOnGetYValue(Self,X,Z)
  else  { default sample random surface value formula }
  if (csDesigning in ComponentState) or
     (IInGallery) then
     result:=0.5*Sqr(Cos(x/(FNumXValues*0.2)))+
                 Sqr(Cos(z/(FNumZValues*0.2)))-
                 Cos(z/(FNumZValues*0.5))
  else
     result:=0;
end;

Function TCustom3DGridSeries.NumSampleValues:Integer;
begin
  result:=FNumXValues;
end;

Procedure TCustom3DGridSeries.ReCreateValues;