TAChart: Initial implementation of TAxisClickTool.

git-svn-id: trunk@60795 -
This commit is contained in:
wp 2019-03-29 23:02:48 +00:00
parent 0ac9eca99f
commit 6a763b0115
19 changed files with 201 additions and 11 deletions

View File

@ -1,6 +1,5 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<fpdoc-descriptions><package name="TAChartLazarusPkg"><module name="TAChartAxisUtils"><element name="TChartBasicAxis"><short><var>TChartBasicAxis</var> is the ancestor of the chart's axis class</short><descr><p>The basic axis consists of</p> <fpdoc-descriptions><package name="TAChartLazarusPkg"><module name="TAChartAxisUtils"><element name="TChartBasicAxis"><short><var>TChartBasicAxis</var> is the ancestor of the chart's axis class</short><descr><p>The basic axis consists of</p><ul><li>ticks (short line strokes perpendicular to the axis direction)</li><li><link id="TChartBasicAxis.Marks">marks</link>, i.e. labels placed at the tick positions</li><li><link id="TChartBasicAxis.Grid">grid lines</link> starting at the tick positions and running across the entire chart</li><li>an optional <link id="TChartBasicAxis.Arrow">arrow</link> at the end of the axis line</li>
<ul><li>ticks (short line strokes perpendicular to the axis direction)</li><li><link id="TChartBasicAxis.Marks">marks</link>, i.e. labels placed at the tick positions</li><li><link id="TChartBasicAxis.Grid">grid lines</link> starting at the tick positions and running across the entire chart</li><li>an optional <link id="TChartBasicAxis.Arrow">arrow</link> at the end of the axis line</li>
</ul> </ul>
</descr><seealso><link id="TAChartAxis.TChartAxis"/> </descr><seealso><link id="TAChartAxis.TChartAxis"/>
</seealso> </seealso>

View File

@ -36,8 +36,7 @@
</element> </element>
<element name="TChartSeries.Clear"> <element name="TChartSeries.Clear">
<short>Remove all points from the series.</short> <short>Remove all points from the series.</short>
<descr> <descr><p>Requires <link id="TChartSeries.ListSource">editable data source</link>.</p>
<p>Requires <link id="TChartSeries.ListSource">editable data source</link>.</p>
</descr> </descr>
</element> </element>
<element name="TChartSeries.Delete"> <element name="TChartSeries.Delete">

View File

@ -61,6 +61,10 @@ msgstr "Fläche-Diagramm"
msgid "Auto scale" msgid "Auto scale"
msgstr "Auto-Skalierung" msgstr "Auto-Skalierung"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr "Klick auf Achse"
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Säulen/Balken-Diagramm" msgstr "Säulen/Balken-Diagramm"
@ -516,4 +520,3 @@ msgstr "Fehler beim Umbenennen von Komponenten: %s"
#: tachartstrconsts.tastoolseditortitle #: tachartstrconsts.tastoolseditortitle
msgid "Edit tools" msgid "Edit tools"
msgstr "Werkzeuge bearbeiten" msgstr "Werkzeuge bearbeiten"

View File

@ -49,6 +49,10 @@ msgstr "Aluekuvaaja"
msgid "Auto scale" msgid "Auto scale"
msgstr "Automaattinen skaalaus" msgstr "Automaattinen skaalaus"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Pylväskuvaaja" msgstr "Pylväskuvaaja"

View File

@ -59,6 +59,10 @@ msgstr "Séries de surfaces"
msgid "Auto scale" msgid "Auto scale"
msgstr "Échelle automatique" msgstr "Échelle automatique"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Séries de barres" msgstr "Séries de barres"

View File

@ -59,6 +59,10 @@ msgstr "Terület"
msgid "Auto scale" msgid "Auto scale"
msgstr "Automatikus méretezés" msgstr "Automatikus méretezés"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Sávok" msgstr "Sávok"

View File

@ -60,6 +60,10 @@ msgstr "Ploto sekos"
msgid "Auto scale" msgid "Auto scale"
msgstr "Automatinis mastelis" msgstr "Automatinis mastelis"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Stulpelių sekos" msgstr "Stulpelių sekos"

View File

@ -60,6 +60,10 @@ msgstr ""
msgid "Auto scale" msgid "Auto scale"
msgstr "Automatyczna skala" msgstr "Automatyczna skala"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "" msgstr ""

View File

@ -49,6 +49,10 @@ msgstr ""
msgid "Auto scale" msgid "Auto scale"
msgstr "" msgstr ""
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "" msgstr ""

View File

@ -59,6 +59,10 @@ msgstr "Série Área"
msgid "Auto scale" msgid "Auto scale"
msgstr "Escala auto" msgstr "Escala auto"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Série Barra" msgstr "Série Barra"

View File

@ -59,6 +59,10 @@ msgstr "Диаграмма с областями"
msgid "Auto scale" msgid "Auto scale"
msgstr "Автоматический масштаб" msgstr "Автоматический масштаб"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Гистограмма" msgstr "Гистограмма"

View File

@ -60,6 +60,10 @@ msgstr "Områdesdiagram"
msgid "Auto scale" msgid "Auto scale"
msgstr "Autoskala" msgstr "Autoskala"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Stapeldiagram" msgstr "Stapeldiagram"

View File

@ -62,6 +62,10 @@ msgstr "Діаграма з областями"
msgid "Auto scale" msgid "Auto scale"
msgstr "Автоматичний масштаб" msgstr "Автоматичний масштаб"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "Гістограма" msgstr "Гістограма"

View File

@ -60,6 +60,10 @@ msgstr "面积图系列"
msgid "Auto scale" msgid "Auto scale"
msgstr "自动缩放" msgstr "自动缩放"
#: tachartstrconsts.rsaxisclicktool
msgid "Axis click"
msgstr ""
#: tachartstrconsts.rsbarseries #: tachartstrconsts.rsbarseries
msgid "Bar series" msgid "Bar series"
msgstr "条形图系列" msgstr "条形图系列"

View File

@ -81,6 +81,10 @@ type
{ TChartAxis } { TChartAxis }
TChartAxisHitTest = (ahtTitle, ahtLine, ahtLabels,
ahtAxisStart, ahtAxisCenter, ahtAxisEnd);
TChartAxisHitTests = set of TChartAxisHitTest;
TChartAxis = class(TChartBasicAxis) TChartAxis = class(TChartBasicAxis)
strict private strict private
FListener: TListener; FListener: TListener;
@ -92,6 +96,7 @@ type
FAxisRect: TRect; FAxisRect: TRect;
FGroupIndex: Integer; FGroupIndex: Integer;
FTitleRect: TRect; FTitleRect: TRect;
FTitlePolygon: TPointArray;
function MakeValuesInRangeParams(AMin, AMax: Double): TValuesInRangeParams; function MakeValuesInRangeParams(AMin, AMax: Double): TValuesInRangeParams;
strict private strict private
FAlignment: TChartAxisAlignment; FAlignment: TChartAxisAlignment;
@ -144,6 +149,7 @@ type
destructor Destroy; override; destructor Destroy; override;
public public
procedure Assign(ASource: TPersistent); override; procedure Assign(ASource: TPersistent); override;
function GetHitTestInfoAt(APoint: TPoint; ADelta: Integer): TChartAxisHitTests; virtual;
procedure Draw; procedure Draw;
procedure DrawTitle(ASize: Integer); procedure DrawTitle(ASize: Integer);
function GetChart: TCustomChart; inline; function GetChart: TCustomChart; inline;
@ -265,7 +271,7 @@ type
implementation implementation
uses uses
LResources, Math, PropEdits, TAChartStrConsts, {%H-}TAGeometry, TAMath; LResources, Math, PropEdits, TAChartStrConsts, TAGeometry, TAMath;
var var
VIdentityTransform: TChartAxisTransformations; VIdentityTransform: TChartAxisTransformations;
@ -458,6 +464,77 @@ begin
inherited; inherited;
end; end;
function TChartAxis.GetHitTestInfoAt(APoint: TPoint;
ADelta: Integer): TChartAxisHitTests;
var
R: TRect;
w, h, loc: Integer;
p: Integer;
begin
Result := [];
if IsPointInPolygon(APoint, FTitlePolygon) then
Include(Result, ahtTitle)
else begin
R := FAxisRect;
case FAlignment of
calLeft:
begin
R.Right := R.Left + Max(ADelta, TickInnerLength);
R.Left := R.Left - Max(ADelta, TickLength);
end;
calRight:
begin
R.Left := R.Right - Max(ADelta, TickInnerLength);
R.Right := R.Right + Max(ADelta, TickLength);
end;
calTop:
begin
R.Bottom := R.Top + Max(ADelta, TickInnerLength);
R.Top := R.Top - Max(ADelta, TickLength);
end;
calBottom:
begin
R.Top := R.Bottom - Max(ADelta, TickInnerLength);
R.Bottom := R.Bottom + Max(ADelta, TickLength);
end;
end;
if IsPointInRect(APoint, R) then
Include(Result, ahtLine)
else if IsPointInside(APoint) then
Include(Result, ahtLabels);
if Result = [] then
exit;
R := FHelper.FClipRect^;
if IsVertical then begin
h := R.Bottom - R.Top;
p := APoint.Y - R.Top;
if p < h div 4 then
loc := +1
else if p > h - h div 4 then
loc := -1
else
loc := 0;
end else begin
w := abs(R.Right - R.Left);
p := abs(APoint.X - R.Left);
if p < w div 4 then
loc := -1
else if p > w - w div 4 then
loc := +1
else
loc := 0;
end;
if IsFlipped then loc := -loc;
case loc of
-1: Include(Result, ahtAxisStart);
0: Include(Result, ahtAxisCenter);
+1: Include(Result, ahtAxisEnd);
end;
end;
end;
procedure TChartAxis.Draw; procedure TChartAxis.Draw;
procedure DrawMinors(AFixedCoord: Integer; AMin, AMax: Double); procedure DrawMinors(AFixedCoord: Integer; AMin, AMax: Double);
@ -520,7 +597,6 @@ end;
procedure TChartAxis.DrawTitle(ASize: Integer); procedure TChartAxis.DrawTitle(ASize: Integer);
var var
p: TPoint; p: TPoint;
dummy: TPointArray = nil;
d: Integer; d: Integer;
begin begin
if not Visible or (ASize = 0) or (FTitlePos = MaxInt) then exit; if not Visible or (ASize = 0) or (FTitlePos = MaxInt) then exit;
@ -536,7 +612,7 @@ begin
end; end;
TPointBoolArr(p)[IsVertical] := FTitlePos; TPointBoolArr(p)[IsVertical] := FTitlePos;
p += FHelper.FZOffset; p += FHelper.FZOffset;
Title.DrawLabel(FHelper.FDrawer, p, p, Title.Caption, dummy); Title.DrawLabel(FHelper.FDrawer, p, p, Title.Caption, FTitlePolygon);
end; end;
function TChartAxis.GetAlignment: TChartAxisAlignment; function TChartAxis.GetAlignment: TChartAxisAlignment;

View File

@ -64,13 +64,13 @@ resourcestring
rsPanningByDrag = 'Panning by drag'; rsPanningByDrag = 'Panning by drag';
rsPanningByClick = 'Panning by click'; rsPanningByClick = 'Panning by click';
rsPanningByMousewheel = 'Panning by mouse wheel'; rsPanningByMousewheel = 'Panning by mouse wheel';
//rsReticule = 'Reticule';
rsDataPointClick = 'Data point click'; rsDataPointClick = 'Data point click';
rsDataPointDrag = 'Data point drag'; rsDataPointDrag = 'Data point drag';
rsDataPointHint = 'Data point hint'; rsDataPointHint = 'Data point hint';
rsDataPointCrossHair = 'Data point crosshair'; rsDataPointCrossHair = 'Data point crosshair';
rsUserDefinedTool = 'User-defined'; rsUserDefinedTool = 'User-defined';
rsDistanceMeasurement = 'Distance measurement'; rsDistanceMeasurement = 'Distance measurement';
rsAxisClickTool = 'Axis click';
// Chart sources // Chart sources
rsSourceNotEditable = 'Editable chart source required'; rsSourceNotEditable = 'Editable chart source required';

View File

@ -1336,7 +1336,7 @@ var
begin begin
ts := GetToolset; ts := GetToolset;
if if
PtInRect(FClipRect, Point(X, Y)) and // PtInRect(FClipRect, Point(X, Y)) and
(ts <> nil) and ts.Dispatch(Self, evidMouseDown, Shift, Point(X, Y)) (ts <> nil) and ts.Dispatch(Self, evidMouseDown, Shift, Point(X, Y))
then then
exit; exit;

View File

@ -57,6 +57,7 @@ type
FOverlapPolicy: TChartMarksOverlapPolicy; FOverlapPolicy: TChartMarksOverlapPolicy;
FShape: TChartLabelShape; FShape: TChartLabelShape;
FTextFormat: TChartTextFormat; FTextFormat: TChartTextFormat;
FTextRect: TRect;
procedure SetAlignment(AValue: TAlignment); procedure SetAlignment(AValue: TAlignment);
procedure SetCalloutAngle(AValue: Cardinal); procedure SetCalloutAngle(AValue: Cardinal);
procedure SetClipped(AValue: Boolean); procedure SetClipped(AValue: Boolean);
@ -95,6 +96,7 @@ type
const AText: String; var APrevLabelPoly: TPointArray); const AText: String; var APrevLabelPoly: TPointArray);
function GetLabelPolygon( function GetLabelPolygon(
ADrawer: IChartDrawer; ASize: TPoint): TPointArray; ADrawer: IChartDrawer; ASize: TPoint): TPointArray;
function GetTextRect: TRect;
function MeasureLabel(ADrawer: IChartDrawer; const AText: String): TSize; function MeasureLabel(ADrawer: IChartDrawer; const AText: String): TSize;
function MeasureLabelHeight(ADrawer: IChartDrawer; const AText: String): TSize; function MeasureLabelHeight(ADrawer: IChartDrawer; const AText: String): TSize;
procedure SetInsideDir(dx, dy: Double); procedure SetInsideDir(dx, dy: Double);
@ -455,6 +457,11 @@ begin
Result := nil; Result := nil;
end; end;
function TChartTextElement.GetTextRect: TRect;
begin
Result := FTextRect;
end;
function TChartTextElement.GetTextShiftNeeded: Boolean; function TChartTextElement.GetTextShiftNeeded: Boolean;
var var
textdir: TDoublePoint; textdir: TDoublePoint;

View File

@ -21,7 +21,7 @@ uses
Controls, CustomTimer, GraphMath, Forms, LCLPlatformDef, InterfaceBase, Controls, CustomTimer, GraphMath, Forms, LCLPlatformDef, InterfaceBase,
LCLType, LCLIntf, LCLType, LCLIntf,
// TAChart // TAChart
TAChartUtils, TADrawUtils, TAGraph, TATypes; TAChartUtils, TADrawUtils, TAChartAxis, TAGraph, TATypes;
type type
@ -583,6 +583,28 @@ type
property Targets; property Targets;
end; end;
TAxisClickTool = class;
TAxisClickEvent = procedure (ASender: TAxisClickTool; Axis: TChartAxis;
AHit: TChartAxisHitTests) of object;
TAxisClickTool = class(TChartTool)
private
FAxis: TChartAxis;
FGrabRadius: Integer;
FHitTest: TChartAxisHitTests;
FOnClick: TAxisClickEvent;
protected
function GetHitTestInfo(APoint: TPoint): boolean;
public
constructor Create(AOwner: TComponent); override;
procedure MouseDown(APoint: TPoint); override;
procedure MouseUp(APoint: TPoint); override;
published
property GrabRadius: Integer read FGrabRadius write FGrabRadius default 4;
property OnClick: TAxisClickEvent read FOnClick write FOnClick;
end;
procedure Register; procedure Register;
procedure RegisterChartToolClass(AToolClass: TChartToolClass; procedure RegisterChartToolClass(AToolClass: TChartToolClass;
@ -1998,6 +2020,45 @@ begin
end; end;
end; end;
{ TAxisClickTool }
constructor TAxisClickTool.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetPropDefaults(Self, ['GrabRadius']);
end;
function TAxisClickTool.GetHitTestInfo(APoint: TPoint): Boolean;
var
ax: TChartAxis;
begin
for ax in FChart.AxisList do begin
FHitTest := ax.GetHitTestInfoAt(APoint, FGrabRadius);
if FHitTest <> [] then begin
FAxis := ax;
Result := true;
exit;
end;
end;
Result := false;
FAxis := nil;
FHitTest := [];
end;
procedure TAxisClickTool.MouseDown(APoint: TPoint);
begin
if GetHitTestInfo(APoint) then
Activate;
end;
procedure TAxisClickTool.MouseUp(APoint: TPoint);
begin
if FHitTest <> [] then
if Assigned(FOnClick) then FOnClick(Self, FAxis, FHitTest);
end;
procedure SkipObsoleteProperties; procedure SkipObsoleteProperties;
const const
PROPORTIONAL_NOTE = 'Obsolete, use TZoomDragTool.RatioLimit=zlrProportional instead'; PROPORTIONAL_NOTE = 'Obsolete, use TZoomDragTool.RatioLimit=zlrProportional instead';
@ -2020,6 +2081,7 @@ initialization
RegisterChartToolClass(TDataPointDragTool, @rsDataPointDrag); RegisterChartToolClass(TDataPointDragTool, @rsDataPointDrag);
RegisterChartToolClass(TDataPointHintTool, @rsDataPointHint); RegisterChartToolClass(TDataPointHintTool, @rsDataPointHint);
RegisterChartToolClass(TDataPointCrosshairTool, @rsDataPointCrosshair); RegisterChartToolClass(TDataPointCrosshairTool, @rsDataPointCrosshair);
RegisterChartToolClass(TAxisClickTool, @rsAxisClickTool);
RegisterChartToolClass(TUserDefinedTool, @rsUserDefinedTool); RegisterChartToolClass(TUserDefinedTool, @rsUserDefinedTool);
SkipObsoleteProperties; SkipObsoleteProperties;