delphi - 为 ListView 中的单个标题背景着色

Question

Delphi FMX 中是否可以为 ListView 中的单个标题背景着色？ 我知道如何在 OnUpdateObject 中的 listview 标题上显示文本，但是可以用自己的颜色为每个标题着色背景或绘制矩形吗？

procedure TForm6.ListView1UpdateObjects(
    const Sender: TObject;
    const AItem: TListViewItem);
var
    pListItemText: TListItemText;
begin
    if AItem.Purpose = TListItemPurpose.Header then
    begin
        pListItemText := AItem.Objects.FindObjectT<TListItemText>('Text');

        if pListItemText = nil then
            pListItemText := TListItemText.Create(AItem);
      
        if assigned(pListItemText) then
            pListItemText.Text:='TEXT';
    end;
end;

Answer 1

我找到了一个解决方案，但我不知道它是否是最佳的。它完全满足我的需求。 我创建了一个单元 uItemHeaderColor.pas

unit uItemHeaderColor;

interface
uses System.UITypes, FMX.ListView.Types, FMX.Graphics, System.Types, FMX.Types;
type
  TListItemHeaderColor = class(TListItemSimpleControl)
  private
    FColor: TAlphaColor;
    procedure SetColor(const AValue: TAlphaColor);
  public
    constructor Create(const AOwner: TListItem); override;
    destructor Destroy; override;
    procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
      const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
      const SubPassNo: Integer = 0); override;
  public
    property Color: TAlphaColor read FColor write SetColor;
  end;


implementation

constructor TListItemHeaderColor.Create(const AOwner: TListItem);
begin
  inherited;
end;

destructor TListItemHeaderColor.Destroy;
begin
  inherited;
end;

procedure TListItemHeaderColor.SetColor(const AValue: TAlphaColor);
begin
  FColor:= AValue;
end;

procedure TListItemHeaderColor.Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
      const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
      const SubPassNo: Integer = 0);
var
  R: TRectF;
begin
  inherited;
  R:= Self.LocalRect;
  Canvas.BeginScene;
  try
    Canvas.Stroke.Kind:= TBrushKind.None;
    Canvas.Fill.Kind:= TBrushKind.Solid;
    Canvas.Fill.Color:= FColor;
    Canvas.FillRect(R, 0, 0, [TCorner.TopLeft, TCorner.TopRight, TCorner.BottomLeft, TCorner.BottomRight], 0.5, TCornerType.Bevel);
  finally
    Canvas.EndScene;
  end;

end;
end.

在主程序中，在 ListView1UpdateObjects 事件中，我创建一个 TListItemHeaderColor 并设置任意颜色。

procedure TForm6.ListView1UpdateObjects(const Sender: TObject;
  const AItem: TListViewItem);
var
  S: TListItemHeaderColor;
  rec: TAlphaColorRec;
begin
  if (AItem.Purpose = TListItemPurpose.Header) then
  begin
    S:= AItem.Objects.FindDrawable('Text') as TListItemHeaderColor;
    if S = nil then
    begin
      rec.A := Random(255);
      rec.R := Random(255);
      rec.B := Random(255);
      rec.G := Random(255);

      S:= TListItemHeaderColor.Create(AItem);
      S.Color:=rec.Color;
    end;
  end;
end;