paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-24 17:40:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: groupededit: highDPI: scale BuddyWidth in AutoAdjustLayout

Browse Source 
git-svn-id: trunk@53759 -
This commit is contained in:
ondrej 2016-12-22 18:12:29 +00:00
parent 9d246cdd6e
commit 33449c9e87
1 changed files with 15 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/groupededit.pp
View File

@ -178,6 +178,9 @@ type
procedure SetTabStop(AValue: Boolean);
procedure SetTextHint(AValue: TTranslateString);
protected
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double; const AScale0Fonts: Boolean);
override;
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
function CreateBuddy: TControl; virtual;
@ -1243,6 +1246,18 @@ begin
inherited Destroy;
end;
procedure TCustomAbstractGroupedEdit.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy; const AXProportion,
AYProportion: Double; const AScale0Fonts: Boolean);
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion, AScale0Fonts);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
BuddyWidth := Round(BuddyWidth*AXProportion);
end;
end;
function TCustomAbstractGroupedEdit.Focused: Boolean;
begin
Result := FEdit.Focused;