From da8aa820039242d9ffdb4fdb43bc73c855e2b19d Mon Sep 17 00:00:00 2001 From: Martok Date: Sat, 20 Aug 2022 01:10:18 +0200 Subject: [PATCH] lcl: consider compositor/DWM extended frame for snapping --- lcl/forms.pp | 1 + lcl/include/intfbasewinapi.inc | 6 +++++ lcl/include/winapi.inc | 5 ++++ lcl/include/winapih.inc | 1 + lcl/include/windowmagnet.inc | 34 ++++++++++++++++------- lcl/interfaces/win32/win32int.pp | 6 ++++- lcl/interfaces/win32/win32winapi.inc | 39 +++++++++++++++++++++++++++ lcl/interfaces/win32/win32winapih.inc | 1 + 8 files changed, 82 insertions(+), 11 deletions(-) diff --git a/lcl/forms.pp b/lcl/forms.pp index ee2882bb30..516ada68d1 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -441,6 +441,7 @@ type FEnabled: boolean; FActiveForm: TCustomForm; FPreviousSource, FPreviousReturn: TWindowPos; + FCompositorBorders: TRect; protected function SnapToSides(var x, cx: integer; px, pcx, pxout, pcxout: integer; dist: integer; leftsides, rightsides: TIntegerDynArray): boolean; function SnapToMonitor(Opts: TWindowMagnetOptions; var WindowPos: TWindowPos): boolean; diff --git a/lcl/include/intfbasewinapi.inc b/lcl/include/intfbasewinapi.inc index ede34c7a90..d3b36ca851 100644 --- a/lcl/include/intfbasewinapi.inc +++ b/lcl/include/intfbasewinapi.inc @@ -968,6 +968,12 @@ begin Result := -1; end; +function TWidgetSet.GetCompositorExtendedBorder(handle : HWND; var Borders: TRect) : Boolean; +begin + Borders:= Rect(0,0,0,0); + Result:= True; +end; + function TWidgetSet.GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; begin Result := 0; diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index f5c05e1333..886b448662 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -360,6 +360,11 @@ begin Result := WidgetSet.GetClipRGN(DC, RGN); end; +function GetCompositorExtendedBorder(handle : HWND; var Borders: TRect) : Boolean; +begin + Result := WidgetSet.GetCompositorExtendedBorder(handle, Borders); +end; + function GetCursorPos(var lpPoint:TPoint): Boolean; begin Result := WidgetSet.GetCursorPos(lpPoint); diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index 3571765f8a..e4659fb9d7 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -116,6 +116,7 @@ function GetCaretPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtu function GetClientRect(handle : HWND; var Rect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetClipBox(DC : hDC; lpRect : PRect) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function GetCompositorExtendedBorder(handle : HWND; var Borders: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetCursorPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} //pbd diff --git a/lcl/include/windowmagnet.inc b/lcl/include/windowmagnet.inc index 07576db5cd..8bb6cab728 100644 --- a/lcl/include/windowmagnet.inc +++ b/lcl/include/windowmagnet.inc @@ -49,6 +49,7 @@ begin FActiveForm:= nil; FPreviousSource:= Default(TWindowPos); FPreviousReturn:= Default(TWindowPos); + FCompositorBorders:= Rect(0, 0, 0, 0); end; function TWindowMagnetManager.SnapForm(Form: TCustomForm; var WindowPos: TWindowPos): boolean; @@ -71,6 +72,9 @@ begin Exit; end; + if not GetCompositorExtendedBorder(Form.Handle, FCompositorBorders) then + FCompositorBorders:= Rect(0, 0, 0, 0); + Result:= SnapToMonitor(Form.SnapOptions, WindowPos) or SnapToForms(Form.SnapOptions, WindowPos); @@ -147,8 +151,10 @@ begin Area:= Screen.MonitorFromRect(Rect).WorkareaRect; {$push} {$BoolEval on} // do not short-circuit, SnapToSides has sideffects that must take place either way - Result:= SnapToSides(WindowPos.x, WindowPos.cx, FPreviousSource.x, FPreviousSource.cx, FPreviousReturn.x, FPreviousReturn.cx, Opts.Distance, [Area.Left], [Area.Right]) or - SnapToSides(WindowPos.y, WindowPos.cy, FPreviousSource.y, FPreviousSource.cy, FPreviousReturn.y, FPreviousReturn.cy, Opts.Distance, [Area.Top], [Area.Bottom]); + Result:= SnapToSides(WindowPos.x, WindowPos.cx, FPreviousSource.x, FPreviousSource.cx, FPreviousReturn.x, FPreviousReturn.cx, + Opts.Distance, [Area.Left - FCompositorBorders.Left], [Area.Right + FCompositorBorders.Right]) or + SnapToSides(WindowPos.y, WindowPos.cy, FPreviousSource.y, FPreviousSource.cy, FPreviousReturn.y, FPreviousReturn.cy, + Opts.Distance, [Area.Top - FCompositorBorders.Top], [Area.Bottom + FCompositorBorders.Bottom]); {$pop} end; @@ -159,13 +165,17 @@ function TWindowMagnetManager.SnapToForms(Opts: TWindowMagnetOptions; var Window Insert(Item, List, Length(List)); end; - procedure AddGoals(wtop, wbot, otop, obot, oleft, oright, mleft, mright: integer; var snapleft, snapright, snapup, snapdown: TIntegerDynArray); + procedure AddGoals(wtop, wbot, otop, obot, oleft, oright, mleft, mright, + btop, bbot, bleft, bright: integer; + var snapleft, snapright, snapup, snapdown: TIntegerDynArray); begin - // is there any overlap? - if (wtop < obot) and (wbot > otop) then begin - Append(oleft, snapright); - Append(oright, snapleft); - if (oleft = mright) or (oright = mleft) then begin + // is there any true overlap? + if (wtop + btop < obot - bbot) and (wbot - bbot > otop + btop) then begin + // add borders in order "apparent +- mine +- theirs" + Append(oleft + bright + bleft, snapright); + Append(oright - bleft - bright, snapleft); + if (oleft + bleft = mright - bright) or + (oright - bright = mleft + bleft) then begin // already magnetised on L-R axis, include top-top/bottom-bottom align goals Append(otop, snapup); Append(obot, snapdown); @@ -196,9 +206,13 @@ begin if not frm.SnapOptions.SnapFormTarget then continue; if GetWindowRect(frm.Handle, br) = 0 then continue; // Left-Right snapping - AddGoals(Rect.Top, Rect.Bottom, br.Top, br.Bottom, br.Left, br.Right, PrevRect.Left, PrevRect.Right, SnapTo[3], SnapTo[1], SnapTo[0], SnapTo[2]); + AddGoals(Rect.Top, Rect.Bottom, br.Top, br.Bottom, br.Left, br.Right, PrevRect.Left, PrevRect.Right, + FCompositorBorders.Top, FCompositorBorders.Bottom, FCompositorBorders.Left, FCompositorBorders.Right, + SnapTo[3], SnapTo[1], SnapTo[0], SnapTo[2]); // Up-Down snapping - AddGoals(Rect.Left, Rect.Right, br.Left, br.Right, br.Top, br.Bottom, PrevRect.Top, PrevRect.Bottom, SnapTo[0], SnapTo[2], SnapTo[3], SnapTo[1]); + AddGoals(Rect.Left, Rect.Right, br.Left, br.Right, br.Top, br.Bottom, PrevRect.Top, PrevRect.Bottom, + FCompositorBorders.Left, FCompositorBorders.Right, FCompositorBorders.Top, FCompositorBorders.Bottom, + SnapTo[0], SnapTo[2], SnapTo[3], SnapTo[1]); end; {$push} diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index addbb580fd..18de1fe852 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -30,7 +30,7 @@ interface } uses Windows, // keep as first - Classes, SysUtils, RtlConsts, ActiveX, MultiMon, CommCtrl, UxTheme, ctypes, + Classes, SysUtils, RtlConsts, ActiveX, MultiMon, CommCtrl, UxTheme, ctypes, DwmApi, {$IF FPC_FULLVERSION>=30000} character, {$ENDIF} @@ -563,6 +563,8 @@ initialization LCLCheckListboxClsName[L+L1] := #0; end; + InitDwmLibrary; + finalization if CurDoubleBuffer.Bitmap <> 0 then begin @@ -577,4 +579,6 @@ finalization Windows.UnregisterClassW(PWideChar( WideString(LCLComboboxClsName) ), System.HInstance); Windows.UnregisterClassW(PWideChar( WideString(LCLCheckListboxClsName) ), System.HInstance); end; + + FreeDwmLibrary; end. diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index d8d9f3f1ea..4042509893 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -1801,6 +1801,45 @@ begin Result := Windows.GetClipRGN(DC, RGN); end; + +{------------------------------------------------------------------------------ + Method: GetCompositorExtendedBorder + Params: + handle - A handle to a window + Borders - Record to recieve borders + Returns: If the function succeeds, return the internal border added by the compositor. Positive values indicate the window + appears smaller than it is. + If the function fails, Rect is unchanged. + Example: + If GetWindowRect returned Rect(0, 0, 1280, 1024) on Windows 10, the visible bounds rect is much smaller, with the difference + appearing as if it is not part of the window (transparent shadow). The "actual" frame is drawn at Rect(7, 0, 1273, 1017). + In this case, this function returns Rect(7, 0, 7, 7) + ------------------------------------------------------------------------------} + +function TWin32WidgetSet.GetCompositorExtendedBorder(handle : HWND; var Borders: TRect) : Boolean; +var + wr, efb: TRect; +begin + if not Assigned(DwmGetWindowAttribute) or not DwmCompositionEnabled then begin + // system does not have a compositor - no extended border + Borders:= Rect(0, 0, 0, 0); + Exit(True); + end; + + Result:= GetWindowRect(handle, wr) <> 0; + if not Result then + Exit; + + Result:= DwmGetWindowAttribute(handle, DWMWA_EXTENDED_FRAME_BOUNDS, @efb, sizeof(efb)) = S_OK; + if not Result then + Exit; + + Borders.Left:= efb.Left - wr.Left; + Borders.Top:= efb.Top - wr.Top; + Borders.Right:= wr.Right - efb.Right; + Borders.Bottom:= wr.Bottom - efb.Bottom; +end; + {------------------------------------------------------------------------------ Method: GetCurrentObject Params: diff --git a/lcl/interfaces/win32/win32winapih.inc b/lcl/interfaces/win32/win32winapih.inc index d2ac88cd7c..e75876505d 100644 --- a/lcl/interfaces/win32/win32winapih.inc +++ b/lcl/interfaces/win32/win32winapih.inc @@ -97,6 +97,7 @@ function GetClientBounds(Handle: HWND; Var Rect: TRect): Boolean; override; function GetClientRect(Handle: HWND; Var Rect: TRect): Boolean; override; function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override; function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override; +function GetCompositorExtendedBorder(handle : HWND; var Borders: TRect) : Boolean; override; function GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; override; function GetCursorPos(var LPPoint: TPoint): Boolean; override; function GetDC(HWnd: HWND): HDC; override;