Commit c11192b6 authored by paul's avatar paul
Browse files

lcl: implement ClientToParent, ParentToClient based on patch of David Jenkins (issue #21763)

git-svn-id: trunk@36775 -
parent a2ae31d2
......@@ -1523,6 +1523,8 @@ type
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;
......@@ -2864,6 +2866,8 @@ begin
Include(Result, ssAlt);
if ((GetKeyState(VK_LWIN) and $8000) <> 0) or ((GetKeyState(VK_RWIN) and $8000) <> 0) then
Include(Result, ssMeta);
if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then
Include(Result, ssMeta);
end;
{------------------------------------------------------------------------------
......
......@@ -1525,6 +1525,24 @@ begin
Result.Y := APoint.Y + P.Y;
end;
function TControl.ClientToParent(const Point: TPoint; AParent: TWinControl): TPoint;
begin
if not Assigned(AParent) then
AParent := Parent;
if not AParent.IsParentOf(Self) then
raise EInvalidOperation.CreateFmt(rsControlIsNotAParent, [AParent.Name, Name]);
Result := AParent.ScreenToClient(ClientToScreen(Point));
end;
function TControl.ParentToClient(const Point: TPoint; AParent: TWinControl): TPoint;
begin
if not Assigned(AParent) then
AParent := Parent;
if not AParent.IsParentOf(Self) then
raise EInvalidOperation.CreateFmt(rsControlIsNotAParent, [AParent.Name, Name]);
Result := ScreenToClient(AParent.ClientToScreen(Point));
end;
{------------------------------------------------------------------------------
TControl.DblClick
------------------------------------------------------------------------------}
......@@ -4938,21 +4956,20 @@ end;
------------------------------------------------------------------------------}
function TControl.IsParentOf(AControl: TControl): boolean;
begin
Result:=false;
while AControl<>nil do begin
AControl:=AControl.Parent;
if Self=AControl then begin
Result:=true;
exit;
end;
Result := False;
while Assigned(AControl) do
begin
AControl := AControl.Parent;
if Self = AControl then
Exit(True);
end;
end;
function TControl.GetTopParent: TControl;
begin
Result:=Self;
while Result.Parent<>nil do
Result:=Result.Parent;
Result := Self;
while Assigned(Result.Parent) do
Result := Result.Parent;
end;
{------------------------------------------------------------------------------
......
......@@ -374,6 +374,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -374,6 +374,10 @@ msgstr "Prvek třídy '%s' nemůže mít prvek třídy '%s' jako dítě"
msgid "Control '%s' has no parent window"
msgstr "Prvek '%s' nemá rodičovské okno"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Krémová"
......
......@@ -376,6 +376,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Cremefarbig"
......
......@@ -373,6 +373,10 @@ msgstr "El control de clase '%s' no puede tener al control de clase '%s' como hi
msgid "Control '%s' has no parent window"
msgstr "El control '%s' no tiene ventana padre"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Crema"
......
......@@ -367,6 +367,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -376,6 +376,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -372,6 +372,10 @@ msgstr "פקד של המחלקה '%s' לא יכול לקבל פקד של מחל
msgid "Control '%s' has no parent window"
msgstr "לפקד s% אין חלון הורה"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "קרמי"
......
......@@ -375,6 +375,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -376,6 +376,10 @@ msgstr "Un controllo di classe '%s' non può avere figli di classe '%s'"
msgid "Control '%s' has no parent window"
msgstr "Il controllo '%s' non ha finestra padre"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Crema"
......
......@@ -375,6 +375,10 @@ msgstr "„%s“ klasės valdiklis negali būti „%s“ klasės valdiklio tėva
msgid "Control '%s' has no parent window"
msgstr "„%s“ valdiklis neturi tėvinio lango"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Kreminė"
......
......@@ -376,6 +376,10 @@ msgstr "Control of klasse '%s' kan control of klasse '%s' niet als kind hebben"
msgid "Control '%s' has no parent window"
msgstr "Control '%s' heeft geen venster als ouder"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Cream"
......
......@@ -374,6 +374,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -378,6 +378,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -367,6 +367,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
......@@ -374,6 +374,10 @@ msgstr "Controle de classe '%s' não pode ter controle de classe '%s' como filho
msgid "Control '%s' has no parent window"
msgstr "Controle '%s' não possui janela pai"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Creme"
......
......@@ -373,6 +373,10 @@ msgstr "Controle de classe '%s' não pode ter controle de classe '%s' como filho
msgid "Control '%s' has no parent window"
msgstr "Controle '%s' não possui janela pai"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Creme"
......
......@@ -374,6 +374,10 @@ msgstr "Элемент управления класса '%s' не может и
msgid "Control '%s' has no parent window"
msgstr "Элемент управления '%s' не имеет родительского окна"
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr "Кремовый"
......
......@@ -377,6 +377,10 @@ msgstr ""
msgid "Control '%s' has no parent window"
msgstr ""
#: lclstrconsts.rscontrolisnotaparent
msgid "'%s' is not a parent of '%s'"
msgstr ""
#: lclstrconsts.rscreamcolorcaption
msgid "Cream"
msgstr ""
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment