Why doesn't my cursor change to an Hourglass in my FindDialog in Delphi?

ぃ、小莉子 提交于 2019-12-23 09:48:00

问题


I am simply opening my FindDialog with:

FindDialog.Execute;

In my FindDialog.OnFind event, I want to change the cursor to an hourglass for searches through large files, which may take a few seconds. So in the OnFind event I do this:

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

What happens is while searching for the text, the cursor properly changes to the hourglass (or rotating circle in Vista) and then back to the pointer when the search is completed.

However, this only happens on the main form. It does not happen on the FindDialog itself. The default cursor remains on the FindDialog during the search. While the search is happening if I move the cursor over the FindDialog it changes to the default, and if I move it off and over the main form it becomes the hourglass.

This does not seem like what is supposed to happen. Am I doing something wrong or does something special need to be done to get the cursor to be the hourglass on all forms?

For reference, I'm using Delphi 2009.


回答1:


I guess the reason for this has got sth. to do with Find Dialog being not a form but a Dialog (a Common Dialog).

You can try setting the class cursor (does not have an effect on the controls of the dialog);

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;



EDIT

An alternative could be to subclass the FindDialog during the search time and respond to WM_SETCURSOR messages with "SetCursor". If we prevent further processing of the message the controls on the dialog won't set their own cursors.

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;



回答2:


Try adding Application.ProcessMessages; after you set the cursor.

If this works, be sure to call your Mother, help an old lady cross the street, or maybe plant a tree. Otherwise, the devil will own another little piece of your soul.



来源:https://stackoverflow.com/questions/2660799/why-doesnt-my-cursor-change-to-an-hourglass-in-my-finddialog-in-delphi

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!