paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-17 21:30:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Allow html tags in display text of distance measurement tool.

Browse Source 
git-svn-id: trunk@55451 -
This commit is contained in:
wp 2017-07-05 13:46:07 +00:00
parent cde5b90623
commit 1ff61505bf
5 changed files with 97 additions and 25 deletions

83
components/tachart/demo/html/main.lfm
View File

@ -10,23 +10,23 @@ object MainForm: TMainForm
LCLVersion = '1.9.0.0'
object BottomPanel: TPanel
Left = 8
Height = 91
Top = 353
Width = 647
Height = 105
Top = 339
Width = 639
Align = alBottom
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
BevelOuter = bvNone
ClientHeight = 91
ClientWidth = 647
ClientHeight = 105
ClientWidth = 639
TabOrder = 0
object CgHTML: TCheckGroup
Left = 0
Height = 78
Top = 8
Width = 327
Width = 333
AutoFill = True
AutoSize = True
BorderSpacing.InnerBorder = 4
@ -40,7 +40,7 @@ object MainForm: TMainForm
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 4
ClientHeight = 58
ClientWidth = 323
ClientWidth = 329
Columns = 4
Items.Strings = (
'title'
@ -50,18 +50,19 @@ object MainForm: TMainForm
'x axis labels'
'x axis title'
'y axis title'
'distance tool'
)
OnItemClick = CgHTMLItemClick
TabOrder = 0
Data = {
0700000002020202020202
080000000202020202020202
}
end
object BtnCopyToClipboard: TButton
AnchorSideTop.Control = BottomPanel
AnchorSideRight.Control = BottomPanel
AnchorSideRight.Side = asrBottom
Left = 518
Left = 510
Height = 25
Top = 8
Width = 121
@ -79,7 +80,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnCopyToClipboard
AnchorSideRight.Side = asrBottom
Left = 518
Left = 510
Height = 25
Top = 37
Width = 121
@ -96,7 +97,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnCopyToClipboard
AnchorSideRight.Side = asrBottom
Left = 518
Left = 510
Height = 25
Top = 66
Width = 121
@ -110,22 +111,46 @@ object MainForm: TMainForm
object CbRTL: TCheckBox
AnchorSideLeft.Control = CgHTML
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnCopyToClipboard
AnchorSideTop.Side = asrCenter
Left = 343
AnchorSideTop.Control = CbRotateXLabels
AnchorSideTop.Side = asrBottom
Left = 349
Height = 19
Top = 11
Top = 38
Width = 86
BorderSpacing.Left = 16
BorderSpacing.Top = 8
Caption = 'Right-to-left'
OnChange = CbRTLChange
TabOrder = 4
Visible = False
end
object CbRotateXLabels: TCheckBox
AnchorSideTop.Control = BtnCopyToClipboard
AnchorSideTop.Side = asrCenter
Left = 349
Height = 19
Top = 11
Width = 131
Caption = 'Rotate x labels by 45°'
OnChange = CbRotateXLabelsChange
TabOrder = 5
end
object Label1: TLabel
AnchorSideLeft.Control = BottomPanel
AnchorSideTop.Control = CgHTML
AnchorSideTop.Side = asrBottom
Left = 0
Height = 15
Top = 90
Width = 305
BorderSpacing.Top = 4
Caption = 'Measure distance: drag with left mouse button held down'
ParentColor = False
end
end
object Chart: TChart
Left = 8
Height = 337
Height = 323
Top = 8
Width = 639
AxisList = <
@ -163,6 +188,8 @@ object MainForm: TMainForm
)
Foot.TextFormat = tfHTML
Foot.Visible = True
Legend.Alignment = laTopCenter
Legend.ColumnCount = 2
Legend.TextFormat = tfHTML
Legend.Visible = True
Title.Brush.Color = clBtnFace
@ -175,6 +202,7 @@ object MainForm: TMainForm
)
Title.TextFormat = tfHTML
Title.Visible = True
Toolset = ChartTools
Align = alClient
BorderSpacing.Around = 8
Color = clWhite
@ -184,7 +212,7 @@ object MainForm: TMainForm
Marks.LinkPen.Color = clGray
Marks.Style = smsLabel
Marks.TextFormat = tfHTML
Title = '<font color="red">Measured</font>'
Title = '<font color="red">Measured data points</font>'
LinePen.Color = clRed
LineType = ltNone
Pointer.Brush.Color = clRed
@ -209,4 +237,23 @@ object MainForm: TMainForm
left = 224
top = 153
end
object ChartTools: TChartToolset
left = 368
top = 88
object DistanceTool: TDataPointDistanceTool
Shift = [ssLeft]
DistanceMode = cdmOnlyX
DrawingMode = tdmNormal
Marks.Distance = 15
Marks.Format = '%0:.9g'
Marks.Frame.Color = clTeal
Marks.LabelBrush.Color = clMoneyGreen
Marks.LinkPen.Color = clSilver
Marks.LinkPen.Visible = False
Marks.TextFormat = tfHTML
MeasureMode = cdmOnlyX
Options = [dpdoLabelAbove]
OnGetDistanceText = DistanceToolGetDistanceText
end
end
end

26
components/tachart/demo/html/main.pas
View File

@ -6,7 +6,8 @@ interface
uses
Classes, SysUtils, FileUtil, TAGraph, TASeries, TASources, Forms, Controls,
Graphics, Dialogs, ExtCtrls, StdCtrls, TAChartAxisUtils, TAFuncSeries;
Graphics, Dialogs, ExtCtrls, StdCtrls, TAChartAxisUtils, TAFuncSeries,
TATools, TADataTools;
type
@ -19,7 +20,11 @@ type
Chart: TChart;
CgHTML: TCheckGroup;
CbRTL: TCheckBox;
ChartTools: TChartToolset;
CbRotateXLabels: TCheckBox;
DistanceTool: TDataPointDistanceTool;
FitSeries: TFitSeries;
Label1: TLabel;
ListChartSource: TListChartSource;
DataSeries: TLineSeries;
BottomPanel: TPanel;
@ -27,9 +32,12 @@ type
procedure BtnCopyToClipboardClick(Sender: TObject);
procedure BtnSaveWMFClick(Sender: TObject);
procedure BtnSaveSVGClick(Sender: TObject);
procedure CbRotateXLabelsChange(Sender: TObject);
procedure CgHTMLItemClick(Sender: TObject; Index: integer);
procedure ChartAxisList1MarkToText(var AText: String; AMark: Double);
procedure CbRTLChange(Sender: TObject);
procedure DistanceToolGetDistanceText(ASender: TDataPointDistanceTool;
var AText: String);
procedure FitSeriesFitComplete(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -66,6 +74,14 @@ begin
{$ENDIF}
end;
procedure TMainForm.CbRotateXLabelsChange(Sender: TObject);
begin
if CbRotateXLabels.Checked then
Chart.BottomAxis.Marks.LabelFont.Orientation := 450
else
Chart.BottomAxis.Marks.LabelFont.Orientation := 0;
end;
procedure TMainForm.BtnSaveSVGClick(Sender: TObject);
begin
Chart.SaveToSVGFile('test.svg');
@ -85,6 +101,7 @@ begin
4: Chart.BottomAxis.Marks.TextFormat := tf;
5: Chart.BottomAxis.Title.TextFormat := tf;
6: Chart.LeftAxis.Title.TextFormat := tf;
7: DistanceTool.Marks.TextFormat := tf;
end;
end;
@ -129,6 +146,12 @@ begin
FitSeries.Source := ListChartSource_Fit;
end;
procedure TMainForm.DistanceToolGetDistanceText(
ASender: TDataPointDistanceTool; var AText: String);
begin
AText := '&Delta;&alpha; = ' + FormatFloat('0.00', ASender.Distance) + '&deg;';
end;
procedure TMainForm.FitSeriesFitComplete(Sender: TObject);
var
p: Array of Double;
@ -160,6 +183,7 @@ begin
CgHTML.Checked[4] := Chart.BottomAxis.Marks.TextFormat = tfNormal;
CgHTML.Checked[5] := Chart.BottomAxis.Title.TextFormat = tfNormal;
CgHTML.Checked[6] := Chart.LeftAxis.Title.TextFormat = tfNormal;
CgHTML.Checked[7] := DistanceTool.Marks.TextFormat = tfNormal;
{$IFDEF WINDOWS}
Chart.Foot.Text[1] := '<font name="Times New Roman" color="gray">' + Chart.Foot.Text[1] + '</font>';

1
components/tachart/tadatatools.pas
View File

@ -41,6 +41,7 @@ type
property Frame;
property LabelBrush;
property LinkPen;
property TextFormat;
end;
TDataPointDistanceTool = class(TDataPointDrawTool)

2
components/tachart/tadrawutils.pas
View File

@ -66,7 +66,7 @@ type
TScaleItems = set of TScaleItem;
IChartDrawer = interface
['{6D8E5591-6788-4D2D-9FE6-596D5157C3C3}']
['{6D8E5591-6788-4D2D-9FE6-596D5157C3C3}']
procedure AddToFontOrientation(ADelta: Integer);
procedure ClippingStart(const AClipRect: TRect);
procedure ClippingStart;

10
components/tachart/tahtml.pas
View File

@ -24,7 +24,7 @@ type
FDrawer: IChartDrawer;
FSize: TPoint;
FPos: TPoint;
FStartPos: TPoint;
FRotPos: TPoint;
FCurrentFont: TFPCustomFont;
FSavedFont: TFPCustomFont;
FFontAngle: Double;
@ -682,15 +682,15 @@ begin
offs := (h * SUB_OFFSET_MULTIPLIER) div SUBSUP_DIVISOR
else
offs := (h * SUP_OFFSET_MULTIPLIER) div SUBSUP_DIVISOR; // this is negative
P := Point(FPos.X, FPos.Y+offs) - FStartPos;
p := RotatePoint(P, -FFontAngle) + FStartPos;
P := Point(FPos.X, FPos.Y+offs) - FRotPos;
p := RotatePoint(P, -FFontAngle) + FRotPos;
FDrawer.TextOut.TextFormat(tfNormal).Pos(P).Text(s).Done;
FCurrentFont.Size := oldFontSize;
end else
begin
FDrawer.SetFont(FCurrentFont);
w := FDrawer.TextExtent(s, tfNormal).X; // tfNormal is correct
p := RotatePoint(FPos - FStartPos, -FFontAngle) + FStartPos;
p := RotatePoint(FPos - FRotPos, -FFontAngle) + FRotPos;
FDrawer.TextOut.TextFormat(tfNormal).Pos(P).Text(s).Done;
end;
inc(FPos.X, w);
@ -789,8 +789,8 @@ var
parser: THTMLParser;
begin
Init;
FRotPos := Point(AX, AY);
FPos := Point(AX, AY);
FStartPos := FPos;
parser := THTMLParser.Create('<p>' + AText + '</p>');
try
parser.OnFoundTag := @HTMLTagFound;