chart.pas

BCB第三方组件

  FText.Assign(Value);
  Repaint;
end;

Procedure TChartTitle.SetVertMargin(const Value:Integer);
begin
  if FVertMargin<>Value then
  begin
    FVertMargin:=Value;
    Repaint;
  end;
end;

function TChartTitle.GetCaption: String;
begin
  if Text.Count>0 then result:=Text[0]
                  else result:='';
end;

procedure TChartTitle.SetCaption(const Value: String);
begin
  Text.Clear;

  if Value<>'' then
     Text.Add(Value);
end;

procedure TChartTitle.Clear;
begin
  Caption:='';
end;

{ TChartFootTitle }
Constructor TChartFootTitle.Create(AOwner: TCustomTeePanel);
Begin
  inherited {$IFDEF CLR}Create(AOwner){$ENDIF};
  IOnTop:=False;
  With Font do
  Begin
    Color:=clRed;
    Style:=[fsItalic];
  end;

  //TODO: DCCIL problem prevents using "with" here...
  TTeeFontAccess(Font).IDefColor:=clRed;
  TTeeFontAccess(Font).IDefStyle:=[fsItalic];
end;

{ TChartWalls }
constructor TChartWalls.Create(Chart: TCustomChart);
begin
  inherited Create;
  FChart:=Chart;
  FBack:=TChartBackWall.Create(FChart);
  FLeft:=TChartLeftWall.Create(FChart);
  FLeft.InitColor($80FFFF); { ChartMarkColor }

  FBottom:=TChartBottomWall.Create(FChart);
  FBottom.InitColor(clWhite);

  FRight:=TChartRightWall.Create(FChart);
  With FRight do
  begin
    Visible:=False;
    InitColor(clSilver);
  end;
end;

procedure TChartWalls.Assign(Source: TPersistent);
begin
  if Source is TChartWalls then
  with TChartWalls(Source) do
  begin
    Self.Back   :=Back;
    Self.Bottom :=Bottom;
    Self.Left   :=Left;
    Self.Right  :=Right;
  end
  else inherited;
end;

destructor TChartWalls.Destroy;
begin
  FBack.Free;
  FBottom.Free;
  FLeft.Free;
  FRight.Free;
  inherited;
end;

procedure TChartWalls.SetBack(const Value: TChartBackWall);
begin
  Back.Assign(Value);
end;

procedure TChartWalls.SetBottom(const Value: TChartBottomWall);
begin
  Bottom.Assign(Value);
end;

procedure TChartWalls.SetLeft(const Value: TChartLeftWall);
begin
  Left.Assign(Value);
end;

procedure TChartWalls.SetRight(const Value: TChartRightWall);
begin
  Right.Assign(Value);
end;

function TChartWalls.GetVisible: Boolean;
begin
  result:=FChart.View3DWalls;
end;

procedure TChartWalls.SetVisible(const Value: Boolean);
begin
  FChart.View3DWalls:=Value;
end;

procedure TChartWalls.SetSize(const Value: Integer);
begin
  Left.Size:=Value;
  Right.Size:=Value;
  Back.Size:=Value;
  Bottom.Size:=Value;
end;

{ TCustomChart }
Constructor TCustomChart.Create(AOwner: TComponent);
Begin
  inherited;
  AutoRepaint:=False;
  FTitle:=TChartTitle.Create(Self);
  if csDesigning in ComponentState then FTitle.FText.Add(ClassName);

  FScrollMouse:=mbRight;

  FSubTitle:=TChartTitle.Create(Self);
  FFoot    :=TChartFootTitle.Create(Self);
  FSubFoot :=TChartFootTitle.Create(Self);

  FWalls:=TChartWalls.Create(Self);
  FLegend:=TChartLegend.Create(Self);

  RestoredAxisScales:=True;
  AutoRepaint :=True;

  if Assigned(TeeNewChartHook) then
     if (csDesigning in ComponentState) and
        Assigned(Owner) and 
        (not (csLoading in Owner.ComponentState)) then
           TeeNewChartHook(Self);
end;

Destructor TCustomChart.Destroy;
Begin
  FSavedScales:=nil;
  AutoRepaint:=False;  { 5.01 }
  FSubTitle.Free;
  FTitle.Free;
  FSubFoot.Free;
  FFoot.Free;
  FWalls.Free;
  FreeAndNil(FLegend);
  inherited;
end;

type
  TSeriesAccess=class(TChartSeries);

Function TCustomChart.FormattedValueLegend(ASeries:TChartSeries; ValueIndex:Integer):String;
var tmp : TCustomChartLegend;
Begin
  if Assigned(ASeries) then
  begin
    tmp:=TCustomChartLegend(TSeriesAccess(ASeries).ILegend);
    if not Assigned(tmp) then tmp:=Legend;
    result:=tmp.FormattedValue(ASeries,ValueIndex);
  end
  else
     result:='';
end;

Function TCustomChart.InternalFormattedLegend( ALegend:TCustomChartLegend;
                                               SeriesOrValueIndex:Integer):String;
begin
  result:=ALegend.FormattedLegend(SeriesOrValueIndex);

  if Assigned(FOnGetLegendText) then
     FOnGetLegendText(Self,ALegend.InternalLegendStyle,SeriesOrValueIndex,result);
end;

Function TCustomChart.FormattedLegend(SeriesOrValueIndex:Integer):String;
Begin
  result:=InternalFormattedLegend(Legend,SeriesOrValueIndex);
end;

procedure TCustomChart.SetLegend(Value:TChartLegend);
begin
  FLegend.Assign(Value);
end;

// "remember" the axis scales when zooming, to restore when unzooming
Function TCustomChart.SaveScales:TAllAxisSavedScales;
var t : Integer;
begin
  SetLength(result,Axes.Count);
  for t:=0 to Axes.Count-1 do
  with Axes[t] do
    if not IsDepthAxis then
    begin
      result[t].Auto:=Automatic;
      result[t].AutoMin:=AutomaticMinimum;
      result[t].AutoMax:=AutomaticMaximum;
      result[t].Min:=Minimum;
      result[t].Max:=Maximum;
    end;
end;

type
  TAxisAccess=class(TChartAxis);

// restore the "remembered" axis scales when unzooming
Procedure TCustomChart.RestoreScales(var Saved:TAllAxisSavedScales);
var t : Integer;
begin
  for t:=0 to Axes.Count-1 do
  with {$IFNDEF CLR}TAxisAccess{$ENDIF}(Axes[t]) do
    if not IsDepthAxis then
    begin
      Automatic:=Saved[t].Auto;
      AutomaticMinimum:=Saved[t].AutoMin;
      AutomaticMaximum:=Saved[t].AutoMax;
      
      {$IFDEF LCL} // Lazarus FPC bug?
      SetMinMax(Saved[t].Min,Saved[t].Max);
      {$ELSE}
      
      {$IFDEF CLR}TAxisAccess(Axes[t]).{$ENDIF}InternalSetMinimum(Saved[t].Min);
      {$IFDEF CLR}TAxisAccess(Axes[t]).{$ENDIF}InternalSetMaximum(Saved[t].Max);
      
      {$ENDIF}
//      if not Automatic then SetMinMax(Saved[t].Min,Saved[t].Max);  // 7.0 Removed
    end;

  Saved:=nil;
end;

procedure TCustomChart.SetBackWall(Value:TChartBackWall);
begin
  Walls.Back:=Value;
end;

function TCustomChart.GetBackWall: TChartBackWall;
begin
  result:=Walls.Back;
end;

function TCustomChart.GetBottomWall: TChartBottomWall;
begin
  result:=Walls.Bottom;
end;

function TCustomChart.GetLeftWall: TChartLeftWall;
begin
  result:=Walls.Left;
end;

function TCustomChart.GetRightWall: TChartRightWall;
begin
  result:=Walls.Right;
end;

Function TCustomChart.GetFrame:TChartPen;
begin
  if Assigned(Walls.Back) then result:=Walls.Back.Pen
                          else result:=nil;
end;

Procedure TCustomChart.SetFrame(Value:TChartPen);
begin
  BackWall.Pen.Assign(Value);
end;

Function TCustomChart.GetBackColor:TColor;
begin
  if BackWall.Transparent then result:=Color
                          else result:=BackWall.Color;
end;

Procedure TCustomChart.SetBackColor(Value:TColor);
begin
  BackWall.Color:=Value;
  { fix 4.01: do not set backwall solid when loading dfms... }
  if Assigned(Parent) and (not (csLoading in ComponentState)) then
     BackWall.Brush.Style:=bsSolid;
end;

Function TCustomChart.IsFreeSeriesColor(AColor:TColor; CheckBackground:Boolean;
                                        ASeries:TChartSeries=nil):Boolean;
var t : Integer;
Begin
  for t:=0 to SeriesCount-1 do
  if ((Series[t]<>ASeries) and (Series[t].SeriesColor=AColor)) or  // 6.02
     (CheckBackground and
     ( (AColor=Color) or (AColor=BackWall.Color) )) then
  begin
    result:=False;
    exit;
  end;
  result:=(not CheckBackground) or ( (AColor<>Color) and (AColor<>BackWall.Color) );
end;

procedure TCustomChart.SetLeftWall(Value:TChartLeftWall);
begin
  Walls.Left:=Value;
end;

procedure TCustomChart.SetBottomWall(Value:TChartBottomWall);
begin
  Walls.Bottom:=Value;
end;

procedure TCustomChart.SetRightWall(Value:TChartRightWall);
begin
  Walls.Right:=Value;
end;

Procedure TCustomChart.DrawRightWall;
var tmpB : Integer;
    tmp  : Integer;
    tmpTop   : Integer;
    tmpBlend : TTeeBlend;
begin
  if RightWall.Visible and ActiveSeriesUseAxis and View3D and View3DWalls then
  begin
    PrepareWallCanvas(RightWall);

    RightWall.CalcPositions(tmpTop,tmpB);

    tmpBlend:=RightWall.TryDrawWall(ChartRect.Right,tmpB);

    with RightWall do
    begin
      if Size>0 then
      begin
        if BackWall.Visible then tmp:=BackWall.Size
                            else tmp:=0;

        Canvas.Cube(ChartRect.Right,ChartRect.Right+Size,tmpTop,tmpB,0,Width3D+tmp,ApplyDark3D)
      end
      else
        Canvas.RectangleZ(ChartRect.Right,tmpTop,tmpB,0,Succ(Width3D));

      if Assigned(FPicture) and Assigned(FPicture.Graphic) then
         Canvas.StretchDraw(TeeRect(0,tmpTop,Width3D,tmpB),
                            Picture.Filtered,
                            ChartRect.Right,cpX);

      DoEndBlending(tmpBlend);
    end;
  end;
end;

Function TCustomChart.DrawWallFirst(APos:Integer):Boolean;
var P : TFourPoints;
    tmpBottom : Integer;
begin
  if Canvas.SupportsFullRotation then
     result:=True
  else
  begin
    With ChartRect do
    begin
      P[0]:=Canvas.Calculate3DPosition(APos,Top,0);
      tmpBottom:=Bottom+CalcWallSize(BottomAxis);
      P[1]:=Canvas.Calculate3DPosition(APos,tmpBottom,0);
      P[2]:=Canvas.Calculate3DPosition(APos,tmpBottom,Width3D+BackWall.Size);
    end;

    result:=TeeCull(P);
  end;
end;

Function TCustomChart.DrawRightWallAfter:Boolean;
begin
  result:=not DrawWallFirst(ChartRect.Right);
end;

Function TCustomChart.DrawLeftWallFirst:Boolean;
begin
  result:=DrawWallFirst(ChartRect.Left);
end;

type
  TChartAxisAccess=class(TChartAxis);
  TCanvasAccess=class(TCanvas3D);

procedure TCustomChart.DrawTitlesAndLegend(BeforeSeries:Boolean);

  Procedure DrawAxisAfter(Axis:TChartAxis);
  begin
    if IsAxisVisible(Axis) then
    begin
      TChartAxisAccess(Axis).IHideBackGrid:=True;
      Axis.Draw(False);
      TChartAxisAccess(Axis).IHideBackGrid:=False;
    end;
  end;

  Procedure DrawAxisGridAfter(Axis:TChartAxis);
  begin
    if IsAxisVisible(Axis) then
    begin
      TChartAxisAccess(Axis).IHideSideGrid:=True;
      TChartAxisAccess(Axis).DrawGrids(Length(Axis.Tick));
      TChartAxisAccess(Axis).IHideSideGrid:=False;
    end;
  end;

  Procedure DrawTitleFoot(CustomOnly:Boolean);

    Procedure DoDrawTitle(ATitle:TChartTitle; const TitleID:String);
    begin
      if ATitle.CustomPosition=CustomOnly then
      begin
        TCanvasAccess(Canvas).BeginEntity(TitleID);

        ATitle.DrawTitle;

        TCanvasAccess(Canvas).EndEntity;
      end;
    end;

  begin
    DoDrawTitle(FTitle,'title');
    DoDrawTitle(FSubTitle,'subtitle');
    DoDrawTitle(FFoot,'foot');
    DoDrawTitle(FSubFoot,'subfoot');
  end;

  { draw title and foot, or draw foot and title, depending
    if legend is at left/right or at top/bottom. }
  { top/bottom legends need to leave space for the title and foot
    before they get displayed.  }
  { If the Legend.CustomPosition is True, then draw the Legend AFTER
    all Series and Axes (on top of chart) }
begin
  Canvas.FrontPlaneBegin;

  if BeforeSeries then
  begin { draw titles and legend before series }
    if (not Legend.CustomPosition) and Legend.ShouldDraw then
    begin
      if Legend.Ve