Проблема, по-видимому, объясняется следующими фактами. Поведение курсора описывается в справке RAD Studio следующим образом:
Если для курсора установлен курсор по умолчанию, этот элемент управления может отображать другой курсор, когда указатель мыши находится над ним. Фактический курсор, который отображает этот элемент управления, является курсором, определенным в InheritedCursor, свойстве только для чтения, которое рассчитывается не только по значению Cursor в этом элементе управления, но также и по значению Cursor в любом предке этого элемента управления (parent, grand). родитель и так далее до родительской формы).
Это реализовано в следующем методе:
procedure TControl.SetCursor(const Value: TCursor);
var
CursorService: IFMXCursorService;
begin
if FCursor <> Value then
begin
FCursor := Value;
if FCursor <> crDefault then
RefreshInheritedCursor
else
begin
if Parent <> nil then
RefreshInheritedCursor
else
FInheritedCursor := crDefault;
end;
if IsMouseOver and not (csLoading in ComponentState) and not (csDesigning in ComponentState) and
TPlatformServices.Current.SupportsPlatformService(IFMXCursorService, CursorService) then
CursorService.SetCursor(FInheritedCursor);
end;
end;
При щелчке мышью по компоненту, который наследуется от класса TControl, вызывается описанная выше процедура. Если IsMouseOver имеет значение True, смена курсора работает. Поэтому вариант 1 работает, когда кнопка нажата, потому что мышь находится над ней, когда она нажата. Но процедура не вызывается при нажатии на элемент меню, связанный с действием, потому что в этом случае мышь находится не над кнопкой, а над элементом меню.
Можно было бы подумать, что вариант 0 должен работатьпотому что там, где на форме щелкают мышью, форма всегда находится под мышью. Но TForm не наследуется от TControl, а только от TFMXObject. Метод TCustomForm.SetCursor просто присваивает значение курсора полю, не вызывая код, реализующий поведение, описанное в файлах справки. Следовательно, опция 0 не работает. Такое поведение, по-видимому, не соответствует описанному в файле справки, в котором говорится, что InheritedCursor должен искать курсор не по умолчанию вплоть до формы предка. Кажется, здесь есть возможности для улучшения реализации FMX!
Что касается подхода в Варианте 2, он на самом деле не работает должным образом. Песочные часы показываются кратко, пока не появится PanelProgress. Это заставляет курсор переключиться обратно на crDefault.
С учетом этих ограничений единственное решение, которое мне удалось найти, - это добавить новую кнопку в PanelProgress с пометкой «Пуск» и переместить большую часть кода. ранее в ActionFindExactMatchesExecute в обработчик события OnClick для новой кнопки. ActionFindExactMatchesExecute становится:
procedure TFormMain.ActionFindExactMatchesExecute(Sender: TObject);
begin
PanelResults.SendToBack;
PanelProgress.BringToFront;
end;
, а код ButtonStartClick:
procedure TFormMain.ButtonStartClick(Sender: TObject);
var
IterationContextHits: TIterationContextHits;
begin
ButtonStart.Cursor:= crHourglass;
{…}
Try
{…}
ShowMessage('Number of matches found: ' + IntToStr(FHitCount));
{Update GUI:}
DataToControls;
PanelResults.BringToFront;
finally
IterationContextHits.Free;
ButtonStart.Cursor:= crDefault;
end;
end;
С этими изменениями в зависимости от того, какой компонент связан с действием, все, что происходит, - это то, что PanelProgress выводится на экран. Тогда есть только один способ для запуска длинного кода, то есть нажать ButtonStart, поэтому мышь обязательно находится над ButtonStart, поэтому Control.IsMouseOver имеет значение true. Следовательно, курсор песочных часов показан, однако действие запущено.