0021763: Add TControl.ClientToParent and TControl.ParentToClient - Free Pascal/Lazarus Bug Tracker

All Projects FPC fpcprojects fpprofiler fpGUI Lazarus Packages Patches Lazarus CCR Mantis pas2js

ID	Project	Category	View Status	Date Submitted	Last Update

0021763	Lazarus	LCL	public	2012-04-13 22:50	2012-04-19 16:30

Reporter	David Jenkins	Assigned To	Paul Ishenin
Priority	normal	Severity	feature	Reproducibility	N/A
Status	closed	Resolution	fixed
Product Version	0.9.30.5 (SVN)	Product Build
Target Version	1.0.0	Fixed in Version	1.1 (SVN)

Summary	0021763: Add TControl.ClientToParent and TControl.ParentToClient
Description	For VCL compatibility we'd like to add TControl.ClientToParent and TControl.ParentToClient Patches against rev 36681 attached
Tags	No tags attached.

Fixed in Revision	36775
LazTarget	1.0
Widgetset	Carbon

Attached Files	control.inc.patch (1,340 bytes) --- /Users/djenkins/laz-changes/14755/control.inc 2012-04-11 16:47:27.000000000 +++ /Users/djenkins/laz-changes/14755/control.inc.ss 2012-04-11 16:48:16.000000000 @@ -1526,6 +1526,26 @@ end; {------------------------------------------------------------------------------ + function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; +------------------------------------------------------------------------------} +function TControl.ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; +begin + if AParent = nil then + AParent := Parent; + Result := AParent.ScreenToClient(ClientToScreen(Point)); +end; + +{------------------------------------------------------------------------------ + function ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint; +------------------------------------------------------------------------------} +function TControl.ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint; +begin + if AParent = nil then + AParent := Parent; + Result := ScreenToClient(AParent.ClientToScreen(Point)); +end; + +{------------------------------------------------------------------------------ TControl.DblClick ------------------------------------------------------------------------------} procedure TControl.DblClick; control.inc.patch (1,340 bytes) controls.pp.patch (665 bytes) --- /Users/djenkins/laz-changes/14755/controls.pp 2012-04-11 16:48:56.000000000 +++ /Users/djenkins/laz-changes/14755/controls.pp.ss 2012-04-11 16:49:28.000000000 @@ -1523,6 +1523,8 @@ function ClientToScreen(const APoint: TPoint): TPoint; function ScreenToControl(const APoint: TPoint): TPoint; function ControlToScreen(const APoint: TPoint): TPoint; + function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; + function ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint; function GetChildsRect(Scrolled: boolean): TRect; virtual; procedure Show; procedure Update; virtual; controls.pp.patch (665 bytes)

2012-04-13 22:50	control.inc.patch (1,340 bytes) --- /Users/djenkins/laz-changes/14755/control.inc 2012-04-11 16:47:27.000000000 +++ /Users/djenkins/laz-changes/14755/control.inc.ss 2012-04-11 16:48:16.000000000 @@ -1526,6 +1526,26 @@ end; {------------------------------------------------------------------------------ + function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; +------------------------------------------------------------------------------} +function TControl.ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; +begin + if AParent = nil then + AParent := Parent; + Result := AParent.ScreenToClient(ClientToScreen(Point)); +end; + +{------------------------------------------------------------------------------ + function ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint; +------------------------------------------------------------------------------} +function TControl.ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint; +begin + if AParent = nil then + AParent := Parent; + Result := ScreenToClient(AParent.ClientToScreen(Point)); +end; + +{------------------------------------------------------------------------------ TControl.DblClick ------------------------------------------------------------------------------} procedure TControl.DblClick; control.inc.patch (1,340 bytes)

2012-04-13 22:51	controls.pp.patch (665 bytes) --- /Users/djenkins/laz-changes/14755/controls.pp 2012-04-11 16:48:56.000000000 +++ /Users/djenkins/laz-changes/14755/controls.pp.ss 2012-04-11 16:49:28.000000000 @@ -1523,6 +1523,8 @@ function ClientToScreen(const APoint: TPoint): TPoint; function ScreenToControl(const APoint: TPoint): TPoint; function ControlToScreen(const APoint: TPoint): TPoint; + function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; + function ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint; function GetChildsRect(Scrolled: boolean): TRect; virtual; procedure Show; procedure Update; virtual; controls.pp.patch (665 bytes)

Zeljan Rikalo 2012-04-14 12:21 developer ~0058574	@Paul, please evaluate this patch.

Paul Ishenin 2012-04-14 16:19 manager ~0058588	Thanks for the patch. There was one check missing if passed parent is not a parent of control. I've added it and commited. Please close if ok.

Date Modified	Username	Field	Change
2012-04-13 22:50	David Jenkins	New Issue
2012-04-13 22:50	David Jenkins	File Added: control.inc.patch
2012-04-13 22:50	David Jenkins	Widgetset	=> Carbon
2012-04-13 22:51	David Jenkins	File Added: controls.pp.patch
2012-04-14 12:21	Zeljan Rikalo	LazTarget	=> -
2012-04-14 12:21	Zeljan Rikalo	Note Added: 0058574
2012-04-14 12:21	Zeljan Rikalo	Assigned To	=> Paul Ishenin
2012-04-14 12:21	Zeljan Rikalo	Status	new => assigned
2012-04-14 16:19	Paul Ishenin	Fixed in Revision	=> 36775
2012-04-14 16:19	Paul Ishenin	LazTarget	- => 1.0
2012-04-14 16:19	Paul Ishenin	Status	assigned => resolved
2012-04-14 16:19	Paul Ishenin	Fixed in Version	=> 1.1 (SVN)
2012-04-14 16:19	Paul Ishenin	Resolution	open => fixed
2012-04-14 16:19	Paul Ishenin	Note Added: 0058588
2012-04-14 16:19	Paul Ishenin	Target Version	=> 1.0.0
2012-04-19 16:30	David Jenkins	Status	resolved => closed