lcl: consider compositor/DWM extended frame for snapping

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;

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;

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);

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

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
+  Result:= SnapToSides(WindowPos.x, WindowPos.cx, FPreviousSource.x, FPreviousSource.cx, FPreviousReturn.x, FPreviousReturn.cx,
-           SnapToSides(WindowPos.y, WindowPos.cy, FPreviousSource.y, FPreviousSource.cy, FPreviousReturn.y, FPreviousReturn.cy, Opts.Distance, [Area.Top], [Area.Bottom]);
+                       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?
+    // is there any true overlap?
-    if (wtop < obot) and (wbot > otop) then begin
+    if (wtop + btop < obot - bbot) and (wbot - bbot > otop + btop) then begin
-      Append(oleft, snapright);
+      // add borders in order "apparent +- mine +- theirs"
-      Append(oright, snapleft);
+      Append(oleft + bright + bleft, snapright);
-      if (oleft = mright) or (oright = mleft) then begin
+      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}

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.

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:

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;