teesurfa.pas

Delphi TeeChartPro.6.01的源代码

      // 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,60);
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.ClearGridIndex;
//var t : Integer;
begin
  SetLength(FGridIndex,0,0);
//  for t:=0 to Length(FGridIndex)-1 do FGridIndex[t]:=nil; // 6.0
//  FGridIndex:=nil;

{  for t:=1 to MaxAllowedCells do
  if Assigned(FGridIndex[t]) then
  begin
    Dispose(FGridIndex[t]);
    FGridIndex[t]:=nil;
  end;}
end;
*)

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

(*
Function TCustom3DGridSeries.GetGridIndex(X,Z:Integer):Integer;
begin
  if (Length(FGridIndex)>=x) and (Length(FGridIndex[x])>=z) then
     result:=FGridIndex[x,z]
  else
     result:=-1;
end;

Procedure TCustom3DGridSeries.SetGridIndex(X,Z,Value:Integer);
begin
  if X>(Length(FGridIndex)-1) then
     SetLength(FGridIndex,X+1);
  if Z>(Length(FGridIndex[x])-1) then SetLength(FGridIndex[x],Z+1);

  FGridIndex[x,z]:=Value;

  {if (X>=1) and (X<=MaxAllowedCells) and
     (Z>=1) and (Z<=MaxAllowedCells) then
  InternalSetGridIndex(x,z,value);
  }
end;
*)

(*
Procedure TCustom3DGridSeries.InternalSetGridIndex(X,Z,Value:Integer);
//var t : Integer;
begin

{  if not Assigned(FGridIndex[x]) then
  begin
    New(FGridIndex[x]); 6.0
    for t:=1 to MaxAllowedCells do FGridIndex[x]^[t]:=-1;
  end;
  }
  FGridIndex[x][z]:=Value;
end;
*)

Procedure TCustom3DGridSeries.InitGridIndex(XCount,ZCount:Integer);
var x : Integer;
    z : Integer;
begin
  SetLength(GridIndex,XCount+1,ZCount+1);
  for x:=0 to XCount do
      for z:=0 to ZCount do GridIndex[x,z]:=-1;
end;

Procedure TCustom3DGridSeries.FillGridIndex;
Var MinX   : TChartValue;
    MinZ   : TChartValue;
    XCount : Integer;
    ZCount : Integer;

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

    Procedure SearchValue(Var ACount:Integer; Var Values:TIrregValues; Const AValue:TChartValue);
    var t : Integer;
    begin
      t:=0;
      while t<ACount do
      begin
        if Values[t]=AValue then Break
        else
        begin
          Inc(t);
          if t=ACount then
          begin
            Values[t]:=AValue;
            Inc(ACount);
          end;
        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;
          if tmpIndex<>t then
          begin
            Values[tmpIndex]:=Values[t];
            Values[t]:=tmpMin;
          end;
        end;
      end;
     end;

    Function ValuePosition(ACount:Integer; Const Values:TIrregValues;
                                           Const AValue:TChartValue):Integer;
    begin
      result:=0;
      while (AValue<>Values[result]) and (result<ACount) do Inc(result);
      Inc(result);
    end;

  Var XVals : TIrregValues;
      ZVals : TIrregValues;
      t     : Integer;
  begin
    XCount:=1;
    XVals[0]:=MinX;
    ZCount:=1;
    ZVals[0]:=MinZ;

    for t:=0 to Count-1 do
    begin
      SearchValue(XCount,XVals,XValues.Value[t]);
      SearchValue(ZCount,ZVals,ZValues.Value[t]);
    end;

    SortValues(XCount,XVals);
    SortValues(ZCount,ZVals);

    InitGridIndex(XCount,ZCount);

    { use sorted xvals and zvals to index Mandatory ValueList in grid }
    for t:=0 to Count-1 do
        GridIndex[ ValuePosition(XCount,XVals,XValues.Value[t]),
                   ValuePosition(ZCount,ZVals,ZValues.Value[t])  ]:=t;
  end;

  Procedure FillRegularGrid;
  var t : Integer;
  begin
    XCount:=1+Round(XValues.MaxValue-MinX);
    ZCount:=1+Round(ZValues.MaxValue-MinZ);

    InitGridIndex(XCount,ZCount);

    for t:=0 to Count-1 do
        GridIndex[ 1+Round(XValues.Value[t]-MinX),
                   1+Round(ZValues.Value[t]-MinZ)  ]:=t;

      //InternalSetGridIndex(1+Round(XValues.Value[t]-MinX),1+Round(ZValues.Value[t]-MinZ),t);
  end;

begin
  MinX:=XValues.MinValue;
  MinZ:=ZValues.MinValue;
  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;
Begin
  CreateValues(FNumXValues,FNumZValues);
end;

Procedure TCustom3DGridSeries.SetNumXValues(Value:Integer);
Begin
  if Value<>FNumXValues then
  begin
    FNumXValues:=Value;
    Clear;
    ReCreateValues;
  end;
End;

Procedure TCustom3DGridSeries.SetNumZValues(Value:Integer);
Begin
  if Value<>FNumZValues then
  begin
    FNumZValues:=Value;
    Clear;
    ReCreateValues;
  end;
End;

Procedure TCustom3DGridSeries.AddValues(Source:TChartSeries);
Begin
  if Source is TCustom3DGridSeries then
  With TCustom3DGridSeries(Source) do
  begin
    Self.FNumXValues:=FNumXValues;
    Self.FNumZValues:=FNumZValues;
  end;

  inherited;
  
  FillGridIndex;
  Repaint;
end;

Procedure TCustom3DGridSeries.Assign(Source:TPersistent);
begin
  if Source is TCustom3DGridSeries then
  With TCustom3DGridSeries(Source) do
  begin
    Self.FNumXValues   :=FNumXValues;
    Self.FNumZValues   :=FNumZValues;
    Self.FIrregularGrid:=FIrregularGrid;
  end;
  inherited;
end;

Procedure TCustom3DGridSeries.SetIrregularGrid(Const Value:Boolean);
begin
  SetBooleanProperty(FIrregularGrid,Value);
end;

Function TCustom3DGridSeries.CanCreateValues:Boolean;
begin
  result:= Assigned(FOnGetYValue) or (csDesigning in ComponentState)
           or IInGallery;
end;

Procedure TCustom3DGridSeries.CreateValues(NumX,NumZ:Integer);
var x           : Integer;
    z           : Integer;
    OldCapacity : Integer;
Begin
  if CanCreateValues then
  begin
    FNumXValues:=NumX;
    FNumZValues:=NumZ;

    OldCapacity:=TeeDefaultCapacity;
    TeeDefaultCapacity:=NumX*NumZ;
    try
      Clear;
      BeginUpdate;
      for z:=1 to NumZ do
          for x:=1 to NumX do AddXYZ(X,GetXZValue(X,Z),Z);
      EndUpdate;
    finally
      TeeDefaultCapacity:=OldCapacity;
    end;

    CreateDefaultPalette(FPaletteSteps);
  end;
End;

Procedure TCustom3DGridSeries.AddSampleValues(NumValues:Integer);
var OldGallery : Boolean;
Begin
  if NumValues>0 then
  begin
    OldGallery:=IInGallery;
    IInGallery:=True;
    try
      CreateValues(NumValues,NumValues);
    finally
      IInGallery:=OldGallery;
    end;
  end;
End;

Procedure TCustom3DGridSeries.DoBeforeDrawChart;
begin
  inherited;
  if Count>0 then FillGridIndex;
end;

Function TCustom3DGridSeries.ExistFourGridIndex(X,Z:Integer):Boolean;
begin
//  if (Length(GridIndex)>(x+InextXCell)) then
//  begin
//    if Length(GridIndex[x+INextXCell])>(z+INextZCell) then
//    begin
      //if Assigned(FGridIndex[x]) and Assigned(FGridIndex[x+INextXCell]) then