Commits the first part of layout auto-adjustment support in the LCL

git-svn-id: trunk@34272 -

lcl/controls.pp

@@ -880,6 +880,15 @@ type
     chtOnKeyDown
     );
 
+  TLayoutAdjustmentPolicy = (
+    lapDefault,     // widgetset dependent
+    lapFixedLayout, // A fixed absolute layout in all platforms
+    lapAutoAdjustWithoutHorizontalScrolling, // Smartphone platforms use this one,
+                                             // the x axis is stretched to fill the screen and
+                                             // the y is scaled to fit the DPI
+    lapAutoAdjustForDPI // For desktops using High DPI, scale x and y to fit the DPI
+  );
+
 {* Note on TControl.Caption
  * The VCL implementation relies on the virtual Get/SetTextBuf to
  * exchange text between widgets and VCL. This means a lot of
@@ -1347,6 +1356,10 @@ type
     property ReadBounds: TRect read FReadBounds;
     property BaseParentClientSize: TSize read FBaseParentClientSize;
     procedure WriteLayoutDebugReport(const Prefix: string); virtual;
+    procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
+      const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer); virtual;
+    function ShouldAutoAdjustLayout: Boolean; virtual;
+    function ShouldAutoAdjustLeftAndTop: Boolean; virtual;
   public
     constructor Create(TheOwner: TComponent);override;
     destructor Destroy; override;
@@ -1977,6 +1990,8 @@ type
     procedure ReAlign; // realign all children
     procedure ScrollBy(DeltaX, DeltaY: Integer); virtual;
     procedure WriteLayoutDebugReport(const Prefix: string); override;
+    procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
+      const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer); override;
   public
     constructor Create(TheOwner: TComponent);override;
     constructor CreateParented(AParentWindow: HWND);

lcl/forms.pp

@@ -1200,12 +1200,15 @@ type
   end;
 
   // This identifies the kind of device where the application currently runs on
+  // Note that the same application can run in all kinds of devices if it has a
+  // user interface flexible enough
   TApplicationType = (
     atDefault,     // The widgetset will attempt to auto-detect the device type
     atDesktop,     // For common desktops and notebooks
     atPDA,         // For smartphones and other devices with touch screen and a small screen
     atKeyPadDevice,// Devices without any pointing device, such as keypad feature phones or kiosk machines
-    atTablet       // Similar to a PDA/Smartphone, but with a large screen
+    atTablet,      // Similar to a PDA/Smartphone, but with a large screen
+    atTV           // The device is a television
   );
 
   TApplicationShowGlyphs = (
@@ -1220,15 +1223,6 @@ type
     tbSingleButton  // hide buttons for Forms with ShowTaskBar = stDefault
   );
 
-  TLayoutAdjustmentPolicy = (
-    lapDefault,     // widgetset dependent
-    lapFixedLayout, // A fixed absolute layout in all platforms
-    lapAutoAdjustWithoutHorizontalScrolling, // Smartphone platforms use this one,
-                                             // the x axis is stretched to fill the screen and
-                                             // the y is scaled to fit the DPI
-    lapAutoAdjustForDPI // For desktops using High DPI, scale x and y to fit the DPI
-  );
-
   { TApplication }
 
   TApplication = class(TCustomApplication)

lcl/include/control.inc

@@ -3442,6 +3442,57 @@ begin
   DebugLn;
 end;
 
+procedure TControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
+  const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer);
+var
+  lXProportion, lYProportion: Double;
+  NewLeft, NewTop, NewHeight, NewWidth: Integer;
+begin
+  // X-axis adjustment
+  if AMode = lapAutoAdjustWithoutHorizontalScrolling then
+  begin
+    lXProportion := ANewFormWidth / AOldFormWidth;
+  end
+  else if AMode = lapAutoAdjustForDPI then
+  begin
+    lXProportion := AToDPI / AFromDPI;
+  end;
+
+  // y-axis adjustment
+  lYProportion := AToDPI / AFromDPI;
+
+  // Apply the changes
+  if (AMode = lapAutoAdjustWithoutHorizontalScrolling) or
+   (AMode = lapAutoAdjustForDPI) then
+  begin
+    if ShouldAutoAdjustLeftAndTop then
+    begin
+      NewLeft := Round(Left * lXProportion);
+      NewTop := Round(Top * lYProportion);
+    end
+    else
+    begin
+      NewLeft := Left;
+      NewTop := Top;
+    end;
+    NewWidth := Round(Width * lXProportion);
+    NewHeight := Round(Height * lYProportion);
+    SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
+  end;
+end;
+
+// The layout should only be auto-adjusted for controls with the most simple
+// default absolute positioning
+function TControl.ShouldAutoAdjustLayout: Boolean;
+begin
+  Result := (Align = alNone) and (Anchors = [akTop, akLeft])
+end;
+
+function TControl.ShouldAutoAdjustLeftAndTop: Boolean;
+begin
+  Result := Parent <> nil;
+end;
+
 procedure TControl.UpdateAnchorRules;
 begin
   UpdateBaseBounds(true,true,false);

lcl/include/wincontrol.inc

@@ -3775,6 +3775,19 @@ begin
     Controls[i].WriteLayoutDebugReport(Prefix+'  ');
 end;
 
+procedure TWinControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
+  const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer);
+var
+  i: Integer;
+begin
+  // Only auto-adjust self if required, but always auto-adjust child objects
+  if ShouldAutoAdjustLayout then
+    inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth);
+
+  for i:=0 to ControlCount-1 do
+    Controls[i].AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth);
+end;
+
 {------------------------------------------------------------------------------
   TWinControl.CanTab
 ------------------------------------------------------------------------------}