为什么我的光标在Delphi的FindDialog中没有变成沙漏？

Question

我只是打开我的FindDialog:

FindDialog.Execute;

在我的FindDialog.OnFind事件中,我想将光标更改为沙漏以搜索大文件,这可能需要几秒钟.所以在OnFind事件中我这样做:

Screen.Cursor := crHourglass;
(code that searches for the text and displays it) ...
Screen.Cursor := crDefault;

搜索文本时,光标会正确地更改为沙漏(或Vista中的旋转圆圈),然后在搜索完成时返回指针.

但是,这只发生在主窗体上.它不会发生在FindDialog本身上.搜索期间,默认光标仍保留在FindDialog上.如果我将光标移到FindDialog上进行搜索,则会更改为默认值,如果我将其移出主表单,则会成为沙漏.

这似乎不应该发生.我做错了什么或者需要做些什么来使光标成为所有表格上的沙漏？

作为参考,我正在使用Delphi 2009.

Answer 1

我想这其中的原因是有的。与查找对话框不是一个表单而是一个对话框（通用对话框）有关。

您可以尝试设置类光标（对对话框的控件没有影响）；

procedure TForm1.FindDialog1Find(Sender: TObject);
begin
  SetClassLong(TFindDialog(Sender).Handle, GCL_HCURSOR, Screen.Cursors[crHourGlass]);
  try
    Screen.Cursor := crHourglass;
    try
//    (code that searches for the text and displays it) ...
    finally
      Screen.Cursor := crDefault;
    end;
  finally
    SetClassLong(TFindDialog(Sender).Handle, GCL_HCURSOR, Screen.Cursors[crDefault]);
  end;
end;

编辑

另一种方法是在搜索期间子类化 FindDialog 并使用“SetCursor”响应 WM_SETCURSOR 消息。如果我们阻止进一步处理消息，对话框上的控件将不会设置自己的光标。

type
  TForm1 = class(TForm)
    FindDialog1: TFindDialog;
    ...
  private
    FSaveWndProc, FWndProc: Pointer;
    procedure FindDlgProc(var Message: TMessage);
    ...
  end;

....
procedure TForm1.FormCreate(Sender: TObject);
begin
  FWndProc := classes.MakeObjectInstance(FindDlgProc);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  classes.FreeObjectInstance(FWndProc);
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
begin
  FSaveWndProc := Pointer(SetWindowLong(FindDialog1.Handle, GWL_WNDPROC,
        Longint(FWndProc)));
  try
    Screen.Cursor := crHourGlass;
    try
//    (code that searches for the text and displays it) ...
    finally
      Screen.Cursor := crDefault;
    end;
  finally
    if Assigned(FWndProc) then
      SetWindowLong(FindDialog1.Handle, GWL_WNDPROC, Longint(FSaveWndProc));
//    SendMessage(FindDialog1.Handle, WM_SETCURSOR, FindDialog1.Handle,
//        MakeLong(HTNOWHERE, WM_MOUSEMOVE));
    SetCursor(Screen.Cursors[crDefault]);
  end;
end;

procedure TForm1.FindDlgProc(var Message: TMessage);
begin
  if Message.Msg = WM_SETCURSOR then begin
    SetCursor(Screen.Cursors[crHourGlass]);
    Message.Result := 1;
    Exit;
  end;
  Message.Result := CallWindowProc(FSaveWndProc, FindDialog1.Handle,
      Message.Msg, Message.WParam, Message.LParam);
end;