paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 12:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: TStatusBar: highDPI: implement DoAutoAdjustLayout

Browse Source 
git-svn-id: trunk@53583 -
This commit is contained in:
ondrej 2016-12-06 19:57:41 +00:00
parent ec3be77f3d
commit 6b96ab0bc3
2 changed files with 22 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/comctrls.pp
View File

@ -157,6 +157,9 @@ type
function DoHint: Boolean; virtual;
procedure DrawPanel(Panel: TStatusPanel; const Rect: TRect); virtual;
procedure LMDrawItem(var Message: TLMDrawItems); message LM_DRAWITEM;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double; const AScaleFonts: Boolean); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;

19
lcl/include/statusbar.inc
View File

@ -147,6 +147,25 @@ begin
FHandleObjectNeedsUpdate:=false;
end;
procedure TStatusBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double; const AScaleFonts: Boolean);
var
I: Integer;
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion, AScaleFonts);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
BeginUpdate;
try
for I := 0 to Panels.Count-1 do
Panels[I].Width := Round(Panels[I].Width * AXProportion);
finally
EndUpdate;
end;
end;
end;
procedure TStatusBar.Loaded;
begin
inherited Loaded;