Delphi Firemonkey ListView滚动条可见性

在Firemonkey的

TListview

中，滚动条的可见性取决于系统是否有触摸屏。当列表视图上没有足够的空间显示所有列表项时，如何覆盖此行为并始终显示垂直滚动

我在

TListViewBase.Create

中看到，滚动可见性再次取决于

HasTouchTracking

的功能结果，这取决于

tScrollingBehavior.TouchTracking

是否在

SystemInformationService.GetScrollingBehavior

中设置

有没有人知道我如何重写这个行为？

不久前，我“匆忙地”组装了这个单元来重写Windows的GetScrollingBehavior。您可以对任何要覆盖它的平台执行类似的操作。在Create方法中，我删除了已安装的服务，但为未被覆盖的部分保留了对它的引用，然后用我自己的替换它

unit DW.ScrollingBehaviourPatch.Win;

// This unit is used for testing of "inertial" scrolling of listviews etc on devices that do not have touch capability

interface

implementation

uses
  FMX.Platform;

type
  TPlatform = class(TInterfacedObject, IFMXSystemInformationService)
  private
    class var FPlatform: TPlatform;
  private
    FSysInfoService: IFMXSystemInformationService;
  public
    { IFMXSystemInformationService }
    function GetScrollingBehaviour: TScrollingBehaviours;
    function GetMinScrollThumbSize: Single;
    function GetCaretWidth: Integer;
    function GetMenuShowDelay: Integer;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TPlatform }

constructor TPlatform.Create;
begin
  inherited;
  if TPlatformServices.Current.SupportsPlatformService(IFMXSystemInformationService, FSysInfoService) then
    TPlatformServices.Current.RemovePlatformService(IFMXSystemInformationService);
  TPlatformServices.Current.AddPlatformService(IFMXSystemInformationService, Self);
  FPlatform := Self;
end;

destructor TPlatform.Destroy;
begin
  //
  inherited;
end;

function TPlatform.GetCaretWidth: Integer;
begin
  Result := FSysInfoService.GetCaretWidth;
end;

function TPlatform.GetMenuShowDelay: Integer;
begin
  Result := FSysInfoService.GetMenuShowDelay;
end;

function TPlatform.GetMinScrollThumbSize: Single;
begin
  Result := FSysInfoService.GetMinScrollThumbSize;
end;

function TPlatform.GetScrollingBehaviour: TScrollingBehaviours;
begin
  Result := [TScrollingBehaviour.Animation, TScrollingBehaviour.TouchTracking];
end;

initialization
  TPlatform.Create;

end.

不久前，我“匆忙地”组装了这个单元来覆盖Windows的GetScrollingBehavior。您可以对任何要覆盖它的平台执行类似的操作。在Create方法中，我删除了已安装的服务，但为未被覆盖的部分保留了对它的引用，然后用我自己的替换它

unit DW.ScrollingBehaviourPatch.Win;

// This unit is used for testing of "inertial" scrolling of listviews etc on devices that do not have touch capability

interface

implementation

uses
  FMX.Platform;

type
  TPlatform = class(TInterfacedObject, IFMXSystemInformationService)
  private
    class var FPlatform: TPlatform;
  private
    FSysInfoService: IFMXSystemInformationService;
  public
    { IFMXSystemInformationService }
    function GetScrollingBehaviour: TScrollingBehaviours;
    function GetMinScrollThumbSize: Single;
    function GetCaretWidth: Integer;
    function GetMenuShowDelay: Integer;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TPlatform }

constructor TPlatform.Create;
begin
  inherited;
  if TPlatformServices.Current.SupportsPlatformService(IFMXSystemInformationService, FSysInfoService) then
    TPlatformServices.Current.RemovePlatformService(IFMXSystemInformationService);
  TPlatformServices.Current.AddPlatformService(IFMXSystemInformationService, Self);
  FPlatform := Self;
end;

destructor TPlatform.Destroy;
begin
  //
  inherited;
end;

function TPlatform.GetCaretWidth: Integer;
begin
  Result := FSysInfoService.GetCaretWidth;
end;

function TPlatform.GetMenuShowDelay: Integer;
begin
  Result := FSysInfoService.GetMenuShowDelay;
end;

function TPlatform.GetMinScrollThumbSize: Single;
begin
  Result := FSysInfoService.GetMinScrollThumbSize;
end;

function TPlatform.GetScrollingBehaviour: TScrollingBehaviours;
begin
  Result := [TScrollingBehaviour.Animation, TScrollingBehaviour.TouchTracking];
end;

initialization
  TPlatform.Create;

end.

---

对于Dave提出的解决方案，需要按如下方式关闭触摸跟踪：

function TPlatformListViewWorkaround.GetScrollingBehaviour: TScrollingBehaviours;
begin
  result := fSysInfoService.GetScrollingBehaviour - [TScrollingBehaviour.TouchTracking];
end;

但是，使用此解决方案，您必须接受触摸屏系统上的listview不能再用手指滚动

---

这就是为什么我现在在Embarcadero Quality Central中打开了一个更改请求，并通过使用新的属性SuppressScrollBarOnTouchSystems（RSP-26584）扩展TListView提出了一个解决方案。对于Dave提出的解决方案，触摸跟踪需要关闭，如下所示：

function TPlatformListViewWorkaround.GetScrollingBehaviour: TScrollingBehaviours;
begin
  result := fSysInfoService.GetScrollingBehaviour - [TScrollingBehaviour.TouchTracking];
end;

但是，使用此解决方案，您必须接受触摸屏系统上的listview不能再用手指滚动

---

这就是为什么我现在在Embarcadero Quality Central中打开了一个变更请求，并通过使用新的属性Suppress BarontouchSystems（RSP-26584）扩展TListView提出了一个解决方案建议。

感谢Dave的这种方法。我必须仔细检查这个解决方案，因为在其他情况下，触摸屏支持对于UI处理仍然很重要。谢谢Dave的这种方法。我必须仔细检查这个解决方案，因为在其他情况下，触摸屏支持对于UI处理仍然很重要。