View Issue Details

IDProjectCategoryView StatusLast Update
0021763LazarusLCLpublic2012-04-19 16:30
ReporterDavid Jenkins Assigned ToPaul Ishenin  
PrioritynormalSeverityfeatureReproducibilityN/A
Status closedResolutionfixed 
Product Version0.9.30.5 (SVN) 
Target Version1.0.0Fixed in Version1.1 (SVN) 
Summary0021763: Add TControl.ClientToParent and TControl.ParentToClient
DescriptionFor VCL compatibility we'd like to add TControl.ClientToParent and TControl.ParentToClient

Patches against rev 36681 attached
TagsNo tags attached.
Fixed in Revision36775
LazTarget1.0
WidgetsetCarbon
Attached Files

Activities

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.

Issue History

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