Can anyone clarify how cursors in Delphi FMX 10.3.1 work? I have a lengthy action and I want the application's cursor to be displayed as crHourglass while the action is executing. In the following code I have introduced 3 options for setting the cursor to crHourglass.
procedure TFormMain.ActionFindExactMatchesExecute(Sender: TObject);
const
CCursorOption= 2;
var
IterationContextHits: TIterationContextHits;
begin
PanelResults.SendToBack;
PanelProgress.BringToFront;
case CCursorOption of
0: Self.Cursor:= crHourglass;
1: ButtonFindExactMatches.Cursor:= crHourglass;
2: CursorManager.SetCursor(crHourglass);
end;
{Create TIterationContextHits object to hold progress variables:}
IterationContextHits:= TIterationContextHits.Create;
try
{Lengthy code that searches multiple files for string matches}
{Report result of operation:}
ShowMessage('Number of matches found: ' + IntToStr(FHitCount));
{Update GUI:}
DataToControls;
PanelResults.BringToFront;
finally
IterationContextHits.Free;
case CCursorOption of
0: Self.Cursor:= crDefault;
1: ButtonFindExactMatches.Cursor:= crDefault;
2: CursorManager.RestorePrevCursor;
end;
end;
end;
In the first option, I set the Cursor property of the MainForm to crHourGlass in the expectation that during execution the application will display the InheritedCursor property, which should search the component z-order stack all the way back to the main form for the first component whose cursor value is not crDefault. But this does not work.
In the second option I set the cursor property of a button that is linked to the action. If the button is clicked to launch the action, the cursor change works. But if the action is launched from a main menu item, then it doesn't.
In the third option I use an object of class TCursorManager that I have written to wrap the platform-dependent service IFMXCursorService. This mostly works, but not invariably. The code for this is:
TCursorRecord= record
FCursor: TCursor;
FStartTime: integer;
end;
TCursorRecordArray= array of TCursorRecord;
TCursorManager= class
private
FCursorService: IFMXCursorService;
FCursorRecordStack: TCursorRecordArray;
FCursorRecordCount: integer;
protected
function GetCursorTickCount: integer;
public
constructor Create;
destructor Destroy; override;
function GetCursor: TCursor;
{Returns currently set cursor}
procedure SetCursor(Cursor: TCursor);
{Sets new cursor}
function RestorePrevCursor: TCursor;
{Restores cursor previously set using this object}
property Cursor: TCursor read GetCursor write SetCursor;
property CursorTickCount: integer read GetCursorTickCount;
end;
implementation
constructor TCursorManager.Create;
var
CurrCursorRecord: TCursorRecord;
begin
{Create platform-dependent cursor service:}
if TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then
FCursorService:= TPlatformServices.Current.GetPlatformService(IFMXCursorService)
as IFMXCursorService;
{Create current cursor record:}
CurrCursorRecord.FCursor:= FCursorService.GetCursor;
CurrCursorRecord.FStartTime:= GetTickCount;
{Put current cursor record onto CursorRecordStack:}
SetLength(FCursorRecordStack, 8);
FCursorRecordCount:= 1;
FCursorRecordStack[0]:= CurrCursorRecord;
end;
function TCursorManager.RestorePrevCursor: TCursor;
var
PrevCursorRecord: TCursorRecord;
begin
if Assigned(FCursorService) then
begin
if FCursorRecordCount>0 then
begin
{Remove current cursor record from stack:}
FCursorRecordCount:= FCursorRecordCount - 1;
PrevCursorRecord:= FCursorRecordStack[FCursorRecordCount-1];
{Reduce size of stack array if possible:}
if FCursorRecordCount mod 8 = 0 then
SetLength(FCursorRecordStack, FCursorRecordCount);
{Update start time of new curr cursor:}
PrevCursorRecord.FStartTime:= GetTickCount;
{Set previous cursor in system:}
FCursorService.SetCursor(PrevCursorRecord.FCursor);
{Return prev cursor:}
Result:= PrevCursorRecord.FCursor;
end;
end;
end;
procedure TCursorManager.SetCursor(Cursor: TCursor);
var
NewCursorRecord: TCursorRecord;
begin
if Assigned(FCursorService) then
begin
{Set up new CursorRecord:}
NewCursorRecord.FCursor:= Cursor;
NewCursorRecord.FStartTime:= GetTickCount;
{Add new cursor record to stack:}
if FCursorRecordCount= Length(FCursorRecordStack) then
SetLength(FCursorRecordStack, FCursorRecordCount + 8);
Inc(FCursorRecordCount);
FCursorRecordStack[FCursorRecordCount-1]:= NewCursorRecord;
{Call system procedure to set cursor:}
FCursorService.SetCursor(Cursor);
end;
end;
What is the simplest way to achieve what I am seeking to accomplish?
The problem seems to be explained by the following facts. The cursor behaviour is described in the RAD Studio Help as follows:
If Cursor is set to the default cursor, this control might display a different cursor when the mouse pointer is over it. The actual cursor that this control displays is the cursor defined in InheritedCursor, a read-only property that is calculated based not only in the value of Cursor in this control, but also the value of Cursor in any ancestor of this control (parent, grand-parent, and so on until the parent form).
It is implemented in the following method:
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;
When the mouse is clicked on a component that inherits from class TControl, the above procedure is called. If IsMouseOver is True, the cursor change works. Therefore option 1 works when the button is clicked, because the mouse is over it when it is clicked. But the procedure does not get called when a menu item linked to the action is clicked, because in that case the mouse is not over the button but over the menu item.
One would have thought that Option 0 should work, because wherever on the form the mouse is clicked, the form is always under the mouse. But TForm does not inherit from TControl, but only from TFMXObject. The method TCustomForm.SetCursor just assigns the cursor value to a field without calling the code that implements the behaviour described in the Help files. Hence option 0 does not work. This behaviour seems to be inconsistent with that described in the Help file, which states that InheritedCursor should search for a non-default cursor all the way back to the ancestor Form. There seems to be scope for improvement in the FMX implementation here!
As for the approach in Option 2, this actually doesn’t work properly. The hourglass is shown briefly until PanelProgress is brought into view. This causes the cursor to switch back to crDefault.
In view of these constraints, the only solution I have been able to find is to add a new button to PanelProgress labelled “Start”, and move most of the code previously in ActionFindExactMatchesExecute into the OnClick event handler for the new button. ActionFindExactMatchesExecute becomes:
procedure TFormMain.ActionFindExactMatchesExecute(Sender: TObject);
begin
PanelResults.SendToBack;
PanelProgress.BringToFront;
end;
and the ButtonStartClick code is:
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;
With these changes whichever component linked to the action is clicked, all that happens is that PanelProgress is brought into view. Then there is only one way for launching the lengthy code, i.e. to click ButtonStart, therefore the mouse is necessarily over the ButtonStart so Control.IsMouseOver is true. Hence the hourglass cursor is shown however the action is launched.