paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 08:58:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Fix high-dpi scaling of the TabHeight and TabWidth properties of TPageControl and TTabControl

Browse Source
This commit is contained in:
wp_xyz 2023-05-16 22:28:12 +02:00
parent 0991e39f7d
commit f793569190
2 changed files with 18 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/comctrls.pp
View File

@ -421,6 +421,8 @@ type
procedure SetTabPosition(tabPos: TTabPosition); virtual;
procedure SetTabWidth(AValue: Smallint);
procedure ShowCurrentPage;
function TabHeightIsStored: Boolean;
function TabWidthIsStored: Boolean;
procedure UpdateAllDesignerFlags;
procedure UpdateDesignerFlags(APageIndex: integer);
procedure DoImageListDestroyResolutionHandle(Sender: TCustomImageList;
@ -503,9 +505,9 @@ type
property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False;
property ShowTabs: Boolean read FShowTabs write SetShowTabs default True;
property Style: TTabStyle read FStyle write SetStyle default tsTabs;
property TabHeight: Smallint read FTabHeight write SetTabHeight default 0;
property TabHeight: Smallint read FTabHeight write SetTabHeight stored TabHeightIsStored;
property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop;
property TabWidth: Smallint read FTabWidth write SetTabWidth default 0;
property TabWidth: Smallint read FTabWidth write SetTabWidth stored TabWidthIsStored;
published
property TabStop default true;
end;

14
lcl/include/customnotebook.inc
View File

@ -843,6 +843,11 @@ begin
DoSendTabSize;
end;
function TCustoMTabControl.TabHeightIsStored: Boolean;
begin
Result := TabHeight > 0;
end;
{------------------------------------------------------------------------------
TCustomTabControl SetTabPosition
------------------------------------------------------------------------------}
@ -864,6 +869,11 @@ begin
DoSendTabSize;
end;
function TCustomTabControl.TabWidthIsStored: Boolean;
begin
Result := TabWidth > 0;
end;
{------------------------------------------------------------------------------
procedure TCustomTabControl.UpdateAllDesignerFlags;
------------------------------------------------------------------------------}
@ -1047,6 +1057,10 @@ begin
begin
if Assigned(Images) then
DoImageListChange(Self);
if TabHeightIsStored then
TabHeight := Round(TabHeight * AYProportion);
if TabWidthIsStored then
TabWidth := Round(TabWidth * AXProportion);
end;
end;