Delphi fmx смена курсора при длительных перациях

Question

При выполнении длительной операции необходимо изменить курсор на «часики».

В классическом VCL это делалось так:

procedure TForm1.Button1Click(Sender: TObject);
var
  OldCursor: TCursor;
begin
  OldCursor := Cursor;
  try
    Cursor := crHourGlass;
    Application.ProcessMessages;
    
    MyProcedure(); // Тут что-то, что выполнятся долго
    
  finally
    Cursor := OldCursor;
  end;
end;

В Firemonkey под Windows это не работает — курсор просто не меняется.

Хотя если поставить BreakPoint после смены курсора, то после возобновления выполнения курсор меняется.

Как правильно выполнять смену курсора в Firemonkey внутри процедуры, работающей в основном потоке приложения?

Answer 1

как уже и говорили нужен новый поток кроме исключительных ситуаций например долгой загрузки главного окна приложения. там можно доп форму сделать которая создастся в момент создания TForm и при каждой смене контента вызывать TControl.Update, а для вашей задачи можно использовать событие по завершению потока

В этом примере я использовал PostMessage а что бы пользователь во время выполнения ничего не кликал можно Enabled := False поставить только не саму форму а панель которая Align = alClient

В моем примере много чего не учтено (например, быстро закрыть программу не дожидаясь окончания) и так так это новый поток и в потоке я трогаю Self.Handle который относится к самой форме то может возникнуть исключение типа read write address, поэтому все переменные к которым могут обращаться разные потоки должны быть продублированы в самом потоке или защищать их критическими секциями.

Как альтернатива PostMessage есть событие TThread.OnTerminate которое сработает когда поток завершится и сработает оно в том потоке с которого создавали TThread т.е в главном.

unit Unit1;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    procedure MyProcedure;
    procedure MyProcedureFinish(var Msg: TMessage); message WM_USER+1;
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Cursor := crSQLWait;
  Panel1.Enabled := False; //чтобы юзер ничего не мог нажать
  TThread.CreateAnonymousThread(MyProcedure).Start; // Тут что-то, что выполнятся долго
end;

procedure TForm1.MyProcedureFinish(var Msg: TMessage); //message WM_USER+1;
begin
  Cursor := crDefault;
  Panel1.Enabled := True;
end;

procedure TForm1.MyProcedure;
var
  I: Integer;
begin
 try
   for I := 0 to 10 do
     Sleep(1000);
 finally
   PostMessage(Self.Handle, WM_USER+1, 0, 0);
 end;
end;

end.

БЛОГ НА HUSL

Delphi fmx смена курсора при длительных перациях

Ответы (1 шт):