mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 02:43:39 +02:00
TAChart: Extract TADataTools unit
git-svn-id: trunk@38432 -
This commit is contained in:
ask
parent
4cf420b246
commit
ad680a75f4
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
for details about the copyright.
|
||||
"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="37">
|
||||
<Files Count="38">
|
||||
<Item1>
|
||||
<Filename Value="tagraph.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
@ -201,6 +201,10 @@
|
||||
<AddToUsesPkgSection Value="False"/>
|
||||
<UnitName Value="TAChartTeeChart"/>
|
||||
</Item37>
|
||||
<Item38>
|
||||
<Filename Value="tadatatools.pas"/>
|
||||
<UnitName Value="TADataTools"/>
|
||||
</Item38>
|
||||
</Files>
|
||||
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
417
components/tachart/tadatatools.pas
Normal file
417
components/tachart/tadatatools.pas
Normal file
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user