Firemonkey中的光标处理答案

【问题标题】：Cursor handling in FiremonkeyFiremonkey中的光标处理
【发布时间】：2019-11-11 11:32:18
【问题描述】：

谁能解释一下 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 的第一个组件的主窗体。但这不起作用。

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

在第三个选项中，我使用我编写的类 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;

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

【问题讨论】：

标签： user-interface delphi firemonkey

【解决方案1】：

这个问题似乎可以通过以下事实来解释。光标行为在 RAD Studio 帮助中描述如下：

如果 Cursor 设置为默认光标，则当鼠标指针悬停在该控件上时，该控件可能会显示不同的光标。此控件显示的实际光标是 InheritedCursor 中定义的光标，这是一个只读属性，不仅根据此控件中 Cursor 的值计算，而且还根据此控件的任何祖先（父级、大-parent，依此类推，直到父窗体）。

通过以下方法实现：

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 应该一直搜索非默认光标到祖先 Form。这里的 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。因此会显示沙漏光标，但会启动操作。

【讨论】：