lcl: controls: highDPI: add ScaleCoord and ScaleCoordBack

git-svn-id: trunk@53543 -

lcl/controls.pp

@@ -1475,6 +1475,9 @@ type
     function CreateAccessibleObject: TLazAccessibleObject; virtual;
     function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual;
     function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual;
+    //scale support
+    function ScaleCoord(const ASize: Integer): Integer;
+    function ScaleCoordBack(const ASize: Integer): Integer;
   public
     // size
     procedure AdjustSize; virtual;// smart calling DoAutoSize

lcl/include/control.inc

@@ -764,6 +764,34 @@ begin
   end;
 end;
 
+function TControl.ScaleCoord(const ASize: Integer): Integer;
+var
+  ParentForm: TCustomForm;
+begin
+  ParentForm := GetParentForm(Self);
+  if ParentForm=nil then
+    raise EInvalidOperation.CreateFmt(rsControlHasNoParentForm, [Name]);
+
+  if ParentForm.DesignTimeDPI=ParentForm.PixelsPerInch then
+    Result := ASize
+  else
+    Result := MulDiv(ASize, ParentForm.PixelsPerInch, ParentForm.DesignTimeDPI);
+end;
+
+function TControl.ScaleCoordBack(const ASize: Integer): Integer;
+var
+  ParentForm: TCustomForm;
+begin
+  ParentForm := GetParentForm(Self);
+  if ParentForm=nil then
+    raise EInvalidOperation.CreateFmt(rsControlHasNoParentForm, [Name]);
+
+  if ParentForm.DesignTimeDPI=ParentForm.PixelsPerInch then
+    Result := ASize
+  else
+    Result := MulDiv(ASize, ParentForm.DesignTimeDPI, ParentForm.PixelsPerInch);
+end;
+
 {------------------------------------------------------------------------------
        TControl.ChangeScale
 

lcl/languages/lclstrconsts.ca.po

@@ -370,6 +370,10 @@ msgstr "Sensible a majúsc-minúsc."
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.cs.po

@@ -364,6 +364,10 @@ msgstr "Rozlišovat velká/malá"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Prvek třídy '%s' nemůže mít prvek třídy '%s' jako dítě"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Prvek '%s' nemá rodičovské okno"

lcl/languages/lclstrconsts.de.po

@@ -363,6 +363,10 @@ msgstr "Schreibweisenabhängig"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.es.po

@@ -360,6 +360,10 @@ msgstr "Sensible a mayúsculas/minúsculas"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "El control de clase '%s' no puede tener al control de clase '%s' como hijo"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "El control '%s' no tiene ventana padre"

lcl/languages/lclstrconsts.fi.po

@@ -360,6 +360,10 @@ msgstr "Sama kirjainkoko"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Luokan '%s' kontrollin lapsi ei voi olla luokan '%s' kontrolli"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Kontrolli '%s':lla ei ole emoikkunaa"

lcl/languages/lclstrconsts.fr.po

@@ -362,6 +362,10 @@ msgstr "Respecter la casse"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Le contrôle de la classe \"%s\" ne peut pas contenir un contrôle de la classe \"%s\" comme enfant"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Le contrôle \"%s\" n'a pas de fenêtre parent"

lcl/languages/lclstrconsts.he.po

@@ -371,6 +371,10 @@ msgstr "רגיש לריישיות"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "פקד של המחלקה  '%s' לא יכול לקבל פקד של מחלקה s% בתור בן"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 #, fuzzy,badformat
 msgid "Control '%s' has no parent window"

lcl/languages/lclstrconsts.hu.po

@@ -362,6 +362,10 @@ msgstr "Kis-/nagybetűre érzékeny"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "'%s' osztályú vezérlőnek nem lehet gyermeke egy '%s' osztályú vezérlő"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "A(z) '%s' vezérlőnek nincs szülő ablaka"

lcl/languages/lclstrconsts.id.po

@@ -371,6 +371,10 @@ msgstr "Sensitif huruf"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.it.po

@@ -364,6 +364,10 @@ msgstr "Differenzia maiuscolo e minuscolo"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Un controllo di classe '%s' non può avere figli di classe '%s'"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Il controllo '%s' non ha finestra padre"

lcl/languages/lclstrconsts.ja.po

@@ -370,6 +370,10 @@ msgstr "大文字小文字を区別"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "コントロールクラス '%s' はコントロールクラス '%s' を子とすることはできません"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "コントロール '%s' には親ウィンドウがありません"

lcl/languages/lclstrconsts.lt.po

@@ -371,6 +371,10 @@ msgstr "Skirti raidžių lygį"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "„%s“ klasės valdiklis negali būti „%s“ klasės valdiklio tėvas"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "„%s“ valdiklis neturi tėvinio lango"

lcl/languages/lclstrconsts.nl.po

@@ -371,6 +371,10 @@ msgstr "Hoofdletter gevoelig"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Control van klasse '%s' kan control van klasse '%s' niet als kind hebben"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Control '%s' heeft geen venster als ouder"

lcl/languages/lclstrconsts.no.po

@@ -370,6 +370,10 @@ msgstr "Skill mellom store/små bokstaver"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.pl.po

@@ -366,6 +366,10 @@ msgstr "Uwzględnij wielkość liter"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.po

@@ -355,6 +355,10 @@ msgstr ""
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.pt.po

@@ -360,6 +360,10 @@ msgstr "Diferenciar maiúsc./minúsc."
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Controle de classe '%s' não pode ter controle de classe '%s' como filho"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Controle '%s' não possui janela pai"

lcl/languages/lclstrconsts.pt_BR.po

@@ -368,6 +368,10 @@ msgstr "Diferenciar maiúsc./minúsc."
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Controle de classe '%s' não pode ter controle de classe '%s' como filho"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Controle '%s' não possui janela pai"

lcl/languages/lclstrconsts.ru.po

@@ -362,6 +362,10 @@ msgstr "С учётом регистра"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Элемент управления класса '%s' не может иметь дочерний элемент управления класса '%s'"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Элемент управления '%s' не имеет родительского окна"

lcl/languages/lclstrconsts.sk.po

@@ -365,6 +365,10 @@ msgstr "Rozlišovať veľké a malé písmo"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Prvok triedy '%s' nemôže mať prvok triedy '%s' ako dieťa"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Prvok '%s' nemá rodičovské okno"

lcl/languages/lclstrconsts.tr.po

@@ -370,6 +370,10 @@ msgstr "Büyük/küçük harfe duyarlı"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/languages/lclstrconsts.uk.po

@@ -371,6 +371,10 @@ msgstr "Врахування регістру"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr "Елемент управління класу '%s' не може мати наслідником елемент класу '%s'"
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr "Елемент управління '%s' не має батьківського вінка"

lcl/languages/lclstrconsts.zh_CN.po

@@ -373,6 +373,10 @@ msgstr "大小写敏感"
 msgid "Control of class '%s' can't have control of class '%s' as a child"
 msgstr ""
 
+#: lclstrconsts.rscontrolhasnoparentform
+msgid "Control '%s' has no parent form"
+msgstr ""
+
 #: lclstrconsts.rscontrolhasnoparentwindow
 msgid "Control '%s' has no parent window"
 msgstr ""

lcl/lclstrconsts.pas

@@ -246,6 +246,7 @@ resourceString
   rsCreatingGdbCatchableError = 'Creating gdb catchable error:';
   rsAControlCanNotHaveItselfAsParent = 'A control can''t have itself as a parent';
   rsControlHasNoParentWindow = 'Control ''%s'' has no parent window';
+  rsControlHasNoParentForm = 'Control ''%s'' has no parent form';
   rsControlIsNotAParent = '''%s'' is not a parent of ''%s''';
   rsControlClassCantContainChildClass = 'Control of class ''%s'' can''t have control of class ''%s'' as a child';
   rsASCannotHaveAsParent = 'Class %s cannot have %s as parent.';