diff --git a/lcl/controls.pp b/lcl/controls.pp index 5f186f5589..b0849842b2 100644 --- a/lcl/controls.pp +++ b/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); diff --git a/lcl/forms.pp b/lcl/forms.pp index b506df9ddb..24fed2ec0d 100644 --- a/lcl/forms.pp +++ b/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) diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 97798e8f0c..c406fc94c2 100644 --- a/lcl/include/control.inc +++ b/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); diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index dedbe05608..f80b27fa66 100644 --- a/lcl/include/wincontrol.inc +++ b/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 ------------------------------------------------------------------------------}