designer: disable snapping when Alt key is pressed (issue #0001974)

git-svn-id: trunk@26910 -

designer/controlselection.pp

@@ -414,8 +414,8 @@ type
     procedure UpdateBounds;
     procedure RestoreBounds;
 
-    procedure MoveSelection(dx, dy: integer);
+    function MoveSelection(dx, dy: integer; TotalDeltas: Boolean): Boolean;
-    function MoveSelectionWithSnapping(TotalDX, TotalDY: integer): boolean;
+    function MoveSelectionWithSnapping(TotalDx, TotalDy: integer): Boolean;
     procedure SizeSelection(dx, dy: integer);
     procedure SetBounds(NewLeft,NewTop,NewWidth,NewHeight: integer);
     procedure AlignComponents(HorizAlignment,VertAlignment:TComponentAlignment);
@@ -1678,19 +1678,20 @@ begin
     Result:=ABottom;
 end;
 
-function TControlSelection.SnapGrabberMousePos(const CurMousePos: TPoint
+function TControlSelection.SnapGrabberMousePos(const CurMousePos: TPoint): TPoint;
-  ): TPoint;
 begin
-  Result:=CurMousePos;
+  Result := CurMousePos;
-  if (not EnvironmentOptions.SnapToGrid) or (ActiveGrabber=nil) then exit;
+  if (not EnvironmentOptions.SnapToGrid) or (ActiveGrabber = nil) then exit;
   if gpLeft in ActiveGrabber.Positions then
-    Result.X:=FindNearestSnapLeft(Result.X)
+    Result.X := FindNearestSnapLeft(Result.X)
-  else if gpRight in ActiveGrabber.Positions then
+  else
-    Result.X:=FindNearestSnapRight(Result.X);
+  if gpRight in ActiveGrabber.Positions then
+    Result.X := FindNearestSnapRight(Result.X);
   if gpTop in ActiveGrabber.Positions then
-    Result.Y:=FindNearestSnapTop(Result.Y)
+    Result.Y := FindNearestSnapTop(Result.Y)
-  else if gpBottom in ActiveGrabber.Positions then
+  else
-    Result.Y:=FindNearestSnapBottom(Result.Y);
+  if gpBottom in ActiveGrabber.Positions then
+    Result.Y := FindNearestSnapBottom(Result.Y);
 end;
 
 function TControlSelection.GetLeftGuideLine(var ALine: TRect): boolean;
@@ -2169,44 +2170,60 @@ begin
   Result:=(Count=1) and (Items[0].Persistent=APersistent);
 end;
 
-procedure TControlSelection.MoveSelection(dx, dy: integer);
+function TControlSelection.MoveSelection(dx, dy: integer; TotalDeltas: Boolean): Boolean;
-begin
-  if (Count=0) or (IsResizing) then exit;
-  if (dx=0) and (dy=0) then exit;
-  //DebugLn('[TControlSelection.MoveSelection] A  %d,%d',[dx,dy]);
-  BeginResizing;
-  //DebugLn('[TControlSelection.MoveSelection] B  %d',[FResizeLockCount]);
-  inc(FLeft,dx);
-  inc(FTop,dy);
-  EndResizing(true);
-end;
-
-function TControlSelection.MoveSelectionWithSnapping(TotalDX, TotalDY: integer
-  ): boolean;
 var
   NewLeft, NewTop: integer;
 begin
-  Result:=false;
+  Result := False;
-  if (Count=0) or (IsResizing) then exit;
+  if (Count = 0) or IsResizing then Exit;
-  NewLeft:=FindNearestSnapLeft(FOldLeft+TotalDX,FWidth);
+  //DebugLn('[TControlSelection.MoveSelection] A  %d,%d',[dx,dy]);
-  NewTop:=FindNearestSnapTop(FOldTop+TotalDY,FHeight);
+  //DebugLn('[TControlSelection.MoveSelection] B  %d',[FResizeLockCount]);
+  if TotalDeltas then
+  begin
+    NewLeft := FOldLeft + dx;
+    NewTop := FOldTop + dy;
+  end
+  else
+  begin
+    NewLeft := FLeft + dx;
+    NewTop := FTop + dy
+  end;
+  if (NewLeft <> FLeft) or (NewTop <> FTop) then
+  begin
+    Result := True;
+    BeginResizing;
+    FLeft := NewLeft;
+    FTop := NewTop;
+    EndResizing(True);
+  end;
+end;
+
+function TControlSelection.MoveSelectionWithSnapping(TotalDx, TotalDy: integer): boolean;
+var
+  NewLeft, NewTop: integer;
+begin
+  Result := False;
+  if (Count = 0) or IsResizing then Exit;
+  NewLeft := FindNearestSnapLeft(FOldLeft + TotalDx, FWidth);
+  NewTop := FindNearestSnapTop(FOldTop + TotalDy, FHeight);
   {$IFDEF VerboseDesigner}
   DebugLn('[TControlSelection.MoveSelectionWithSnapping] A  ',
-    'TotalD='+dbgs(TotalDX)+','+dbgs(TotalDY),
+    'TotalD='+dbgs(TotalDx)+','+dbgs(TotalDy),
     ' CurBounds='+dbgs(FLeft)+','+dbgs(FTop)+','+dbgs(FWidth)+','+dbgs(FHeight),
     ' OldBounds='+dbgs(FOldLeft)+','+dbgs(FOldTop)+','+dbgs(FOldWidth)+','+dbgs(FOldHeight)
     +' NewPos='+dbgs(NewLeft)+','+dbgs(NewTop));
   {$ENDIF}
-  if (NewLeft<>FLeft) or (NewTop<>FTop) then begin
+  if (NewLeft <> FLeft) or (NewTop <> FTop) then
-    Result:=true;
+  begin
+    Result := True;
     BeginResizing;
-    FLeft:=NewLeft;
+    FLeft := NewLeft;
-    FTop:=NewTop;
+    FTop := NewTop;
     {$IFDEF VerboseDesigner}
     DebugLn('[TControlSelection.MoveSelectionWithSnapping] B  ',
       ' Bounds='+dbgs(FLeft)+','+dbgs(FTop)+','+dbgs(FWidth)+','+dbgs(FHeight));
     {$ENDIF}
-    EndResizing(true);
+    EndResizing(True);
   end;
 end;
 

designer/designer.pp

@@ -670,7 +670,7 @@ begin
   {$ENDIF}
   if (ControlSelection.SelectionForm<>Form)
   or ControlSelection.LookupRootSelected then exit;
-  ControlSelection.MoveSelection(DiffX, DiffY);
+  ControlSelection.MoveSelection(DiffX, DiffY, False);
   Modified;
 end;
 
@@ -1600,61 +1600,64 @@ procedure TDesigner.GetMouseMsgShift(TheMessage: TLMMouse;
 begin
   Shift := [];
   if (TheMessage.Keys and MK_Shift) = MK_Shift then
-    Include(Shift,ssShift);
+    Include(Shift, ssShift);
   if (TheMessage.Keys and MK_Control) = MK_Control then
-    Include(Shift,ssCtrl);
+    Include(Shift, ssCtrl);
+
+  if GetKeyState(VK_MENU) < 0 then Include(Shift, ssAlt);
+  if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Shift, ssMeta);
 
   case TheMessage.Msg of
   LM_LBUTTONUP,LM_LBUTTONDBLCLK,LM_LBUTTONTRIPLECLK,LM_LBUTTONQUADCLK:
     begin
-      Include(Shift,ssLeft);
+      Include(Shift, ssLeft);
-      Button:=mbLeft;
+      Button := mbLeft;
     end;
   LM_MBUTTONUP,LM_MBUTTONDBLCLK,LM_MBUTTONTRIPLECLK,LM_MBUTTONQUADCLK:
     begin
-      Include(Shift,ssMiddle);
+      Include(Shift, ssMiddle);
-      Button:=mbMiddle;
+      Button := mbMiddle;
     end;
   LM_RBUTTONUP,LM_RBUTTONDBLCLK,LM_RBUTTONTRIPLECLK,LM_RBUTTONQUADCLK:
     begin
-      Include(Shift,ssRight);
+      Include(Shift, ssRight);
-      Button:=mbRight;
+      Button := mbRight;
     end;
   else
     if (TheMessage.Keys and MK_MButton) <> 0 then
     begin
-      Include(Shift,ssMiddle);
+      Include(Shift, ssMiddle);
-      Button:=mbMiddle;
+      Button := mbMiddle;
     end;
     if (TheMessage.Keys and MK_RButton) <> 0 then
     begin
-      Include(Shift,ssRight);
+      Include(Shift, ssRight);
-      Button:=mbRight;
+      Button := mbRight;
     end;
     if (TheMessage.Keys and MK_LButton) <> 0 then
     begin
-      Include(Shift,ssLeft);
+      Include(Shift, ssLeft);
-      Button:=mbLeft;
+      Button := mbLeft;
     end;
     if (TheMessage.Keys and MK_XBUTTON1) <> 0 then
     begin
-      Include(Shift,ssExtra1);
+      Include(Shift, ssExtra1);
-      Button:=mbExtra1;
+      Button := mbExtra1;
     end;
     if (TheMessage.Keys and MK_XBUTTON2) <> 0 then
     begin
-      Include(Shift,ssExtra2);
+      Include(Shift, ssExtra2);
-      Button:=mbExtra2;
+      Button := mbExtra2;
     end;
   end;
 
   case TheMessage.Msg of
   LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK,LM_XBUTTONDBLCLK:
-    Include(Shift,ssDouble);
+    Include(Shift, ssDouble);
   LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK,LM_XBUTTONTRIPLECLK:
-    Include(Shift,ssTriple);
+    Include(Shift, ssTriple);
   LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK,LM_XBUTTONQUADCLK:
-    Include(Shift,ssQuad);
+    Include(Shift, ssQuad);
   end;
 end;
 
@@ -2251,9 +2254,9 @@ begin
   begin
     if Grabber = nil then
       ACursor := crDefault
-    else begin
+    else
       ACursor := Grabber.Cursor;
-    end;
+
     if ACursor <> LastFormCursor then
     begin
       LastFormCursor := ACursor;
@@ -2276,8 +2279,17 @@ begin
             ControlSelection.SaveBounds;
             Include(FFlags, dfHasSized);
           end;
-          OldSnappedMousePos := ControlSelection.SnapGrabberMousePos(OldMouseMovePos);
+          // skip snapping when Alt is pressed
-          CurSnappedMousePos:= ControlSelection.SnapGrabberMousePos(LastMouseMovePos);
+          if not (ssAlt in Shift) then
+          begin
+            OldSnappedMousePos := ControlSelection.SnapGrabberMousePos(OldMouseMovePos);
+            CurSnappedMousePos := ControlSelection.SnapGrabberMousePos(LastMouseMovePos);
+          end
+          else
+          begin
+            OldSnappedMousePos := OldMouseMovePos;
+            CurSnappedMousePos := LastMouseMovePos;
+          end;
           ControlSelection.SizeSelection(
             CurSnappedMousePos.X - OldSnappedMousePos.X,
             CurSnappedMousePos.Y - OldSnappedMousePos.Y);
@@ -2289,7 +2301,7 @@ begin
         SelectedCompClass := GetSelectedComponentClass;
         if (not ControlSelection.RubberBandActive) and
            (SelectedCompClass=nil) and
-           (Shift=[ssLeft]) and
+           ((Shift=[ssLeft]) or (Shift=[ssAlt, ssLeft])) and
            (ControlSelection.Count>=1) and
            (not ControlSelection.LookupRootSelected) then
         begin // move selection
@@ -2299,9 +2311,8 @@ begin
             Include(FFlags, dfHasSized);
           end;
           //debugln('TDesigner.MouseMoveOnControl Move MouseDownComponent=',dbgsName(MouseDownComponent),' OldMouseMovePos=',dbgs(OldMouseMovePos),' MouseMovePos',dbgs(LastMouseMovePos),' MouseDownPos=',dbgs(MouseDownPos));
-          if ControlSelection.MoveSelectionWithSnapping(
+          if ((ssAlt in Shift) and ControlSelection.MoveSelection(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y, True)) or
-              LastMouseMovePos.X - MouseDownPos.X,
+             ControlSelection.MoveSelectionWithSnapping(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y) then
-              LastMouseMovePos.Y - MouseDownPos.Y) then
             DoModified;
         end
         else
@@ -2880,7 +2891,7 @@ end;
 
 procedure TDesigner.OnSnapToGridOptionMenuClick(Sender: TObject);
 begin
-  EnvironmentOptions.SnapToGrid:=not EnvironmentOptions.SnapToGrid;
+  EnvironmentOptions.SnapToGrid := not EnvironmentOptions.SnapToGrid;
 end;
 
 procedure TDesigner.OnShowOptionsMenuItemClick(Sender: TObject);
@@ -2890,7 +2901,7 @@ end;
 
 procedure TDesigner.OnSnapToGuideLinesOptionMenuClick(Sender: TObject);
 begin
-  EnvironmentOptions.SnapToGuideLines:=not EnvironmentOptions.SnapToGuideLines;
+  EnvironmentOptions.SnapToGuideLines := not EnvironmentOptions.SnapToGuideLines;
 end;
 
 procedure TDesigner.OnViewLFMMenuClick(Sender: TObject);
@@ -2978,7 +2989,7 @@ end;
 
 function TDesigner.GetSnapToGrid: boolean;
 begin
-  Result:=EnvironmentOptions.SnapToGrid;
+  Result := EnvironmentOptions.SnapToGrid;
 end;
 
 procedure TDesigner.SetShowGrid(const AValue: boolean);