前端之家

  1. 首页
  2. 问答

Firemonkey中的光标处理

• 问答

有人可以澄清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;

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

chenglong678 回答：Firemonkey中的光标处理

该问题似乎由以下事实解释。 RAD Studio帮助中描述了游标行为，如下所示：

  

如果将“光标”设置为默认光标，则当鼠标指针悬停在该控件上时，该控件可能会显示其他光标。该控件显示的实际游标是在InheritedCursor中定义的游标，它是一个只读属性，它不仅基于此控件中Cursor的值，而且还基于该控件任何祖先（父，大）中的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应该一直搜索非默认游标，直到返回祖先表单。这里的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。因此，尽管操作已启动，但显示了沙漏光标。

delphifiremonkeyuser-interface
本文链接：https://www.f2er.com/3124586.html

大家都在问