Firemonkey中的游标处理

Question

谁能澄清Delphi FMX 10.3.1中的游标如何工作？我有一个冗长的动作，我希望应用程序的光标显示为动作执行时的crHourglass。在以下代码中，我介绍了3个用于将光标设置为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;

在第一个选项中，我希望将MainForm的Cursor属性设置为crHourGlass，应用程序将显示InheritedCursor属性，该属性应在组件的z顺序堆栈中搜索所有返回光标值不是crDefault的第一个组件的主窗体的方法。但这不起作用。

在第二个选项中，我设置了链接到该动作的按钮的cursor属性。如果单击该按钮以启动操作，光标更改起作用。但是，如果操作是从主菜单项启动的，则不会。

在第三个选项中，我使用编写的TCursorManager类的对象包装与平台相关的服务IFMXCursorService。这通常有效，但并非总是如此。该代码是：

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;

实现我要达到的目标的最简单方法是什么？

Answer 1

该问题似乎由以下事实解释。RAD Studio帮助中描述的游标行为是通过以下方法实现的：

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起作用，因为单击按钮时鼠标悬停在其上方。但是，当单击链接到该动作的菜单项时，该过程不会被调用，因为在那种情况下，鼠标不在按钮上方，而是在菜单项上方。

人们曾以为Option 0应该起作用，因为无论在表单上单击鼠标的哪个位置，表单始终位于鼠标的下方。但是TForm不能从TControl继承，而只能从TFMXObject继承。方法TCustomForm.SetCursor只是将光标值分配给一个字段，而无需调用实现帮助文件中描述的行为的代码。因此，选项0不起作用。这里的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。因此，显示了沙漏光标，但是操作已启动。