lcl: implement window snapping / magnetic borders

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}
 
 
 //==============================================================================

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;

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;

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