Как изменить курсор мыши, когда левая кнопка мыши нажата? - PullRequest
6 голосов
/ 18 декабря 2008

В Delphi 2007, в событии перемещения мыши, я пытаюсь изменить курсор мыши с помощью:

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;

например. Однако, когда левая кнопка мыши нажата, а я перемещаю мышь, курсор не меняется ни на crDrag, ни на crNoDrop. Код выполняется (например, Cursor: = crDrag;), но курсор не изменяется. Когда левая кнопка мыши поднята, и я перемещаю мышь, курсор без проблем меняется.

(Первоначально я пытался использовать некоторые события и свойства Drag & Drop, но не мог заставить все работать так, как я хотел.)

Изменить: Уточнение желаемого поведения и отформатированный код.

Редактировать: Спасибо, Gamecat, но я хочу, чтобы курсор изменился, когда левая кнопка мыши нажата, а во время движения курсора курсор должен меняться назад и вперед между crDrag и crNoDrop.

Ответы [ 2 ]

11 голосов
/ 18 декабря 2008

Если вы установите курсор мыши в OnMouseDown и сбросите его в OnMouseUp, все работает нормально:

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;

Если вы хотите, чтобы курсор мыши реагировал на движение мыши, используйте следующее:

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;

Требуется MouseUp, иначе курсор не вернется назад, если он находится над элементом управления.

Обязательно используйте Screen.Cursor везде.

5 голосов
/ 19 декабря 2008

Немного не по теме, но, возможно, полезно для вас.

Я создал глобальный стек, чтобы разрешить смену вложенного курсора. Это позволяет любому коду кода установить курсор мыши на то, что им нужно, не беспокоясь о том, на что его вызывающий или вызываемый установил его.

Например:

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;

Ни одна из процедур не должна беспокоиться о том, в каком состоянии нуждается другая, и не оставляет курсора мыши.

//===============================================================
//   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;
...