Delphi Teechart，因标题更改而自动重新计算自定义标记区域

Delphi 10.1，VCL，带有嵌入式Teechart

我有一个区域序列，其标记通过代码移动到自定义位置。 更改标记标题内容时，黄色背景不会自动调整大小以适应新的标记内容。 我有一个工作，但它有闪烁，它不是优雅的。 我在寻找一个更好的办法

详情如下： 我在图表上放置了三个按钮，一个用于移动标记位置，第二个按钮用于添加第二个内容行以标记标题。第三个按钮是我的工作，以获得一个适当的大小。 系列创作：

procedure TForm2.FormCreate(Sender: TObject);
begin
  Chart1.View3D := false;
  Chart1.Axes.Bottom.SetMinMax(0,5);

  with Chart1.AddSeries(tAreaSeries) as tAreaSeries do
    begin
      AddXY(1, 10);                  // Two points AreaSeries
      AddXY(4, 10);
      Marks[1].Visible     := false; // Hide the other Mark, the default is true
      Marks.Visible        := true;  // Global Visibility for all Markers
      Chart1[0].Marks[0].Text.Text := 'First-line';
    end;
end;

按移动标记按钮代码：

procedure TForm2.btnMoveMarkClick(Sender: TObject);
begin
  Chart1[0].Marks.Positions[0].Custom := true;
  Chart1[0].Marks.Positions[0].Offset(point(50,70));
//  Chart1[0].Marks.Positions[0].LeftTop := point(150,200);  // It is moving the Mark but not drawing the line to Series point
  Chart1.Repaint; // It doesn't work without this Repaint
end;

将生成以下屏幕： 现在，按第2个按钮更改标记标题内容，如下所示：

procedure TForm2.btnChangeMarkContentClick(Sender: TObject);
begin
  Chart1[0].Marks[0].Text.Text := 'First-line'+#13+'Second-line';
end;

procedure TForm2.btnResizeMarkClick(Sender: TObject);
var
  LastPoint: tpoint;
begin
  LastPoint := Chart1[0].Marks.Positions[0].LeftTop;
  Chart1[0].Marks.Positions.Automatic(0);
  Chart1.Repaint;

  Chart1[0].Marks.Positions[0].Custom := true;
  Chart1.Repaint;
//  Chart1[0].Marks[0].MoveTo(LastPoint); // It doesn't work - Why?
  Chart1[0].Marks.Positions[0].LeftTop := LastPoint; // Better to use Offset
  Chart1.Repaint;
end;

type
  tCustomTextShapeAccess = class(tCustomTextShape); // Yeray: tCustomTextShapeAccess class to get access to the protected CalcBounds method

const
  tcaTopLeft = 0;
  tcaArrowTo = 1;

procedure TeeChart_ResizeCustomMark(aChart: tChart; aSeriesInx, aMarkInx, aAnchor: integer);
// Resize Custom Mark area shape. It is required after Title text modification
// aAnchor: tcaTopLeft(0), tcaArrowTo(1); Choose which point to keep
var
  aSeries: tChartSeries;
  aMark  : tMarksItem;
  aMarkPosision: tSeriesMarkPosition;
begin
  // Assignments for more readable code
  aSeries       := aChart[aSeriesInx];
  aMark         := aChart[aSeriesInx].Marks[aMarkInx];
  aMarkPosision := aSeries.Marks.Positions[aMarkInx];

  // Bounds Calculation of the new Mark. Yeray solution.
  tCustomTextShapeAccess(aMark).CalcBounds(aChart); // Yeray: tCustomTextShapeAccess class to get access to the protected CalcBounds method
  aMarkPosision.Height := aMark.Height;
  aMarkPosision.Width  := aMark.Width;

  // Set Mark position based on aAnchor
  case aAnchor of
    tcaTopLeft: // Keep LeftTop point. Set new ArrowTo point.
      begin
        aMarkPosision.ArrowTo.X := aMarkPosision.LeftTop.X + (aMarkPosision.Width div 2);
        if aSeries.CalcYPos(aMarkInx) > aMarkPosision.ArrowTo.Y then // Mark above Series point
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y + aMarkPosision.Height
        else
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y;
      end;
    else        // Set ArrowTo point. Set a New LeftTop point.
      begin
        aMarkPosision.LeftTop.X := aMarkPosision.ArrowTo.X - (aMarkPosision.Width div 2);
        if aSeries.CalcYPos(aMarkInx) > aMarkPosision.ArrowTo.Y then // Mark above Series point
          aMarkPosision.LeftTop.Y := aMarkPosision.ArrowTo.Y - (aMarkPosision.Height -1)
        else                                                         // Mark below Series point
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y;
      end;
  end; // case

  aChart.Repaint;
end;

如您所见，黄色背景大小未更改：

我的强力解决方案是删除自定义位置，这将调整标记的大小，然后重新定位标记，如下所示：

procedure TForm2.btnChangeMarkContentClick(Sender: TObject);
begin
  Chart1[0].Marks[0].Text.Text := 'First-line'+#13+'Second-line';
end;

procedure TForm2.btnResizeMarkClick(Sender: TObject);
var
  LastPoint: tpoint;
begin
  LastPoint := Chart1[0].Marks.Positions[0].LeftTop;
  Chart1[0].Marks.Positions.Automatic(0);
  Chart1.Repaint;

  Chart1[0].Marks.Positions[0].Custom := true;
  Chart1.Repaint;
//  Chart1[0].Marks[0].MoveTo(LastPoint); // It doesn't work - Why?
  Chart1[0].Marks.Positions[0].LeftTop := LastPoint; // Better to use Offset
  Chart1.Repaint;
end;

type
  tCustomTextShapeAccess = class(tCustomTextShape); // Yeray: tCustomTextShapeAccess class to get access to the protected CalcBounds method

const
  tcaTopLeft = 0;
  tcaArrowTo = 1;

procedure TeeChart_ResizeCustomMark(aChart: tChart; aSeriesInx, aMarkInx, aAnchor: integer);
// Resize Custom Mark area shape. It is required after Title text modification
// aAnchor: tcaTopLeft(0), tcaArrowTo(1); Choose which point to keep
var
  aSeries: tChartSeries;
  aMark  : tMarksItem;
  aMarkPosision: tSeriesMarkPosition;
begin
  // Assignments for more readable code
  aSeries       := aChart[aSeriesInx];
  aMark         := aChart[aSeriesInx].Marks[aMarkInx];
  aMarkPosision := aSeries.Marks.Positions[aMarkInx];

  // Bounds Calculation of the new Mark. Yeray solution.
  tCustomTextShapeAccess(aMark).CalcBounds(aChart); // Yeray: tCustomTextShapeAccess class to get access to the protected CalcBounds method
  aMarkPosision.Height := aMark.Height;
  aMarkPosision.Width  := aMark.Width;

  // Set Mark position based on aAnchor
  case aAnchor of
    tcaTopLeft: // Keep LeftTop point. Set new ArrowTo point.
      begin
        aMarkPosision.ArrowTo.X := aMarkPosision.LeftTop.X + (aMarkPosision.Width div 2);
        if aSeries.CalcYPos(aMarkInx) > aMarkPosision.ArrowTo.Y then // Mark above Series point
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y + aMarkPosision.Height
        else
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y;
      end;
    else        // Set ArrowTo point. Set a New LeftTop point.
      begin
        aMarkPosision.LeftTop.X := aMarkPosision.ArrowTo.X - (aMarkPosision.Width div 2);
        if aSeries.CalcYPos(aMarkInx) > aMarkPosision.ArrowTo.Y then // Mark above Series point
          aMarkPosision.LeftTop.Y := aMarkPosision.ArrowTo.Y - (aMarkPosision.Height -1)
        else                                                         // Mark below Series point
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y;
      end;
  end; // case

  aChart.Repaint;
end;

它正在执行任务，但由于标记移动而闪烁，如下所示：

感谢您提供有关如何调整标记大小而不删除导致闪烁的自定义位置的任何提示。

---

重新启动

您可以重新计算标记边界，并将宽度和高度指定给相应的位置：

  TCustomTextShapeAccess(Chart1[0].Marks[0]).CalcBounds(Chart1);
  Chart1[0].Marks.Positions[0].Height:=Chart1[0].Marks[0].Height;
  Chart1[0].Marks.Positions[0].Width:=Chart1[0].Marks[0].Width;
  Chart1.Repaint;

注意：您必须声明TCustomTextShapeAccess类才能访问受保护的CalcBounds方法：

---

耶雷解决了主要问题。此外，还应按如下方式调整箭头：

procedure TForm2.btnChangeMarkContentClick(Sender: TObject);
begin
  Chart1[0].Marks[0].Text.Text := 'First-line'+#13+'Second-line';
end;

procedure TForm2.btnResizeMarkClick(Sender: TObject);
var
  LastPoint: tpoint;
begin
  LastPoint := Chart1[0].Marks.Positions[0].LeftTop;
  Chart1[0].Marks.Positions.Automatic(0);
  Chart1.Repaint;

  Chart1[0].Marks.Positions[0].Custom := true;
  Chart1.Repaint;
//  Chart1[0].Marks[0].MoveTo(LastPoint); // It doesn't work - Why?
  Chart1[0].Marks.Positions[0].LeftTop := LastPoint; // Better to use Offset
  Chart1.Repaint;
end;

type
  tCustomTextShapeAccess = class(tCustomTextShape); // Yeray: tCustomTextShapeAccess class to get access to the protected CalcBounds method

const
  tcaTopLeft = 0;
  tcaArrowTo = 1;

procedure TeeChart_ResizeCustomMark(aChart: tChart; aSeriesInx, aMarkInx, aAnchor: integer);
// Resize Custom Mark area shape. It is required after Title text modification
// aAnchor: tcaTopLeft(0), tcaArrowTo(1); Choose which point to keep
var
  aSeries: tChartSeries;
  aMark  : tMarksItem;
  aMarkPosision: tSeriesMarkPosition;
begin
  // Assignments for more readable code
  aSeries       := aChart[aSeriesInx];
  aMark         := aChart[aSeriesInx].Marks[aMarkInx];
  aMarkPosision := aSeries.Marks.Positions[aMarkInx];

  // Bounds Calculation of the new Mark. Yeray solution.
  tCustomTextShapeAccess(aMark).CalcBounds(aChart); // Yeray: tCustomTextShapeAccess class to get access to the protected CalcBounds method
  aMarkPosision.Height := aMark.Height;
  aMarkPosision.Width  := aMark.Width;

  // Set Mark position based on aAnchor
  case aAnchor of
    tcaTopLeft: // Keep LeftTop point. Set new ArrowTo point.
      begin
        aMarkPosision.ArrowTo.X := aMarkPosision.LeftTop.X + (aMarkPosision.Width div 2);
        if aSeries.CalcYPos(aMarkInx) > aMarkPosision.ArrowTo.Y then // Mark above Series point
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y + aMarkPosision.Height
        else
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y;
      end;
    else        // Set ArrowTo point. Set a New LeftTop point.
      begin
        aMarkPosision.LeftTop.X := aMarkPosision.ArrowTo.X - (aMarkPosision.Width div 2);
        if aSeries.CalcYPos(aMarkInx) > aMarkPosision.ArrowTo.Y then // Mark above Series point
          aMarkPosision.LeftTop.Y := aMarkPosision.ArrowTo.Y - (aMarkPosision.Height -1)
        else                                                         // Mark below Series point
          aMarkPosision.ArrowTo.Y := aMarkPosision.LeftTop.Y;
      end;
  end; // case

  aChart.Repaint;
end;

---

再次感谢耶雷。它解决标记区域更新问题，但不更新箭头。我找到了解决方案，并将其作为答案展示。