Delphi: 屏幕光标无法工作，无法解决Windows.SetCursor(crHourGlass)问题

Question

在我的应用程序中，我有

Screen.Cursor := crHourGlass;
Application.ProcessMessages;
try
...

finally
  Screen.Cursor := crDefault;
  Application.ProcessMessages;
end;

但是这并没有像预期的那样起作用。在处理时，它似乎立即改回了crDefault。

经过一些谷歌搜索，我决定尝试Windows.SetCursor() - 但我在MSDN上搜索，找不到光标类型列表。

更新 我以为找到了解决方案（使用SetSystemCursor(Screen.Cursors[crHourGlass], OCR_NORMAL);），但我似乎无法将光标改回正常状态 :(。

- Richard Woolf

---

如果你的问题没有更多细节，我只能说：如果光标似乎立即改回crDefault，那么try语句内的代码可能会将其改回（或调用使该更改的某些代码），或者它使用某种异步进程，例如启动另一个线程，实际上是处理该过程的线程。因此，程序执行finally部分并将光标立即改回crDefault。 - jachguate

Jachguate> 现在似乎发生的情况是，只有当应用程序具有适当的焦点时，设置光标才会产生影响 - 但是任何发生在应用程序外部的进程 - 比如调用 DLL 进程或要求扫描仪进行扫描（注意：我正在进行扫描，没有显示扫描仪进度等的弹出窗体）- 然后 Windows 恢复默认光标。因此，我认为我需要一种方法，在我的进程完成之前，在 WINDOWS 中为所有应用程序设置光标。 - Richard Woolf

“所以我认为我需要一种方法，在我的进程完成之前，为所有应用程序在WINDOWS中设置光标。” - 这是一个非常奇怪的要求。只有您的应用程序正在忙碌。为什么您希望其他应用程序在它们没有忙碌时看起来像是忙碌的呢？ - Roddy

只有你的应用程序在忙碌，为什么你希望其他应用程序看起来也很忙碌呢？那我该怎么解决这个问题呢？当我按下一个按钮时，我会设置屏幕光标为crHourglass；然后我让扫描仪获取图像 - 这会导致应用程序失去焦点10秒钟，等待扫描完成（请注意：如上所述，它没有任何“新窗口”等），然后调用一个DLL，再次导致应用程序失去焦点。在所有这些“失去焦点”的时间里，光标会恢复为crDefault（箭头）。 - Richard Woolf

@Richard：你可以一步一步地运行应用程序，当IDE不与你的窗口重叠并且在执行每行代码时检查光标，检查哪一行特定的代码将其改回crDefault。然后跟踪该行并按照代码进行操作，直到找到有问题的指令。也许真正的问题是扫描仪dll调用...因此你无法做任何事情使它正确，但很有可能你的代码或第三方库中有一些东西可以改变或解决。顺便说一下：如果你想让我收到你的回复通知，请在评论中使用@我的名字。 - jachguate

Windows.SetCursor() 不起作用。'TWinControl' 返回 Screen.Cursor 用于 WM_SETCURSOR 消息，除非控件显式地设置了其光标，否则 VCL 控件上的光标将恢复为 Screen.Cursor。但无论如何，当您必须使用它时：windows.SetCursor(Screen.Cursors[crHourGlass])。设置 'Screen.Cursor' 调用相同的方法，顺便提一下。 - Sertac Akyuz

Answer 1

我认为我有解决方案：

以下是如何更改“整个桌面”的光标 - 而不仅仅是您的应用程序：

SetSystemCursor(Screen.Cursors[crDefault], OCR_NORMAL);

但要注意：任何想要更改光标的其他应用程序/窗口都会这样做 - 因此，只有在您的应用程序忙碌时用户不乱动其他应用程序才有效。作为覆盖，您可以暂时将所有系统默认光标更改为所需的光标 - 并在过程结束后将它们全部更改回来。

我仍然对MSDN没有为SetCursor提供其光标类型感到失望 - 但幸运的是我最终没有使用它。

更新: 这似乎是正确的方法，但我似乎无法在 SetSystemCursor(Screen.Cursors[crHourGlass], OCR_NORMAL);之后将光标改回箭头。 如果有人在阅读这篇文章，请花点时间为我提供一些可行的代码 - 首先将系统光标设置为沙漏，然后再将其设置回箭头。

编辑: 恢复默认光标的示例代码：

procedure TForm1.Button1Click(Sender: TObject);
var
  cArrow, cHour: HCURSOR;
begin
  cArrow := CopyImage(Screen.Cursors[crArrow], IMAGE_CURSOR, 0, 0, LR_COPYFROMRESOURCE);
  cHour := CopyImage(Screen.Cursors[crHourGlass], IMAGE_CURSOR, 0, 0, LR_COPYFROMRESOURCE);
  if (cArrow <> 0) and (cHour <> 0) and SetSystemCursor(cHour, OCR_NORMAL) then
    try

      // do processing

    finally
      SetSystemCursor(cArrow, OCR_NORMAL);
    end;
end;

- Richard Woolf

---

MSDN在SetCursor中不会提到光标类型，因为SetCursor不接受光标类型。它期望一个光标句柄，因此参考了可以提供句柄的各种函数，包括CreateCursor和LoadCursor。后者确实提到了各种内置光标。如果这已经足够了，您可以按照MSDN中的其他链接访问光标主题概述。 - Rob Kennedy

根据我上面的更新，这似乎是正确的轨迹，但我无法将光标改回普通箭头。 - Richard Woolf

@Sertac Akyuz 感谢您提供的示例，非常好用并且有效。 - Richard Woolf

Answer 2

我在我的应用程序中遇到了同样的问题，解决方法是在窗体构造函数中调用Application.ProcessMessages函数。

这是我的测试应用程序：

// MainFormUnit
type
  TMainForm = class(TForm)
    btnClickMe: TButton;
    procedure btnClickMeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  LazyFormUnit;

{$R *.dfm}

procedure TMainForm.btnClickMeClick(Sender: TObject);
var
  oLazyForm: TLazyForm
begin
  oLazyForm := TLazyForm.Create(Self, 0);
  oLazyForm.ShowModal;
  oLazyForm.Free;
end;

而第二种表单

// LazyFormUnit
type
  TLazyForm = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    constructor Create(p_oComponent: TComponent; p_nValue: Integer); reintroduce;
  end;

implementation

{$R *.dfm}

constructor TLazyForm.Create(p_oComponent: TComponent; p_nValue: Integer);
begin
  inherited Create(p_oComponent);
  Application.ProcessMessages;
end;

procedure TLazyForm.FormShow(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  try
    Sleep(1000 * 5);
  finally
    Screen.Cursor := crDefault;
  end;
end;

这个解决方案将不改变系统光标。

- LZR

---

你应该尽可能避免在应用程序中使用Application.ProcessMessages。如果不非常小心，Application.ProcessMessages可能会导致许多麻烦的问题。 - Gabriel

Answer 3

这取决于您的 try 块中有什么。如果它不需要任何时间，那么光标将立即返回 crDefault。如果您在 finally 之前放置了一个调试语句，则应该在光标返回 crDefault 之前执行它。

此外，您不应该假定在启动程序时光标为 crDefault。一种安全的方法是：

var
  C: TCursor;

begin

  C : = Screen.Cursor;
  Screen.Cursor := crHourGlass;

  try
    // long running code here
  finally
    Screen.Cursor := C;
  end;

end;

最后（恕我直言），如果您使用Application.ProcessMessages的目的是确保更改的光标被显示出来，那么您并不需要它。

- Larry Lustig

---

谢谢，但它根本不起作用。是的，在try..finally块中有很多处理过程，实际上在try..finally中有调用其他过程的过程等 - 其中一些过程可能会暂时将焦点从应用程序转移开，例如获取扫描仪进行扫描（应用程序将等待扫描），显然在此期间我的光标不是沙漏形状。我该如何强制执行？ - Richard Woolf

你追踪过了吗？你的代码会改变光标。有可能在 try 块中早期的某些代码——无论是你自己的还是来自库（扫描器？）——包含了再次更改光标的代码。如果那段代码做出了与你相同的假设（即光标应该回到 crDefault 而不是调用代码时的状态），那么这就可以解释表现上的行为。 - Larry Lustig

Answer 4

试试这个：

Screen.Cursor := crHourGlass;
try
  ...
finally
  TThread.Synchronize(nil,
    procedure
    begin
      Screen.Cursor := crDefault;
    end
  );
end;

对我来说，它正常工作。

- Djone Kreusch