From b83838139d0de7f777b3f68a174445f0ad2d1d5a Mon Sep 17 00:00:00 2001 From: Martok Date: Thu, 16 Jun 2022 22:13:53 +0200 Subject: [PATCH] lcl: implement window snapping / magnetic borders --- lcl/forms.pp | 51 ++++++++ lcl/include/customform.inc | 2 + lcl/include/screen.inc | 2 + lcl/include/windowmagnet.inc | 229 +++++++++++++++++++++++++++++++++++ 4 files changed, 284 insertions(+) create mode 100644 lcl/include/windowmagnet.inc diff --git a/lcl/forms.pp b/lcl/forms.pp index ce26a9403d..43e8b5f682 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -86,6 +86,7 @@ type TIDesigner = class; TMonitor = class; TScrollingWinControl = class; + TCustomForm = class; { Hint actions } @@ -415,6 +416,41 @@ type end; + { TWindowMagnetOptions } + + TWindowMagnetOptions = class(TPersistent) + private + FSnapMonitor: boolean; + FSnapForms: boolean; + FSnapFormTarget: boolean; + FDistance: integer; + public + constructor Create; + published + property SnapToMonitor: boolean read FSnapMonitor write FSnapMonitor default false; + property SnapToForms: boolean read FSnapForms write FSnapForms default false; + property SnapFormTarget: boolean read FSnapFormTarget write FSnapFormTarget default true; + property Distance: integer read FDistance write FDistance default 10; + end; + + { TWindowMagnetManager } + + TWindowMagnetManager = class + private + FEnabled: boolean; + FActiveForm: TCustomForm; + FPreviousSource, FPreviousReturn: TWindowPos; + 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; + function SnapToForms(Opts: TWindowMagnetOptions; var WindowPos: TWindowPos): boolean; + public + constructor Create; + property Enabled: boolean read FEnabled write FEnabled; + function SnapForm(Form: TCustomForm; var WindowPos: TWindowPos): boolean; + end; + + { TCustomForm } TBorderIcon = ( // Form title bar items @@ -530,6 +566,7 @@ type FDelayedEventCtr: Integer; FDelayedOnChangeBounds, FDelayedOnResize: Boolean; FIsFirstOnShow, FIsFirstOnActivate: Boolean; + FSnapOptions: TWindowMagnetOptions; function GetClientHandle: HWND; function GetEffectiveShowInTaskBar: TShowInTaskBar; function GetMonitor: TMonitor; @@ -568,12 +605,17 @@ type function FindDefaultForActiveControl: TWinControl; procedure UpdateMenu; procedure UpdateShowInTaskBar; + function GetScreenSnap: boolean; + procedure SetScreenSnap(aValue: boolean); + function GetSnapBuffer: integer; + procedure SetSnapBuffer(aValue: integer); protected procedure WMActivate(var Message : TLMActivate); message LM_ACTIVATE; procedure WMCloseQuery(var message: TLMessage); message LM_CLOSEQUERY; procedure WMHelp(var Message: TLMHelp); message LM_HELP; procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW; procedure WMSize(var message: TLMSize); message LM_Size; + procedure WMWindowPosChanging(var Message: TLMWindowPosChanging); message LM_WINDOWPOSCHANGING; procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED; @@ -753,6 +795,9 @@ type property LastActiveControl: TWinControl read FLastActiveControl; property PopupMode: TPopupMode read FPopupMode write SetPopupMode default pmNone; property PopupParent: TCustomForm read FPopupParent write SetPopupParent; + property SnapOptions: TWindowMagnetOptions read FSnapOptions; + property ScreenSnap: boolean read GetScreenSnap write SetScreenSnap stored false; + property SnapBuffer: integer read GetSnapBuffer write SetSnapBuffer stored false; property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; property OnClose: TCloseEvent read FOnClose write FOnClose stored IsForm; @@ -898,8 +943,11 @@ type property PopupParent; property Position; property SessionProperties; + property ScreenSnap; property ShowHint; property ShowInTaskBar; + property SnapBuffer; + property SnapOptions; property UseDockManager; property LCLVersion: string read FLCLVersion write FLCLVersion stored LCLVersionIsStored; property Scaled; @@ -1102,6 +1150,7 @@ type FPixelsPerInch : Integer; FSaveFocusedList: TFPList; FSystemFont: TFont; + FMagnetManager: TWindowMagnetManager; procedure DeleteCursor(AIndex: Integer); procedure DestroyCursors; procedure DestroyMonitors; @@ -1157,6 +1206,7 @@ type function GetIconFont: TFont; virtual; function GetMenuFont: TFont; virtual; function GetSystemFont: TFont; virtual; + property MagnetManager: TWindowMagnetManager read FMagnetManager; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; @@ -2323,6 +2373,7 @@ end; {$I application.inc} {$I applicationproperties.inc} {$I hintwindow.inc} +{$I windowmagnet.inc} //============================================================================== diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index f9c6bc5a1f..853e4dde5f 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -131,6 +131,7 @@ begin FreeIconHandles; Screen.RemoveForm(Self); FreeThenNil(FActionLists); + FreeThenNil(FSnapOptions); for HandlerType:=Low(FFormHandlers) to High(FFormHandlers) do FreeThenNil(FFormHandlers[HandlerType]); //DebugLn('[TCustomForm.Destroy] B ',Name,':',ClassName); @@ -2083,6 +2084,7 @@ begin FloatingDockSiteClass := TWinControlClass(ClassType); Screen.AddForm(Self); FAllowDropFiles := False; + FSnapOptions:= TWindowMagnetOptions.Create; if ParentBiDiMode then BiDiMode := Application.BidiMode; diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc index bd8d284131..65e3fabeef 100644 --- a/lcl/include/screen.inc +++ b/lcl/include/screen.inc @@ -71,6 +71,7 @@ begin FDataModuleList := TFPList.Create; FPixelsPerInch := ScreenInfo.PixelsPerInchX; FSaveFocusedList := TFPList.Create; + FMagnetManager := TWindowMagnetManager.Create; AddDataModule := @DoAddDataModule; RemoveDataModule := @DoRemoveDataModule; @@ -102,6 +103,7 @@ begin FreeThenNil(FCustomFormsZOrdered); FreeThenNil(FSaveFocusedList); FreeThenNil(FFonts); + FreeThenNil(FMagnetManager); // DestroyCursors; - free on widgetset free FCursorMap.Free; FMonitors.Free; diff --git a/lcl/include/windowmagnet.inc b/lcl/include/windowmagnet.inc new file mode 100644 index 0000000000..4ee53a6fba --- /dev/null +++ b/lcl/include/windowmagnet.inc @@ -0,0 +1,229 @@ +{%MainUnit ../forms.pp} + +{ TWindowMagnetManager + + ***************************************************************************** + This file is part of the Lazarus Component Library (LCL) + + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** +} + +{ TWindowMagnetOptions } + +constructor TWindowMagnetOptions.Create; +begin + inherited; + FSnapMonitor:= false; + FSnapForms:= false; + FSnapFormTarget:= true; + FDistance:= 10; +end; + +{ TWindowMagnetManager } + +function PosToRect(wp: TWindowPos): TRect; +begin + Result.Left:= wp.x; + Result.Top:= wp.y; + Result.Right:= wp.x + wp.cx; + Result.Bottom:= wp.y + wp.cy; +end; + +constructor TWindowMagnetManager.Create; +begin + inherited Create; + FEnabled:= true; + FActiveForm:= nil; + FPreviousSource:= Default(TWindowPos); + FPreviousReturn:= Default(TWindowPos); +end; + +function TWindowMagnetManager.SnapForm(Form: TCustomForm; var WindowPos: TWindowPos): boolean; +var + SrcPos: TWindowPos; +begin + Result:= false; + // FIXME: compiler bug? generates nonsensical comps if done in one statement + if not FEnabled then Exit; + if ((WindowPos.flags and SWP_SHOWWINDOW) > 0) then Exit; + if ((WindowPos.flags and SWP_HIDEWINDOW) > 0) then Exit; + if (Form.ComponentState * [csDestroying, csDesigning, csLoading] <> []) then Exit; + if not (Form.SnapOptions.SnapToMonitor or Form.SnapOptions.SnapToForms) then Exit; + + SrcPos:= WindowPos; + if Form <> FActiveForm then begin + FActiveForm:= Form; + FPreviousSource:= WindowPos; + FPreviousReturn:= WindowPos; + Exit; + end; + + Result:= SnapToMonitor(Form.SnapOptions, WindowPos) or + SnapToForms(Form.SnapOptions, WindowPos); + + FPreviousSource:= SrcPos; + FPreviousReturn:= WindowPos; +end; + +function TWindowMagnetManager.SnapToSides(var x, cx: integer; px, pcx, pxout, pcxout: integer; dist: integer; leftsides, rightsides: TIntegerDynArray): boolean; +var + Moving, Resizing: Boolean; + goal: Integer; +begin + Result:= False; + Moving:= x <> px; + Resizing:= cx <> pcx; + + try + if Resizing and Moving then begin + // Resizing Left Edge + for goal in leftsides do begin + Result:= Abs(x - goal) < dist; + if Result then begin + Inc(cx, x - goal); + x:= goal; + Exit; + end; + end; + end else + if Resizing then begin + // Resizing Right Edge + for goal in rightsides do begin + Result:= Abs(x + cx - goal) < dist; + if Result then begin + cx:= goal - x; + Exit; + end; + end; + end else + if Moving then begin + // Moving Left Edge + for goal in leftsides do begin + Result:= Abs(x - goal) < dist; + if Result then begin + x:= goal; + Exit; + end; + end; + // Moving Right Edge + for goal in rightsides do begin + Result:= Abs(x + cx - goal) < dist; + if Result then begin + x:= goal - cx; + Exit; + end; + end; + end else begin + // No change on this axis + x:= pxout; + cx:= pcxout; + end; + finally + Result:= Result and ((x<>pcxout) or (cx<>pcxout)); + end; +end; + +function TWindowMagnetManager.SnapToMonitor(Opts: TWindowMagnetOptions; var WindowPos: TWindowPos): boolean; +var + Rect, Area: TRect; +begin + Result:= False; + if not Opts.SnapToMonitor then + Exit; + Rect:= PosToRect(WindowPos); + 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]); +{$pop} +end; + +function TWindowMagnetManager.SnapToForms(Opts: TWindowMagnetOptions; var WindowPos: TWindowPos): boolean; + + procedure Append(Item: integer; var List: TIntegerDynArray); + begin + Insert(Item, List, Length(List)); + end; + + procedure AddGoals(wtop, wbot, otop, obot, oleft, oright, mleft, mright: 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 + // already magnetised on L-R axis, include top-top/bottom-bottom align goals + Append(otop, snapup); + Append(obot, snapdown); + end; + end; + end; + +var + Rect, br, PrevRect: TRect; + SnapTo: array[0..3] of TIntegerDynArray; // CSS order: t,r,b,l + fi: Integer; + frm: TCustomForm; +begin + Result:= False; + if not Opts.SnapToForms then + Exit; + Rect:= PosToRect(WindowPos); + PrevRect:= PosToRect(FPreviousReturn); + + SnapTo[0]:= nil; + SnapTo[1]:= nil; + SnapTo[2]:= nil; + SnapTo[3]:= nil; + + for fi:= 0 to Screen.CustomFormCount - 1 do begin + frm:= Screen.CustomForms[fi]; + if frm.Handle = WindowPos.hwnd then continue; + 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]); + // 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]); + end; + +{$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, SnapTo[3], SnapTo[1]) or + SnapToSides(WindowPos.y, WindowPos.cy, FPreviousSource.y, FPreviousSource.cy, FPreviousReturn.y, FPreviousReturn.cy, Opts.Distance, SnapTo[0], SnapTo[2]); +{$pop} +end; + + +{ TCustomForm } + +function TCustomForm.GetScreenSnap: boolean; +begin + Result:= FSnapOptions.SnapToMonitor; +end; + +function TCustomForm.GetSnapBuffer: integer; +begin + Result:= FSnapOptions.Distance; +end; + +procedure TCustomForm.SetScreenSnap(aValue: boolean); +begin + FSnapOptions.SnapToMonitor:= aValue; +end; + +procedure TCustomForm.SetSnapBuffer(aValue: integer); +begin + FSnapOptions.Distance:= aValue; +end; + +procedure TCustomForm.WMWindowPosChanging(var Message: TLMWindowPosChanging); +begin + Screen.MagnetManager.SnapForm(Self, Message.WindowPos^); +end; + + +// included by forms.pp