Teechart,由于标题更改而自动重新计算自定义标记区域
Teechart, automatic recalculation of a custom Mark Area due to title changes
Delphi 10.1,VCL,带有嵌入式 Teechart。
我有一个区域系列,其中的标记已通过代码移动到自定义位置。
当 Mark 标题内容更改时,黄色背景不会调整(自动调整大小)以适应新的 Mark 内容。
我有一个解决方法,但它有闪烁而且不优雅。
我正在寻找如何做得更好的想法。
详情:
我在图表上放置了三个按钮,一个用于移动标记位置,第二个按钮用于向标记标题添加第二个内容行。第三个按钮是我的工作,以获得合适的尺寸。
系列创作:
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;
会生成如下画面:
现在,按第二个按钮更改标记标题内容如下:
procedure TForm2.btnChangeMarkContentClick(Sender: TObject);
begin
Chart1[0].Marks[0].Text.Text := 'First-line'+#13+'Second-line';
end;
如您所见,黄色背景大小没有改变:
我的 brut-force 解决方法是删除自定义位置,这将调整标记的大小,然后再次重新定位标记,如下所示:
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;
可以正常工作,但由于标记移动会出现闪烁,如下:
感谢您提供任何提示如何在不删除其导致闪烁的自定义位置的情况下调整标记的大小。
雷伦
您可以重新计算标记边界并将Width
和Height
分配给相应的位置:
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
class 才能访问受保护的 CalcBounds
方法:
type TCustomTextShapeAccess=class(TCustomTextShape);
Yeray 解决了主要问题。另外,Arrows也要调整如下:
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;
Delphi 10.1,VCL,带有嵌入式 Teechart。
我有一个区域系列,其中的标记已通过代码移动到自定义位置。 当 Mark 标题内容更改时,黄色背景不会调整(自动调整大小)以适应新的 Mark 内容。 我有一个解决方法,但它有闪烁而且不优雅。 我正在寻找如何做得更好的想法。
详情: 我在图表上放置了三个按钮,一个用于移动标记位置,第二个按钮用于向标记标题添加第二个内容行。第三个按钮是我的工作,以获得合适的尺寸。 系列创作:
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;
会生成如下画面:
procedure TForm2.btnChangeMarkContentClick(Sender: TObject);
begin
Chart1[0].Marks[0].Text.Text := 'First-line'+#13+'Second-line';
end;
如您所见,黄色背景大小没有改变:
我的 brut-force 解决方法是删除自定义位置,这将调整标记的大小,然后再次重新定位标记,如下所示:
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;
可以正常工作,但由于标记移动会出现闪烁,如下:
感谢您提供任何提示如何在不删除其导致闪烁的自定义位置的情况下调整标记的大小。 雷伦
您可以重新计算标记边界并将Width
和Height
分配给相应的位置:
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
class 才能访问受保护的 CalcBounds
方法:
type TCustomTextShapeAccess=class(TCustomTextShape);
Yeray 解决了主要问题。另外,Arrows也要调整如下:
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;