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

lcl: consider compositor/DWM extended frame for snapping

Browse Source
This commit is contained in:
Martok 2022-08-20 01:10:18 +02:00 committed by Maxim Ganetsky
parent 0b50d7cfc2
commit da8aa82003
8 changed files with 82 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

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

6
lcl/include/intfbasewinapi.inc
View File

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

5
lcl/include/winapi.inc
View File

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

1
lcl/include/winapih.inc
View File

@ -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

34
lcl/include/windowmagnet.inc
View File

@ -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}

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

@ -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.

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

@ -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:

1
lcl/interfaces/win32/win32winapih.inc
View File

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