Fare imlecini sol fare düğmesi kapalıyken nasıl değiştirebilirim? Delphi 2007'de

Question

, bir fare hareketi olay, ben fare imlecini değiştirmek deneyin: örneğin

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; 

. Ancak, farenin sol tuşu ve fareyi hareket ettirdiğimde, imleç ya crDrag ya da crNoDrop olarak değişmez. Kod çalıştırılır (örn. Cursor: = crDrag;) ancak imleç değişmez. Farenin sol tuşu ve fareyi hareket ettirdiğimde, imleç problemi değiştirmez.

(Başlangıçta bazı Sürükle & Bırak olayları ve özellikleri kullanmaya çalıştı ama istediğim şekilde çalışması için her şeyi alamadım.)

Düzenleme: Aydınlatılmış istenen davranışları ve biçimlendirilmiş kodu.

Düzenleme: Teşekkürler, Gamecat, ama sol fare düğmesi kapalıyken imlecin değişmesini ve fareyi hareket ettirirken imlecin crDrag ve crNoDrop arasında ileri ve geri olarak değişmesini istiyorum. Eğer onMouseDown fare imlecini ayarlamak ve onMouseUp içinde sıfırlamak Eğer

Answer 1

şey çalışıyor:

: fare hareketlerine bir tepki MouseCursor istiyorsanız

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; 

şunları kullanın

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 gerekli, aksi halde bir denetimin üzerinde kalıyorsa imleç geri değişmeyecek.

Her yerde Screen.Cursor kullandığınızdan emin olun.

Answer 2

Biraz konu dışı, ancak belki sizin için yararlı olabilir.

İç içe geçmiş imleç değişikliklerine izin vermek için genel bir yığın oluşturdum. Bu, herhangi bir kod parçasının, fare imlecini, arayan veya arayanın ayarladığı şey hakkında endişelenmeden istedikleri şeye ayarlamasına izin verir. Örneğin

:

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; 

Ne prosedür diğer ihtiyaçları devlet olduğunu dert zorundadır ya da fare imlecini bırakır.

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