How do I change the mouse cursor when the left mouse button is down?
Asked Answered
I

2

6

In Delphi 2007, in a mouse move event, I try to change the mouse cursor with:

procedure TFr_Board_Display.PaintBox_Proxy_BoardMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin

  if left_mouse_button_down then begin  
    if some_condition then begin
      Cursor := crDrag;
    end
    else begin
      Cursor := crNoDrop;
    end;
  end
  else begin
    if some_other_condition then begin
      Cursor := crHandPoint;
    end
    else begin
      Cursor := crDefault;
    end;
  end;
end;

for example. However, when the left mouse button is down, and I move the mouse, the cursor doesn't change to either crDrag or crNoDrop. The code is executed (e.g. Cursor := crDrag;) but the cursor does not change. When the left mouse button is up, and I move the mouse, the cursor changes no problem.

(I originally tried to use some Drag & Drop events and properties, but couldn't get everything to work the way I wanted.)

Edit: Clarified desired behavior, and formatted code.

Edit: Thank you, Gamecat, but I want the cursor to change when the left mouse button is down and the while the mouse is moving the cursor should change back and forth between crDrag and crNoDrop.

Incunabulum answered 18/12, 2008 at 7:21 Comment(1)
Added more info, so it is usable on mouse move.Moraceous
M
11

If you set the mouse cursor in the OnMouseDown and reset it in the OnMouseUp, anything works fine:

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Cursor := crCross;
end;

procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Cursor := crDefault; // Or you can restore a saved cursor.
end;

If you want the mousecursor to react at the mouse move, use the following:

procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then begin
    if X<100 then
      Screen.Cursor := crCross
    else
      Screen.Cursor := crHourGlass;
  end else
    Screen.Cursor := crDefault;  // Or you can restore a saved cursor.
end;

procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault; // Or you can restore a saved cursor.
end;

The MouseUp is needed, else the cursor won't change back if it hovers above a control.

Be sure to use Screen.Cursor everywhere.

Moraceous answered 18/12, 2008 at 8:2 Comment(0)
H
5

Slightly off-topic, but perhaps useful to you.

I created a global stack to allow nested cursor changes. It lets any piece of code set the mouse cursor to what they want without worrying about what their caller or callee's set it to.

For example:

procedure AskUserWhatToDo;
begin
  PushMouseCursor(crArrow);
  try
     if MessageDlg('Abort?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        SysUtils.Abort;
  finally
     PopMouseCursor;
  end;
end;

procedure LongProcess;
begin
  PushMouseCursor(crHourglass);
  try
     //  do something
     if QuestionableState then
       AskUserWhatToDo;
     //  do something
  finally
    PopMouseCursor;
  end;
end;

Neither procedure has to worry about what state the other needs or leaves the mouse cursor.

//===============================================================
//   in a universal utility module (mine is called CraftWindows.pas)

function SetMouseCursor(ACursor : TCursor) : TCursor;
begin
   Result := Screen.Cursor;
   Screen.Cursor := ACursor;
end;

var
   GlobalMouseCursorStack : TList = nil;

procedure PushMouseCursor(ACursor : TCursor);
begin
   if GlobalMouseCursorStack = nil then
       GlobalMouseCursorStack := TList.Create;

   GlobalMouseCursorStack.Add(Pointer(SetMouseCursor(ACursor)));
end;

procedure PopMouseCursor;
begin
   if (GlobalMouseCursorStack <> nil) and (GlobalMouseCursorStack.Count > 0) then
   begin
       SetMouseCursor(TCursor(GlobalMouseCursorStack.Last));
       GlobalMouseCursorStack.Delete(GlobalMouseCursorStack.Count - 1);
   end;
end;

...

finalization
  GlobalMouseCursorStack.Free;
Haemachrome answered 18/12, 2008 at 21:40 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.