Search code examples
delphidrawingcustom-controlsmousemouse-cursor

Snapping mouse cursor to a line in a Delphi custom control


I'm wondering how can I achieve horizontal (or vertical) snapping the mouse cursor to a line. For example, on the Facebook timeline feature, when you hover the mouse over the line down the center, it snaps the cursor to the center. Bringing the mouse close to the line snaps it too.

I'd like to wrap this inside of a single custom control, rather than controls of a form. There will be either a vertical or horizontal line, and it must snap the mouse cursor to it when it gets anywhere close. I will be adding events which return the position of the line which was clicked. This control will also have a scrollbar, either vertical or horizontal, parallel to this line, and both scrollbars will never show at the same time. There's a master property whether to display this line vertical or horizontal.

The mouse should not actually move position, but just the display of the cursor should somehow be tweaked to show it in the center of this line, while the actual X (or Y) position never changes. I don't want to move the cursor, I want to display the cursor in the center of this line if it gets anywhere close. While the cursor is in this snapped position, it will display another custom cursor instead of the standard (or default) arrow.

All I need to know is how to handle, within this control, the event of a mouse pointer coming in the vicinity of this line and tweak the display of the cursor to be in the center of this line.


Solution

  • Snapping requires you to snap something.

    • in AutoCAD the "cursor" is actually a horizontal and vertical line intersecting where the "cursor" is
    • Photoshop uses the Windows mouse, but snaps the effect to guidelines
    • Facebook snaps a little + sign to a spot on the timeline

    You need to track the mouse's position (i.e. OnMouseMove) and if the cursor is "close enough" you can then decide what to do.

    Here's a little sample program where i have an imaginary vertical line at 150px from the left. If i get close enough to that line, a little Facebook + appears:

    enter image description here

    const
        centerLine = 150; //"line" is at 150px from the left
        tolerance = 15; //15px on either size is about good.
    
    procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
        if IsMouseNearLine(x, y) then
        begin
            //We're on the centerline-ish. React by...
            //...changing the cursor to a <->
            Self.Cursor := crSizeWE;
    
            //and maybe let's put a "+" there, like Facebook
            if (FPlusLabel = nil) then
            begin
                FPlusLabel := TLabel.Create(Self);
                FPlusLabel.Parent := Self;
                FPlusLabel.Caption := '+';
                FPlusLabel.Alignment := taCenter;
                FPlusLabel.Font.Color := $00996600; //Windows UX "Main Instruction" color
                FPlusLabel.Font.Style := FPlusLabel.Font.Style + [fsBold];
            end;
    
            FPlusLabel.Left := centerLine-(FPlusLabel.Width div 2);
            FPlusLabel.Top := Y-(FPlusLabel.Height div 2);
            FPlusLabel.Visible := True;
        end
        else
        begin
            Self.Cursor := crDefault;
            if Assigned(FPlusLabel) then
                FPlusLabel.Visible := False;
        end;
    end;
    
    function TForm1.IsMouseNearLine(X, Y: Integer): Boolean;
    begin
        if (x >= (centerLine-tolerance)) and (x <= (centerLine+tolerance)) then
        begin
            //we're close-ish to the line
            Result := true;
        end
        else
            Result := False;
    end;
    

    Things start to get hairy when you have other controls, each needing to play along with the MouseMove messages. But it's not too bad if you forward them all to a single handler; performing client-to-screen-to-formClient before you do.

    Note: Any code is released into the public domain. No attribution required.