{ ***************************************************************************** See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Authors: Alexander Klenin } unit TADataTools; {$H+} interface uses Classes, TAChartUtils, TADrawUtils, TAGraph, TATools, TATextElements, 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; property TextFormat; end; TDataPointDistanceTool = class(TDataPointDrawTool) published type TDataPointMode = (dpmFree, dpmSnap, dpmLock); TOptions = set of ( dpdoRotateLabel, dpdoLabelAbove, dpdoPermanent, dpdoFlipLabel, dpdoClipping); strict private // Workaround for FPC 2.6 bug. Remove after migration to 2.8. FAnchors: array of TObject; FDataPointModeEnd: TDataPointMode; FDataPointModeStart: TDataPointMode; FLastChart: TChart; FMarks: TDataPointDistanceToolMarks; FMeasureMode: TChartDistanceMode; FOnGetDistanceText: TDataPointGetDistanceTextEvent; FOnMeasure: TDataPointDistanceToolMeasureEvent; FOptions: TOptions; FPointerEnd: TDataPointDistanceToolPointer; FPointerStart: TDataPointDistanceToolPointer; procedure Changed(ASender: TObject); 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(ADrawer: IChartDrawer); override; function FindRef( APoint: TPoint; AMode: TDataPointMode; ADest: TDataPointTool.TPointRef; AOtherEndSeries: TBasicChartSeries): Boolean; function GetDistanceText: String; function SameTransformations(ASeries1, ASeries2: TBasicChartSeries): Boolean; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Distance(AUnits: TChartUnits = cuAxis): 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; published property DataPointModeEnd: TDataPointMode read FDataPointModeEnd write FDataPointModeEnd default dpmFree; property DataPointModeStart: TDataPointMode read FDataPointModeStart write FDataPointModeStart default dpmFree; 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; property Transparency; published property OnGetDistanceText: TDataPointGetDistanceTextEvent read FOnGetDistanceText write FOnGetDistanceText; property OnMeasure: TDataPointDistanceToolMeasureEvent read FOnMeasure write FOnMeasure; end; implementation uses GraphMath, Math, SysUtils, Types, TAChartStrConsts, 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; SetPropDefaults(FLabelBrush, ['Color']); Format := DEF_DISTANCE_FORMAT; end; { TDataPointDistanceTool } procedure TDataPointDistanceTool.Changed(ASender: TObject); begin if not (dpdoPermanent in FOptions) then exit; if FChart <> nil then FChart.StyleChanged(ASender) else if FLastChart <> nil then FLastChart.StyleChanged(ASender); end; 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(PointEnd.Series); p2 := PointEnd.AxisPos(PointStart.Series); 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(ADrawer: IChartDrawer); var a: Double; procedure DrawPointer(APointer: TDataPointDistanceToolPointer; APos: TPoint); begin with APointer do if Visible then DrawSize(ADrawer, APos, Point(HorizSize, VertSize), clTAColor, a); end; var p1, p2: TPoint; dummy: TPointArray = nil; flip: Boolean; begin if not (IsActive or (FChart <> nil) and (dpdoPermanent in Options)) then exit; 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; StartTransparency(ADrawer); if dpdoClipping in FOptions then ADrawer.ClippingStart(FChart.ClipRect); try if LinePen.Visible then begin ADrawer.Pen := LinePen; ADrawer.Line(p1, p2); end; a := ArcTan2(p2.Y - p1.Y, p2.X - p1.X); DrawPointer(PointerStart, p1); DrawPointer(PointerEnd, p2); if Marks.Visible then begin flip := (dpdoFlipLabel in Options) and ((a > Pi /2) or (a < -Pi / 2)); Marks.SetAdditionalAngle( IfThen(dpdoRotateLabel in Options, IfThen(flip, Pi - a, -a), 0)); p1 := (p1 + p2) div 2; a += IfThen((dpdoLabelAbove in Options) xor flip, -Pi / 2, Pi / 2); p2 := p1 + RotatePointX(Marks.Distance, a); Marks.DrawLabel(ADrawer, p1, p2, GetDistanceText, dummy); end; finally if dpdoClipping in FOptions then ADrawer.ClippingStop; end; inherited; ADrawer.SetTransparency(0); end; function TDataPointDistanceTool.FindRef( APoint: TPoint; AMode: TDataPointMode; ADest: TDataPointTool.TPointRef; AOtherEndSeries: TBasicChartSeries): Boolean; begin FSeries := nil; if AMode in [dpmSnap, dpmLock] then begin FindNearestPoint(APoint); ADest.FGraphPos := FNearestGraphPoint; ADest.FIndex := PointIndex; if not SameTransformations(FSeries, AOtherEndSeries) then FSeries := nil; end; ADest.FSeries := FSeries; if FSeries = nil then ADest.SetGraphPos(FChart.ImageToGraph(APoint)); Result := (FSeries <> nil) or (AMode <> dpmLock); 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(cuAxis), Distance(cuGraph)]); 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 if IsActive then exit; if dpdoPermanent in Options then DoHide(GetCurrentDrawer); PointStart.FSeries := nil; if FindRef(APoint, DataPointModeStart, PointStart, nil) then Activate; PointEnd.Assign(PointStart); Handled; end; procedure TDataPointDistanceTool.MouseMove(APoint: TPoint); var newEnd: TPointRef; id: IChartDrawer; begin if not IsActive then exit; id := GetCurrentDrawer; DoHide(id); newEnd := TPointRef.Create; try if FindRef(APoint, DataPointModeEnd, newEnd, PointStart.Series) then PointEnd.Assign(newEnd); finally FreeAndNil(newEnd); end; if (EffectiveDrawingMode = tdmXor) and Assigned(id) then begin id.SetXor(true); DoDraw(id); id.SetXor(false); end; Handled; end; procedure TDataPointDistanceTool.MouseUp(APoint: TPoint); begin MouseMove(APoint); if Assigned(OnMeasure) and (PointStart.GraphPos <> PointEnd.GraphPos) then OnMeasure(Self); if dpdoPermanent in Options then begin FLastChart := FChart; Deactivate end else Hide; 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 = nil) or (ASeries2 = nil) 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); Changed(Self); end; procedure TDataPointDistanceTool.SetOptions(AValue: TOptions); begin if FOptions = AValue then exit; Changed(Self); FOptions := AValue; end; procedure TDataPointDistanceTool.SetPointerEnd( AValue: TDataPointDistanceToolPointer); begin if FPointerEnd = AValue then exit; FPointerEnd.Assign(AValue); Changed(Self); end; procedure TDataPointDistanceTool.SetPointerStart( AValue: TDataPointDistanceToolPointer); begin if FPointerStart = AValue then exit; FPointerStart.Assign(AValue); Changed(Self); end; initialization RegisterChartToolClass(TDataPointDistanceTool, @rsDistanceMeasurement); end.