diff --git a/.gitattributes b/.gitattributes
index 7825d23000..14f1617bcb 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -3017,6 +3017,7 @@ components/tachart/tachartwmf.lpk svneol=native#text/plain
components/tachart/tachartwmf.pas svneol=native#text/pascal
components/tachart/tacustomseries.pas svneol=native#text/plain
components/tachart/tacustomsource.pas svneol=native#text/pascal
+components/tachart/tadatatools.pas svneol=native#text/pascal
components/tachart/tadbsource.pas svneol=native#text/pascal
components/tachart/tadraweraggpas.pas svneol=native#text/pascal
components/tachart/tadrawerbgra.pas svneol=native#text/pascal
diff --git a/components/tachart/tachartlazaruspkg.lpk b/components/tachart/tachartlazaruspkg.lpk
index 6579c15daf..20e43818c4 100644
--- a/components/tachart/tachartlazaruspkg.lpk
+++ b/components/tachart/tachartlazaruspkg.lpk
@@ -34,7 +34,7 @@
for details about the copyright.
"/>
-
+
@@ -201,6 +201,10 @@
+
+
+
+
diff --git a/components/tachart/tachartlazaruspkg.pas b/components/tachart/tachartlazaruspkg.pas
index 071ab79e58..263d13beb4 100644
--- a/components/tachart/tachartlazaruspkg.pas
+++ b/components/tachart/tachartlazaruspkg.pas
@@ -13,7 +13,7 @@ uses
TALegendPanel, TARadialSeries, TACustomSource, TAGeometry, TANavigation,
TADrawerCanvas, TADrawerSVG, TAIntervalSources, TAChartAxisUtils,
TAChartListbox, TAEnumerators, TADataPointsEditor, TAChartExtentLink,
- TAToolEditors, TAMath, TAChartImageList, LazarusPackageIntf;
+ TAToolEditors, TAMath, TAChartImageList, TADataTools, LazarusPackageIntf;
implementation
diff --git a/components/tachart/tadatatools.pas b/components/tachart/tadatatools.pas
new file mode 100644
index 0000000000..302e3fbde1
--- /dev/null
+++ b/components/tachart/tadatatools.pas
@@ -0,0 +1,417 @@
+{
+
+ *****************************************************************************
+ * *
+ * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
+ * for details about the copyright. *
+ * *
+ * This program is distributed in the hope that it will be useful, *
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of *
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
+ * *
+ *****************************************************************************
+
+Authors: Alexander Klenin
+
+}
+
+unit TADataTools;
+
+{$H+}
+
+interface
+
+uses
+ Classes, TAChartUtils, TAGraph, TATools, TATypes;
+
+type
+ TDataPointDistanceTool = class;
+
+ TDataPointDistanceToolMeasureEvent =
+ procedure (ASender: TDataPointDistanceTool) of object;
+ TDataPointGetDistanceTextEvent =
+ procedure (ASender: TDataPointDistanceTool; var AText: String) of object;
+
+ TDataPointDistanceToolPointer = class(TSeriesPointer)
+ published
+ property Style default psVertBar;
+ end;
+
+ TDataPointDistanceToolMarks = class(TCustomChartMarks)
+ public
+ procedure Assign(ASource: TPersistent); override;
+ constructor Create(AOwner: TCustomChart);
+ published
+ property Distance default DEF_MARKS_DISTANCE;
+ property Format;
+ property Frame;
+ property LabelBrush;
+ property LinkPen;
+ end;
+
+
+ TDataPointDistanceTool = class(TDataPointDrawTool)
+ published
+ type
+ TOptions = set of (dpdoLockToData);
+
+ strict private
+ // Workaround for FPC 2.6 bug. Remove after migration to 2.8.
+ FAnchors: array of TObject;
+ FMarks: TDataPointDistanceToolMarks;
+ FMeasureMode: TChartDistanceMode;
+ FOnGetDistanceText: TDataPointGetDistanceTextEvent;
+ FOnMeasure: TDataPointDistanceToolMeasureEvent;
+ FOptions: TOptions;
+ FPointerEnd: TDataPointDistanceToolPointer;
+ FPointerStart: TDataPointDistanceToolPointer;
+ function GetPointEnd: TDataPointTool.TPointRef; inline;
+ function GetPointStart: TDataPointTool.TPointRef;
+ procedure SetMarks(AValue: TDataPointDistanceToolMarks);
+ procedure SetOptions(AValue: TOptions);
+ procedure SetPointerEnd(AValue: TDataPointDistanceToolPointer);
+ procedure SetPointerStart(AValue: TDataPointDistanceToolPointer);
+
+ strict protected
+ procedure DoDraw; override;
+ function FindRef(APoint: TPoint; ADest: TDataPointTool.TPointRef): Boolean;
+ function GetDistanceText: String;
+ function SameTransformations(ASeries1, ASeries2: TBasicChartSeries): Boolean;
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Distance(AUnits: TChartUnits = cuGraph): Double;
+ procedure KeyDown(APoint: TPoint); override;
+ procedure KeyUp(APoint: TPoint); override;
+ procedure MouseDown(APoint: TPoint); override;
+ procedure MouseMove(APoint: TPoint); override;
+ procedure MouseUp(APoint: TPoint); override;
+ property PointEnd: TDataPointTool.TPointRef read GetPointEnd;
+ property PointStart: TDataPointTool.TPointRef read GetPointStart;
+
+ published
+ property DrawingMode;
+ property GrabRadius default 20;
+ property LinePen: TChartPen read FPen write SetPen;
+ property Marks: TDataPointDistanceToolMarks read FMarks write SetMarks;
+ property MeasureMode: TChartDistanceMode
+ read FMeasureMode write FMeasureMode default cdmXY;
+ property Options: TOptions read FOptions write SetOptions default [];
+ property PointerEnd: TDataPointDistanceToolPointer
+ read FPointerEnd write SetPointerEnd;
+ property PointerStart: TDataPointDistanceToolPointer
+ read FPointerStart write SetPointerStart;
+ published
+ property OnGetDistanceText: TDataPointGetDistanceTextEvent
+ read FOnGetDistanceText write FOnGetDistanceText;
+ property OnMeasure: TDataPointDistanceToolMeasureEvent
+ read FOnMeasure write FOnMeasure;
+ end;
+
+
+implementation
+
+uses
+ FPCanvas, Graphics, GraphMath, LCLIntf, LCLType, Math, SysUtils, Types,
+ TAChartAxis, TACustomSeries, TAGeometry;
+
+const
+ DEF_DISTANCE_FORMAT = '%0:.9g';
+
+{ TDataPointDistanceToolMarks }
+
+procedure TDataPointDistanceToolMarks.Assign(ASource: TPersistent);
+begin
+ if ASource is TChartMarks then
+ with TDataPointDistanceToolMarks(ASource) do begin
+ Self.FLabelBrush.Assign(FLabelBrush);
+ Self.FLabelFont.Assign(FLabelFont);
+ Self.FLinkPen.Assign(FLinkPen);
+ end;
+ inherited Assign(ASource);
+end;
+
+constructor TDataPointDistanceToolMarks.Create(AOwner: TCustomChart);
+begin
+ inherited Create(AOwner);
+ FDistance := DEF_MARKS_DISTANCE;
+ FLabelBrush.Color := clYellow;
+ Format := DEF_DISTANCE_FORMAT;
+end;
+
+{ TDataPointDistanceTool }
+
+constructor TDataPointDistanceTool.Create(AOwner: TComponent);
+begin
+ inherited;
+ SetLength(FAnchors, 2);
+ FAnchors[0] := TDataPointTool.TPointRef.Create;
+ FAnchors[1] := TDataPointTool.TPointRef.Create;
+ FMarks := TDataPointDistanceToolMarks.Create(nil);
+ FPointerEnd := TDataPointDistanceToolPointer.Create(nil);
+ FPointerStart := TDataPointDistanceToolPointer.Create(nil);
+end;
+
+destructor TDataPointDistanceTool.Destroy;
+begin
+ FAnchors[0].Free;
+ FAnchors[1].Free;
+ FreeAndNil(FMarks);
+ FreeAndNil(FPointerEnd);
+ FreeAndNil(FPointerStart);
+ inherited;
+end;
+
+function TDataPointDistanceTool.Distance(AUnits: TChartUnits): Double;
+var
+ p1, p2: TDoublePoint;
+begin
+ case AUnits of
+ cuPercent: exit(0); // Not implemented.
+ cuAxis: begin
+ p1 := PointStart.AxisPos;
+ p2 := PointEnd.AxisPos;
+ end;
+ cuGraph: begin
+ p1 := PointStart.GraphPos;
+ p2 := PointEnd.GraphPos;
+ end;
+ cuPixel: begin
+ with FChart.GraphToImage(PointStart.GraphPos) do
+ p1 := DoublePoint(X, Y);
+ with FChart.GraphToImage(PointEnd.GraphPos) do
+ p2 := DoublePoint(X, Y);
+ end;
+ end;
+ case MeasureMode of
+ cdmOnlyX: Result := Abs(p1.X - p2.X);
+ cdmOnlyY: Result := Abs(p1.Y - p2.Y);
+ // The user is responsible for ensuring that both axes have
+ // the same physical dimensions: the xy distance is not
+ // meaningful, for example, if x is in days and y in Dollars.
+ cdmXY: Result := Norm([p1.X - p2.X, p1.Y - p2.Y]);
+ end;
+end;
+
+procedure TDataPointDistanceTool.DoDraw;
+
+ procedure DrawXorText(ACanvas: TCanvas; APoint: TPoint; const AText: String);
+ var
+ bmp: TBitmap;
+ ext: TSize;
+ begin
+ ext := ACanvas.TextExtent(AText);
+ bmp := TBitmap.Create;
+ try
+ bmp.SetSize(ext.cx, ext.cy);
+ bmp.Canvas.Brush.Style := bsClear;
+ bmp.Canvas.Font := ACanvas.Font;
+ bmp.Canvas.Font.Color := clWhite;
+ bmp.Canvas.TextOut(0, 0, AText);
+ APoint -= ext div 2;
+ BitBlt(
+ ACanvas.Handle, APoint.X, APoint.Y, ext.cx, ext.cy,
+ bmp.Canvas.Handle, 0, 0, SRCINVERT);
+ finally
+ bmp.Free;
+ end;
+ end;
+
+var
+ a: Double;
+
+ procedure DrawPointer(APointer: TDataPointDistanceToolPointer; APos: TPoint);
+ var
+ oldMode: TFPPenMode;
+ oldColor: TColor;
+ oldStyle: TFPBrushStyle;
+ begin
+ with APointer do begin
+ if not Visible then exit;
+ if EffectiveDrawingMode = tdmXor then begin
+ oldMode := Pen.Mode;
+ oldColor := Pen.Color;
+ oldStyle := Brush.Style;
+ Pen.Mode := pmXor;
+ Pen.Color := clWhite;
+ Brush.Style := bsClear;
+ end;
+ try
+ DrawSize(FChart.Drawer, APos, Point(HorizSize, VertSize), clTAColor, a);
+ finally
+ if EffectiveDrawingMode = tdmXor then begin
+ Pen.Mode := oldMode;
+ Pen.Color := oldColor;
+ Brush.Style := oldStyle;
+ end;
+ end;
+ end;
+ end;
+
+var
+ p1, p2: TPoint;
+ dummy: TPointArray = nil;
+begin
+ p1 := FChart.GraphToImage(PointStart.GraphPos);
+ p2 := FChart.GraphToImage(PointEnd.GraphPos);
+ case MeasureMode of
+ cdmOnlyX: p2.Y := p1.Y;
+ cdmOnlyY: p2.X := p1.X;
+ end;
+ if p1 = p2 then exit;
+ if LinePen.Visible then
+ FChart.Drawer.Line(p1, p2);
+ a := ArcTan2(p2.Y - p1.Y, p2.X - p1.X);
+ DrawPointer(PointerStart, p1);
+ DrawPointer(PointerEnd, p2);
+ if Marks.Visible then begin
+ p1 := (p1 + p2) div 2;
+ if EffectiveDrawingMode = tdmNormal then
+ Marks.DrawLabel(FChart.Drawer, p1, p1, GetDistanceText, dummy)
+ else
+ DrawXorText(FChart.Canvas, p1, GetDistanceText);
+ end;
+ inherited;
+end;
+
+function TDataPointDistanceTool.FindRef(
+ APoint: TPoint; ADest: TDataPointTool.TPointRef): Boolean;
+begin
+ if dpdoLockToData in Options then begin
+ FindNearestPoint(APoint);
+ if FSeries = nil then exit(false);
+ with ADest do begin
+ FGraphPos := FNearestGraphPoint;
+ FIndex := PointIndex;
+ FSeries := Self.FSeries;
+ end;
+ end
+ else
+ ADest.SetGraphPos(FChart.ImageToGraph(APoint));
+ Result := true;
+end;
+
+// Use Marks.Format and/or OnGetDistanceText event handler to create the text
+// to be displayed along the connecting line between PointStart and PointEnd.
+// OnGetDistanceText is useful for converting the distance, for example, to a
+// datetime string.
+function TDataPointDistanceTool.GetDistanceText: String;
+begin
+ Result := Format(Marks.Format, [Distance]);
+ if Assigned(OnGetDistanceText) then
+ OnGetDistanceText(Self, Result);
+end;
+
+function TDataPointDistanceTool.GetPointEnd: TDataPointTool.TPointRef;
+begin
+ Result := TDataPointTool.TPointRef(FAnchors[High(FAnchors)]);
+end;
+
+function TDataPointDistanceTool.GetPointStart: TDataPointTool.TPointRef;
+begin
+ Result := TDataPointTool.TPointRef(FAnchors[0]);
+end;
+
+procedure TDataPointDistanceTool.KeyDown(APoint: TPoint);
+begin
+ MouseDown(APoint);
+end;
+
+procedure TDataPointDistanceTool.KeyUp(APoint: TPoint);
+begin
+ MouseUp(APoint);
+end;
+
+procedure TDataPointDistanceTool.MouseDown(APoint: TPoint);
+begin
+ DoHide;
+ if not FindRef(APoint, PointStart) then exit;
+ Activate;
+ PointEnd.Assign(PointStart);
+ Handled;
+end;
+
+procedure TDataPointDistanceTool.MouseMove(APoint: TPoint);
+var
+ newEnd: TPointRef;
+begin
+ if not IsActive then exit;
+ DoHide;
+ newEnd := TPointRef.Create;
+ try
+ if
+ FindRef(APoint, newEnd) and
+ SameTransformations(PointStart.Series, newEnd.Series)
+ then
+ PointEnd.Assign(newEnd);
+ finally
+ FreeAndNil(newEnd);
+ end;
+ if EffectiveDrawingMode = tdmXor then
+ DoDraw;
+ Handled;
+end;
+
+procedure TDataPointDistanceTool.MouseUp(APoint: TPoint);
+begin
+ MouseMove(APoint);
+ if Assigned(OnMeasure) and (PointStart.GraphPos <> PointEnd.GraphPos) then
+ OnMeasure(Self);
+ Deactivate;
+end;
+
+function TDataPointDistanceTool.SameTransformations(
+ ASeries1, ASeries2: TBasicChartSeries): Boolean;
+
+ function CheckAxis(AAxisIndex1, AAxisIndex2: Integer): Boolean; inline;
+ begin
+ Result :=
+ TransformByAxis(FChart.AxisList, AAxisIndex1) =
+ TransformByAxis(FChart.AxisList, AAxisIndex2);
+ end;
+
+var
+ s1: TCustomChartSeries absolute ASeries1;
+ s2: TCustomChartSeries absolute ASeries2;
+begin
+ Result :=
+ (ASeries1 = ASeries2) or
+ (ASeries1 is TCustomChartSeries) and
+ (ASeries2 is TCustomChartSeries) and
+ ((MeasureMode = cdmOnlyY) or CheckAxis(s1.AxisIndexX, s2.AxisIndexX)) and
+ ((MeasureMode = cdmOnlyX) or CheckAxis(s1.AxisIndexY, s2.AxisIndexY));
+end;
+
+procedure TDataPointDistanceTool.SetMarks(AValue: TDataPointDistanceToolMarks);
+begin
+ if FMarks = AValue then exit;
+ FMarks.Assign(AValue);
+end;
+
+procedure TDataPointDistanceTool.SetOptions(AValue: TOptions);
+begin
+ if FOptions = AValue then exit;
+ FOptions := AValue;
+end;
+
+procedure TDataPointDistanceTool.SetPointerEnd(
+ AValue: TDataPointDistanceToolPointer);
+begin
+ if FPointerEnd = AValue then exit;
+ FPointerEnd.Assign(AValue);
+end;
+
+procedure TDataPointDistanceTool.SetPointerStart(
+ AValue: TDataPointDistanceToolPointer);
+begin
+ if FPointerStart = AValue then exit;
+ FPointerStart.Assign(AValue);
+end;
+
+initialization
+
+ RegisterChartToolClass(TDataPointDistanceTool, 'Distance measurement');
+
+end.
+
diff --git a/components/tachart/tatools.pas b/components/tachart/tatools.pas
index 96b9998f34..a93c2bda2f 100644
--- a/components/tachart/tatools.pas
+++ b/components/tachart/tatools.pas
@@ -345,8 +345,6 @@ type
TChartDistanceMode = (cdmXY, cdmOnlyX, cdmOnlyY);
- { TDataPointTool }
-
TDataPointTool = class(TChartTool)
public
type
@@ -511,87 +509,6 @@ type
property Size: Integer read FSize write FSize default -1;
end;
- TDataPointDistanceTool = class;
-
- TDataPointDistanceToolMeasureEvent =
- procedure (ASender: TDataPointDistanceTool) of object;
- TDataPointGetDistanceTextEvent =
- procedure (ASender: TDataPointDistanceTool; var AText: String) of object;
-
- TDataPointDistanceToolPointer = class(TSeriesPointer)
- published
- property Style default psVertBar;
- end;
-
- TDataPointDistanceToolMarks = class(TCustomChartMarks)
- public
- procedure Assign(ASource: TPersistent); override;
- constructor Create(AOwner: TCustomChart);
- published
- property Distance default DEF_MARKS_DISTANCE;
- property Format;
- property Frame;
- property LabelBrush;
- property LinkPen;
- end;
-
- TDataPointDistanceTool = class(TDataPointDrawTool)
- published
- type
- TOptions = set of (dpdoLockToData);
-
- strict private
- FAnchors: array of TDataPointTool.TPointRef;
- FMarks: TDataPointDistanceToolMarks;
- FMeasureMode: TChartDistanceMode;
- FOnGetDistanceText: TDataPointGetDistanceTextEvent;
- FOnMeasure: TDataPointDistanceToolMeasureEvent;
- FOptions: TOptions;
- FPointerEnd: TDataPointDistanceToolPointer;
- FPointerStart: TDataPointDistanceToolPointer;
- function GetPointEnd: TDataPointTool.TPointRef; inline;
- procedure SetMarks(AValue: TDataPointDistanceToolMarks);
- procedure SetOptions(AValue: TOptions);
- procedure SetPointerEnd(AValue: TDataPointDistanceToolPointer);
- procedure SetPointerStart(AValue: TDataPointDistanceToolPointer);
-
- strict protected
- procedure DoDraw; override;
- function FindRef(APoint: TPoint; ADest: TDataPointTool.TPointRef): Boolean;
- function GetDistanceText: String;
- function SameTransformations(ASeries1, ASeries2: TBasicChartSeries): Boolean;
-
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Distance(AUnits: TChartUnits = cuGraph): Double;
- procedure KeyDown(APoint: TPoint); override;
- procedure KeyUp(APoint: TPoint); override;
- procedure MouseDown(APoint: TPoint); override;
- procedure MouseMove(APoint: TPoint); override;
- procedure MouseUp(APoint: TPoint); override;
- property PointEnd: TDataPointTool.TPointRef read GetPointEnd;
- property PointStart: TDataPointTool.TPointRef read FAnchors[0];
-
- published
- property DrawingMode;
- property GrabRadius default 20;
- property LinePen: TChartPen read FPen write SetPen;
- property Marks: TDataPointDistanceToolMarks read FMarks write SetMarks;
- property MeasureMode: TChartDistanceMode
- read FMeasureMode write FMeasureMode default cdmXY;
- property Options: TOptions read FOptions write SetOptions default [];
- property PointerEnd: TDataPointDistanceToolPointer
- read FPointerEnd write SetPointerEnd;
- property PointerStart: TDataPointDistanceToolPointer
- read FPointerStart write SetPointerStart;
- published
- property OnGetDistanceText: TDataPointGetDistanceTextEvent
- read FOnGetDistanceText write FOnGetDistanceText;
- property OnMeasure: TDataPointDistanceToolMeasureEvent
- read FOnMeasure write FOnMeasure;
- end;
-
TReticuleTool = class(TChartTool)
public
procedure MouseMove(APoint: TPoint); override;
@@ -607,12 +524,9 @@ var
implementation
uses
- Graphics, GraphMath, InterfaceBase, LCLIntf, LCLType, Math, SysUtils,
+ GraphMath, InterfaceBase, Math, SysUtils,
TAChartAxis, TACustomSeries, TADrawerCanvas, TAEnumerators, TAGeometry, TAMath;
-const
- DEF_DISTANCE_FORMAT = '%0:.9g';
-
function InitBuiltinTools(AChart: TChart): TBasicChartToolset;
var
ts: TChartToolset;
@@ -642,27 +556,6 @@ begin
ToolsClassRegistry.AddObject(ACaption, TObject(AToolClass));
end;
-{ TDataPointDistanceToolMarks }
-
-procedure TDataPointDistanceToolMarks.Assign(ASource: TPersistent);
-begin
- if ASource is TChartMarks then
- with TDataPointDistanceToolMarks(ASource) do begin
- Self.FLabelBrush.Assign(FLabelBrush);
- Self.FLabelFont.Assign(FLabelFont);
- Self.FLinkPen.Assign(FLinkPen);
- end;
- inherited Assign(ASource);
-end;
-
-constructor TDataPointDistanceToolMarks.Create(AOwner: TCustomChart);
-begin
- inherited Create(AOwner);
- FDistance := DEF_MARKS_DISTANCE;
- FLabelBrush.Color := clYellow;
- Format := DEF_DISTANCE_FORMAT;
-end;
-
{ TDataPointTool.TPointRef }
procedure TDataPointTool.TPointRef.Assign(ASource: TPointRef);
@@ -1826,271 +1719,6 @@ begin
end;
end;
-
-{ TDataPointDistanceTool }
-
-constructor TDataPointDistanceTool.Create(AOwner: TComponent);
-begin
- inherited;
- SetLength(FAnchors, 2);
- FAnchors[0] := TDataPointTool.TPointRef.Create;
- FAnchors[1] := TDataPointTool.TPointRef.Create;
- FMarks := TDataPointDistanceToolMarks.Create(nil);
- FPointerEnd := TDataPointDistanceToolPointer.Create(nil);
- FPointerStart := TDataPointDistanceToolPointer.Create(nil);
-end;
-
-destructor TDataPointDistanceTool.Destroy;
-begin
- FAnchors[0].Free;
- FAnchors[1].Free;
- FreeAndNil(FMarks);
- FreeAndNil(FPointerEnd);
- FreeAndNil(FPointerStart);
- inherited;
-end;
-
-function TDataPointDistanceTool.Distance(AUnits: TChartUnits): Double;
-var
- p1, p2: TDoublePoint;
-begin
- case AUnits of
- cuPercent: exit(0); // Not implemented.
- cuAxis: begin
- p1 := PointStart.AxisPos;
- p2 := PointEnd.AxisPos;
- end;
- cuGraph: begin
- p1 := PointStart.GraphPos;
- p2 := PointEnd.GraphPos;
- end;
- cuPixel: begin
- with FChart.GraphToImage(PointStart.GraphPos) do
- p1 := DoublePoint(X, Y);
- with FChart.GraphToImage(PointEnd.GraphPos) do
- p2 := DoublePoint(X, Y);
- end;
- end;
- case MeasureMode of
- cdmOnlyX: Result := Abs(p1.X - p2.X);
- cdmOnlyY: Result := Abs(p1.Y - p2.Y);
- // The user is responsible for ensuring that both axes have
- // the same physical dimensions: the xy distance is not
- // meaningful, for example, if x is in days and y in Dollars.
- cdmXY: Result := Norm([p1.X - p2.X, p1.Y - p2.Y]);
- end;
-end;
-
-procedure TDataPointDistanceTool.DoDraw;
-
- procedure DrawXorText(ACanvas: TCanvas; APoint: TPoint; const AText: String);
- var
- bmp: TBitmap;
- ext: TSize;
- begin
- ext := ACanvas.TextExtent(AText);
- bmp := TBitmap.Create;
- try
- bmp.SetSize(ext.cx, ext.cy);
- bmp.Canvas.Brush.Style := bsClear;
- bmp.Canvas.Font := ACanvas.Font;
- bmp.Canvas.Font.Color := clWhite;
- bmp.Canvas.TextOut(0, 0, AText);
- APoint -= ext div 2;
- BitBlt(
- ACanvas.Handle, APoint.X, APoint.Y, ext.cx, ext.cy,
- bmp.Canvas.Handle, 0, 0, SRCINVERT);
- finally
- bmp.Free;
- end;
- end;
-
-var
- a: Double;
-
- procedure DrawPointer(APointer: TDataPointDistanceToolPointer; APos: TPoint);
- var
- oldMode: TFPPenMode;
- oldColor: TColor;
- oldStyle: TFPBrushStyle;
- begin
- with APointer do begin
- if not Visible then exit;
- if EffectiveDrawingMode = tdmXor then begin
- oldMode := Pen.Mode;
- oldColor := Pen.Color;
- oldStyle := Brush.Style;
- Pen.Mode := pmXor;
- Pen.Color := clWhite;
- Brush.Style := bsClear;
- end;
- try
- DrawSize(FChart.Drawer, APos, Point(HorizSize, VertSize), clTAColor, a);
- finally
- if EffectiveDrawingMode = tdmXor then begin
- Pen.Mode := oldMode;
- Pen.Color := oldColor;
- Brush.Style := oldStyle;
- end;
- end;
- end;
- end;
-
-var
- p1, p2: TPoint;
- dummy: TPointArray = nil;
-begin
- p1 := FChart.GraphToImage(PointStart.GraphPos);
- p2 := FChart.GraphToImage(PointEnd.GraphPos);
- case MeasureMode of
- cdmOnlyX: p2.Y := p1.Y;
- cdmOnlyY: p2.X := p1.X;
- end;
- if p1 = p2 then exit;
- if LinePen.Visible then
- FChart.Drawer.Line(p1, p2);
- a := ArcTan2(p2.Y - p1.Y, p2.X - p1.X);
- DrawPointer(PointerStart, p1);
- DrawPointer(PointerEnd, p2);
- if Marks.Visible then begin
- p1 := (p1 + p2) div 2;
- if EffectiveDrawingMode = tdmNormal then
- Marks.DrawLabel(FChart.Drawer, p1, p1, GetDistanceText, dummy)
- else
- DrawXorText(FChart.Canvas, p1, GetDistanceText);
- end;
- inherited;
-end;
-
-function TDataPointDistanceTool.FindRef(
- APoint: TPoint; ADest: TDataPointTool.TPointRef): Boolean;
-begin
- if dpdoLockToData in Options then begin
- FindNearestPoint(APoint);
- if FSeries = nil then exit(false);
- with ADest do begin
- FGraphPos := FNearestGraphPoint;
- FIndex := PointIndex;
- FSeries := Self.FSeries;
- end;
- end
- else
- ADest.SetGraphPos(FChart.ImageToGraph(APoint));
- Result := true;
-end;
-
-// Use Marks.Format and/or OnGetDistanceText event handler to create the text
-// to be displayed along the connecting line between PointStart and PointEnd.
-// OnGetDistanceText is useful for converting the distance, for example, to a
-// datetime string.
-function TDataPointDistanceTool.GetDistanceText: String;
-begin
- Result := Format(Marks.Format, [Distance]);
- if Assigned(OnGetDistanceText) then
- OnGetDistanceText(Self, Result);
-end;
-
-function TDataPointDistanceTool.GetPointEnd: TDataPointTool.TPointRef;
-begin
- Result := FAnchors[High(FAnchors)];
-end;
-
-procedure TDataPointDistanceTool.KeyDown(APoint: TPoint);
-begin
- MouseDown(APoint);
-end;
-
-procedure TDataPointDistanceTool.KeyUp(APoint: TPoint);
-begin
- MouseUp(APoint);
-end;
-
-procedure TDataPointDistanceTool.MouseDown(APoint: TPoint);
-begin
- DoHide;
- if not FindRef(APoint, PointStart) then exit;
- Activate;
- PointEnd.Assign(PointStart);
- Handled;
-end;
-
-procedure TDataPointDistanceTool.MouseMove(APoint: TPoint);
-var
- newEnd: TPointRef;
-begin
- if not IsActive then exit;
- DoHide;
- newEnd := TPointRef.Create;
- try
- if
- FindRef(APoint, newEnd) and
- SameTransformations(PointStart.Series, newEnd.Series)
- then
- PointEnd.Assign(newEnd);
- finally
- FreeAndNil(newEnd);
- end;
- if EffectiveDrawingMode = tdmXor then
- DoDraw;
- Handled;
-end;
-
-procedure TDataPointDistanceTool.MouseUp(APoint: TPoint);
-begin
- MouseMove(APoint);
- if Assigned(OnMeasure) and (PointStart.GraphPos <> PointEnd.GraphPos) then
- OnMeasure(Self);
- Deactivate;
-end;
-
-function TDataPointDistanceTool.SameTransformations(
- ASeries1, ASeries2: TBasicChartSeries): Boolean;
-
- function CheckAxis(AAxisIndex1, AAxisIndex2: Integer): Boolean; inline;
- begin
- Result :=
- TransformByAxis(FChart.AxisList, AAxisIndex1) =
- TransformByAxis(FChart.AxisList, AAxisIndex2);
- end;
-
-var
- s1: TCustomChartSeries absolute ASeries1;
- s2: TCustomChartSeries absolute ASeries2;
-begin
- Result :=
- (ASeries1 = ASeries2) or
- (ASeries1 is TCustomChartSeries) and
- (ASeries2 is TCustomChartSeries) and
- ((MeasureMode = cdmOnlyY) or CheckAxis(s1.AxisIndexX, s2.AxisIndexX)) and
- ((MeasureMode = cdmOnlyX) or CheckAxis(s1.AxisIndexY, s2.AxisIndexY));
-end;
-
-procedure TDataPointDistanceTool.SetMarks(AValue: TDataPointDistanceToolMarks);
-begin
- if FMarks = AValue then exit;
- FMarks.Assign(AValue);
-end;
-
-procedure TDataPointDistanceTool.SetOptions(AValue: TOptions);
-begin
- if FOptions = AValue then exit;
- FOptions := AValue;
-end;
-
-procedure TDataPointDistanceTool.SetPointerEnd(
- AValue: TDataPointDistanceToolPointer);
-begin
- if FPointerEnd = AValue then exit;
- FPointerEnd.Assign(AValue);
-end;
-
-procedure TDataPointDistanceTool.SetPointerStart(
- AValue: TDataPointDistanceToolPointer);
-begin
- if FPointerStart = AValue then exit;
- FPointerStart.Assign(AValue);
-end;
-
initialization
ToolsClassRegistry := TStringList.Create;
@@ -2106,7 +1734,6 @@ initialization
RegisterChartToolClass(TDataPointDragTool, 'Data point drag');
RegisterChartToolClass(TDataPointHintTool, 'Data point hint');
RegisterChartToolClass(TDataPointCrosshairTool, 'Data point crosshair');
- RegisterChartToolClass(TDataPointDistanceTool, 'Distance measurement');
RegisterChartToolClass(TUserDefinedTool, 'User-defined');
finalization