Почему мой курсор не меняется на Песочные часы в моем FindDialog в Delphi? - PullRequest
Новая
       28

Почему мой курсор не меняется на Песочные часы в моем FindDialog в Delphi?

5 голосов
/ 18 апреля 2010

Я просто открываю свой 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.

Ответы [ 2 ]

3 голосов
/ 18 апреля 2010

Я думаю, причина этого в чем-то. сделать диалог поиска не формой, а диалогом (общим диалогом).

Вы можете попробовать установить курсор класса (не влияет на элементы управления диалогового окна); 

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

Альтернативой может быть создание подкласса FindDialog во время поиска и ответ на сообщения WM_SETCURSOR с помощью "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;
0 голосов
/ 18 апреля 2010

Попробуйте добавить Application.ProcessMessages; после того, как вы установите курсор.

Если это сработает, обязательно позвоните своей маме, помогите пожилой женщине перейти улицу или посадите дерево. Иначе дьяволу будет принадлежать еще один маленький кусочек вашей души.

...