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

win32: fix form bounds for windows with multi-line main menus and/or scrollbars

Browse Source
This commit is contained in:
Ondrej Pokorny 2022-11-15 21:22:06 +01:00
parent 0c34cad9a0
commit 877d933344
3 changed files with 110 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
lcl/interfaces/win32/win32int.pp
View File

@ -280,8 +280,8 @@ function AdjustWindowRectExForDpi(const lpRect: LPRECT; dwStyle: DWORD; bMenu: B
function GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT;
function LoadIconWithScaleDown(hinst:HINST; pszName:LPCWStr;cx:cint;cy:cint;var phico: HICON ):HRESULT;
procedure AdjustFormBounds(const AHandle: HANDLE; var ioSizeRect: TRect); overload;
procedure AdjustFormBounds(aHasMenu: Boolean; dwStyle, dwExStyle: DWORD; dpi: UINT; var ioSizeRect: TRect); overload;
procedure AdjustFormClientToWindowSize(const AHandle: HANDLE; var ioSize: TSize); overload;
procedure AdjustFormClientToWindowSize(aHasMenu: Boolean; dwStyle, dwExStyle: DWORD; dpi: UINT; var ioSize: TSize); overload;
implementation
@ -439,44 +439,68 @@ begin
Result := S_FALSE;
end;
procedure AdjustFormBounds(const AHandle: HANDLE; var ioSizeRect: TRect);
procedure AdjustFormClientToWindowSize(const AHandle: HANDLE; var ioSize: TSize);
{$IFNDEF LCLRealFormBounds}
var
xClientRect, xWindowRect: TRect;
xClientRect, xWindowRect, xSR: TRect;
xNonClientDPI: UINT;
Info: tagWINDOWINFO;
xInfo: tagWINDOWINFO;
xTopLeft: TPoint;
xHasMenu: Boolean;
xReplaceTop: LongInt;
{$ENDIF}
begin
{$IFNDEF LCLRealFormBounds}
xClientRect := Default(TRect);
xWindowRect := Default(TRect);
if (AHandle<>0)
and GetClientRect(AHandle, xClientRect) and not xClientRect.IsEmpty
and (GetWindowRect(AHandle, xWindowRect)<>0) and not xWindowRect.IsEmpty then
begin
Inc(ioSizeRect.Right, xWindowRect.Width-xClientRect.Width);
Inc(ioSizeRect.Bottom, xWindowRect.Height-xClientRect.Height);
Exit; // the sizes could be obtained from window-client -> exit
end;
// convert form client size to window size
// the difference between Windows.GetClientRect(AHandle, xClientRect) and Windows.GetWindowRect(AHandle, xWindowRect)
// must not be used because it fails when the form has visible scrollbars (and can be scrolled)
// the sizes could not be obtained from window-client (e.g. the window is minimized) -> calculate default
if (AHandle<>0) and AreDpiAwarenessContextsEqual(GetThreadDpiAwarenessContext, DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2) then
if AreDpiAwarenessContextsEqual(GetThreadDpiAwarenessContext, DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2) then
xNonClientDPI := GetDpiForWindow(AHandle)
else
xNonClientDPI := ScreenInfo.PixelsPerInchX;
Info := Default(tagWINDOWINFO);
Info.cbSize := SizeOf(Info);
if GetWindowInfo(AHandle, @Info) then
AdjustWindowRectExForDpi(@ioSizeRect, Info.dwStyle, GetMenu(AHandle)<>0, Info.dwExStyle, xNonClientDPI);
xInfo := Default(tagWINDOWINFO);
xInfo.cbSize := SizeOf(xInfo);
if GetWindowInfo(AHandle, @xInfo) then
begin
xHasMenu := GetMenu(AHandle)<>0;
xTopLeft := Point(0, 0);
xClientRect := Default(TRect);
xWindowRect := Default(TRect);
// AdjustWindowRectExForDpi calculates only 1 menu line but on Win32 the menu can have multiple lines
// therefore get the top coordinate from ClientToScreen difference if possible (that is correct also when scrollbars are shown)
if xHasMenu
and Windows.GetClientRect(AHandle, xClientRect) and not xClientRect.IsEmpty // just to check that there is some client rect and ClientToScreen will return some sane results
and Windows.GetWindowRect(AHandle, xWindowRect) and not xWindowRect.IsEmpty
and Windows.ClientToScreen(AHandle, xTopLeft) then
begin
xReplaceTop := xTopLeft.Y-xWindowRect.Top;
xHasMenu := False;
end else
xReplaceTop := 0;
xSR := Rect(0, 0, 0, 0);
AdjustWindowRectExForDpi(@xSR, xInfo.dwStyle, xHasMenu, xInfo.dwExStyle, xNonClientDPI);
if xReplaceTop>0 then
xSR.Top := -xReplaceTop;
Inc(ioSize.cx, xSR.Width);
Inc(ioSize.cy, xSR.Height);
end;
{$ENDIF}
end;
procedure AdjustFormBounds(aHasMenu: Boolean; dwStyle, dwExStyle: DWORD; dpi: UINT; var ioSizeRect: TRect);
procedure AdjustFormClientToWindowSize(aHasMenu: Boolean; dwStyle, dwExStyle: DWORD; dpi: UINT; var ioSize: TSize);
var
SizeRect: TRect;
begin
{$IFNDEF LCLRealFormBounds}
// no known handle -> default (1 menu line)
AdjustWindowRectExForDpi(@ioSizeRect, dwStyle, aHasMenu, dwExStyle, dpi);
SizeRect := Rect(0, 0, ioSize.Width, ioSize.Height);
AdjustWindowRectExForDpi(@SizeRect, dwStyle, aHasMenu, dwExStyle, dpi);
ioSize.Width := SizeRect.Width;
ioSize.Height := SizeRect.Height;
{$ENDIF}
end;

19
lcl/interfaces/win32/win32winapi.inc
View File

@ -2418,14 +2418,14 @@ function TWin32WidgetSet.GetWindowSize(Handle : hwnd;
procedure ExcludeBorder(dwStyle, dwExStyle: DWORD);
var
xRect: Windows.RECT;
xSize: Windows.SIZE;
begin
if (Height<>0) and (Width<>0) then
begin
xRect := Rect(0, 0, 0, 0);
AdjustFormBounds(GetMenu(Handle)<>0, dwStyle, dwExStyle, GetDpiForWindow(Handle), xRect);
Dec(Height, xRect.Height);
Dec(Width, xRect.Width);
xSize := TSize.Create(0, 0);
AdjustFormClientToWindowSize(Handle, xSize);
Dec(Height, xSize.Height);
Dec(Width, xSize.Width);
end;
end;
@ -2457,13 +2457,12 @@ begin
if Result then
begin
// for minimized window use normal position, in other case use rcWindow of WindowInfo
if (WP.showCmd<>SW_MINIMIZE) and (WP.showCmd<>SW_SHOWMINIMIZED) and not Info.rcClient.IsEmpty then
SetWidthHeightFromRect(Info.rcClient)
// DO NOT USE rcClient here because it is wrong if the form has scrollbars
if (WP.showCmd<>SW_MINIMIZE) and (WP.showCmd<>SW_SHOWMINIMIZED) then
SetWidthHeightFromRect(Info.rcWindow)
else
begin
SetWidthHeightFromRect(WP.rcNormalPosition);
ExcludeBorder(Info.dwStyle, Info.dwExStyle); // rcClient is not available -> get ExcludeBorder
end;
ExcludeBorder(Info.dwStyle, Info.dwExStyle);
//WriteLn('W = ', Width, ' H = ', Height);
Exit;
end;

92
lcl/interfaces/win32/win32wsforms.pp
View File

@ -122,7 +122,7 @@ type
published
end;
procedure AdjustFormBounds(const AForm: TCustomForm; var ioSizeRect: TRect); overload;
procedure AdjustFormClientToWindowSize(const AForm: TCustomForm; var ioSize: TSize); overload;
implementation
@ -305,29 +305,29 @@ begin
FlagsEx := FlagsEx or CalcBorderIconsFlagsEx(AForm);
end;
procedure AdjustFormBounds(const AForm: TCustomForm; var ioSizeRect: TRect); overload;
procedure AdjustFormClientToWindowSize(const AForm: TCustomForm; var ioSize: TSize);
var
xNonClientDPI: LCLType.UINT;
begin
if AForm.HandleAllocated then
AdjustFormBounds(AForm.Handle, ioSizeRect)
AdjustFormClientToWindowSize(AForm.Handle, ioSize)
else // default handling
AdjustFormBounds(AForm.Menu<>nil,
AdjustFormClientToWindowSize(AForm.Menu<>nil,
CalcBorderStyleFlags(AForm) or CalcBorderIconsFlags(AForm),
CalcBorderStyleFlagsEx(AForm) or CalcBorderIconsFlagsEx(AForm),
ScreenInfo.PixelsPerInchX, ioSizeRect);
ScreenInfo.PixelsPerInchX, ioSize);
end;
function CustomFormWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall;
procedure LCLFormSizeToWin32Size(AForm: TCustomForm; var AWidth, AHeight: Integer);
var
SizeRect: Windows.RECT;
Size: TSize;
begin
SizeRect := Classes.Rect(0, 0, AWidth, AHeight);
AdjustFormBounds(AForm, SizeRect);
AWidth := SizeRect.Width;
AHeight := SizeRect.Height;
Size := TSize.Create(AWidth, AHeight);
AdjustFormClientToWindowSize(AForm, Size);
AWidth := Size.Width;
AHeight := Size.Height;
end;
procedure SetMinMaxInfo(WinControl: TWinControl; var MinMaxInfo: TMINMAXINFO);
@ -420,6 +420,7 @@ var
Bounds: TRect;
SystemMenu: HMenu;
MaximizeForm: Boolean = False;
lSize: TSize;
begin
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
@ -471,7 +472,9 @@ begin
pClassName := @ClsName[0];
WindowTitle := StrCaption;
Bounds := lForm.BoundsRect;
AdjustFormBounds(lForm, Bounds);
lSize := Bounds.Size;
AdjustFormClientToWindowSize(lForm, lSize);
Bounds.Size := lSize;
if (lForm.Position in [poDefault, poDefaultPosOnly]) and not (csDesigning in lForm.ComponentState) then
begin
Left := CW_USEDEFAULT;
@ -643,41 +646,54 @@ class procedure TWin32WSCustomForm.SetBounds(const AWinControl: TWinControl;
var
AForm: TCustomForm absolute AWinControl;
CurRect: Windows.RECT = (Left: 0; Top: 0; Right: 0; Bottom: 0);
SizeRect: Windows.RECT;
lSize: Windows.SIZE;
L, T, W, H: Integer;
Attempt: 0..1; // 2 attempts
begin
// the LCL defines the size of a form without border, win32 with.
// -> adjust size according to BorderStyle
SizeRect := Bounds(ALeft, ATop, AWidth, AHeight);
AdjustFormBounds(AForm, SizeRect);
L := ALeft;
T := ATop;
W := SizeRect.Right - SizeRect.Left;
H := SizeRect.Bottom - SizeRect.Top;
// we are calling setbounds in TWinControl.Initialize
// if position is default it will be changed to designed. We do not want this.
if wcfInitializing in TWinControlAccess(AWinControl).FWinControlFlags then
// Problem:
// When setting the ClientRect, the main menu may change height (the menu lines may change).
// After the first attempt to set bounds, they can be wrong because the number of the lines changed and
// it is not possible to determine the menu line count for the target rectangle/
// Therefore a second attempt is needed to get the correct height.
for Attempt := Low(Attempt) to High(Attempt) do
begin
if GetWindowRect(AForm.Handle, CurRect) then
begin
if AForm.Position in [poDefault, poDefaultPosOnly] then
begin
L := CurRect.Left;
T := CurRect.Top;
end;
// the LCL defines the size of a form without border, win32 with.
// -> adjust size according to BorderStyle
lSize := TSize.Create(AWidth, AHeight);
if AForm.Position in [poDefault, poDefaultSizeOnly] then
AdjustFormClientToWindowSize(AForm, lSize);
L := ALeft;
T := ATop;
W := lSize.Width;
H := lSize.Height;
// we are calling setbounds in TWinControl.Initialize
// if position is default it will be changed to designed. We do not want this.
if wcfInitializing in TWinControlAccess(AWinControl).FWinControlFlags then
begin
if GetWindowRect(AForm.Handle, CurRect) then
begin
W := CurRect.Right - CurRect.Left;
H := CurRect.Bottom - CurRect.Top;
if AForm.Position in [poDefault, poDefaultPosOnly] then
begin
L := CurRect.Left;
T := CurRect.Top;
end;
if AForm.Position in [poDefault, poDefaultSizeOnly] then
begin
W := CurRect.Right - CurRect.Left;
H := CurRect.Bottom - CurRect.Top;
end;
end;
end;
// rect adjusted, pass to inherited to do real work
TWin32WSWinControl.SetBounds(AWinControl, L, T, W, H);
if (Attempt=High(Attempt)) // last one, no need to call GetClientRect
or not GetClientRect(AWinControl, CurRect) // not available
or ((CurRect.Width=AWidth) and (CurRect.Height=AHeight)) then // or correct size -> break
break;
end;
// rect adjusted, pass to inherited to do real work
TWin32WSWinControl.SetBounds(AWinControl, L, T, W, H);
end;
class procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);