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

git-svn-id: trunk@55451 -

components/tachart/demo/html/main.lfm

@@ -10,23 +10,23 @@ object MainForm: TMainForm
   LCLVersion = '1.9.0.0'
   object BottomPanel: TPanel
     Left = 8
-    Height = 91
+    Height = 105
-    Top = 353
+    Top = 339
-    Width = 647
+    Width = 639
     Align = alBottom
     AutoSize = True
     BorderSpacing.Left = 8
-    BorderSpacing.Top = 8
+    BorderSpacing.Right = 8
     BorderSpacing.Bottom = 8
     BevelOuter = bvNone
-    ClientHeight = 91
+    ClientHeight = 105
-    ClientWidth = 647
+    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.Control = CbRotateXLabels
-      AnchorSideTop.Side = asrCenter
+      AnchorSideTop.Side = asrBottom
-      Left = 343
+      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

components/tachart/demo/html/main.pas

@@ -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 := 'Δα = ' + FormatFloat('0.00', ASender.Distance) + '°';
+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>';

components/tachart/tadatatools.pas

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

components/tachart/tadrawutils.pas

@@ -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;

components/tachart/tahtml.pas

@@ -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 := Point(FPos.X, FPos.Y+offs) - FRotPos;
-    p := RotatePoint(P, -FFontAngle) + FStartPos;
+    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;