FMX TTabControl 中的多行选项卡

Question

VCL TTabConrol 中有一个众所周知的属性 Multiline 允许将选项卡放置在多行中。

但是FMX库中没有这样的属性。 FMX 应用程序中可以多行显示选项卡吗？

Answer 1

不，这是不可能的，至少不是开箱即用的。如果要添加支持，请仔细查看 TTabControl.RealignTabs;。

Answer 2

不完美但工作

unit BFSTabControl;

interface

uses
  System.Classes, System.Types, System.Math, System.Rtti, System.SysUtils
  , FMX.TabControl, FMX.Controls;

type
  TBFSTabControl = class(TTabControl)
  private
    rttc,rtti: TRttiType;
    rtFRealigningTabs,rtFContent,rtFBackground,rtFNoItemsContent,rtFClientRect,rtFTabContentSize,rtFTabBarRect,rtFLeftOffset,rtFRightOffset: TRttiField;
    FMultiLineTabs: Boolean;
    procedure SetMultiLineTabs(const Value: Boolean);

  protected
    procedure RealignTabs; override;
  public
    constructor Create(AOwner: TComponent); override;

    property MultiLineTabs: Boolean read FMultiLineTabs write SetMultiLineTabs;
  end;

implementation

constructor TBFSTabControl.Create(AOwner: TComponent);
begin
  rttc := TRTTIContext.Create.GetType(TTabControl);
  rtFRealigningTabs := rttc.GetField('FRealigningTabs');
  rtFContent := rttc.GetField('FContent');
  rtFBackground := rttc.GetField('FBackground');
  rtFNoItemsContent := rttc.GetField('FNoItemsContent');
  rtFClientRect := rttc.GetField('FClientRect');
  rtFTabContentSize := rttc.GetField('FTabContentSize');
  rtFTabBarRect := rttc.GetField('FTabBarRect');

  rtti := TRTTIContext.Create.GetType(TTabItem);
  rtFLeftOffset := rtti.GetField('FLeftOffset');
  rtFRightOffset := rtti.GetField('FRightOffset');

  FMultiLineTabs := True;

  inherited;
end;

type
  TFakeTabItem = class(TTabItem);
  TOpenControl = class(TControl);

function GetIdxBeg(ARow: Integer; CountInRow: array of Integer): Integer;
var
  I: Integer;
begin
  Result := 0;
  if ARow > 0 then
    for I := 0 to ARow-1 do
      Result := Result +CountInRow[I];
end;

function CalcRowWidth(ARow: Integer; ItemsWidth: array of Single; CountInRow: array of Integer): Single;
var
  I, IdxBeg: Integer;
begin
  IdxBeg := GetIdxBeg(ARow,CountInRow);
  Result := 0;
  for I := IdxBeg to IdxBeg +CountInRow[ARow] - 1 do
    Result := Result +ItemsWidth[I];
end;

procedure TBFSTabControl.RealignTabs;
const
  MinHeight = 5;
var
  I, J, CountVisibleItems, RowCount, BegRowIdx, RowIdx, ActiveRow, Surplus: Integer;
  CurX, CurY, LLeftOffset, LRightOffset, RowWidth, TotalWidth, TotalHeight, MaxHeight, CurRowWidth, ItemWidth, ExtraWidth, ExtraWidthRow: Single;
  ItemRect: TRectF;
  LItem: TFakeTabItem;
  ItemsRowIdx, CountInRow: array of Integer;
  ItemsWidth: array of Single;
  VisibleLItems: array of TFakeTabItem;

  FClientRect: TRectF;
  FContent: TContent;
  FBackground: TControl;
  FTabContentSize: TSizeF;
  FTabBarRect: TRectF;
begin
  if (not FMultiLineTabs) or (FMultiLineTabs and (EffectiveTabPosition in [TTabPosition.None, TTabPosition.Dots])) then begin
    inherited;
    Exit;
  end;

  if rtFRealigningTabs.GetValue(Self).AsBoolean then
    Exit;

  FContent := rtFContent.GetValue(Self).AsObject as TContent;
  if ([csLoading, csDestroying] * ComponentState = []) then begin
    rtFRealigningTabs.SetValue(Self,True);
    try
      // Initialization
      FClientRect := LocalRect;
      FBackground := TControl(rtFBackground.GetValue(Self).AsObject);
      if FBackground <> nil then
        FClientRect := FBackground.Padding.PaddingRect(FClientRect);
      if ResourceControl <> nil then
        FClientRect := ResourceControl.Margins.PaddingRect(FClientRect);
      rtFClientRect.SetValue(Self,TValue.From<TRectF>(FClientRect));

      // Get only visible items
      CountVisibleItems := 0;
      SetLength(VisibleLItems,TabCount);
      for I := 0 to TabCount - 1 do begin
        LItem := TFakeTabItem(Tabs[I]);
        LItem.FDesignSelectionMarks := True;
        if LItem.Visible then begin
          VisibleLItems[CountVisibleItems] := LItem;
          Inc(CountVisibleItems);
        end;
      end;

      // Calc minimum row count, total width and max height
      TotalWidth := 0;
      RowCount := 0;
      CurRowWidth := 0;
      MaxHeight := MinHeight;
      SetLength(ItemsWidth,CountVisibleItems);
      for I := 0 to CountVisibleItems - 1 do begin
        LItem := VisibleLItems[I];
        MaxHeight := Max(MaxHeight, Trunc(LItem.Info.Size.cy + LItem.Margins.Top + LItem.Margins.Bottom));
        ItemWidth := LItem.Info.Size.cx + LItem.Margins.Left + LItem.Margins.Right;
        ItemsWidth[I] := ItemWidth;
        if ItemWidth > FClientRect.Width then begin
          if CurRowWidth <> 0 then
            Inc(RowCount);
          CurRowWidth := 0;
          Inc(RowCount);
        end else if (CurRowWidth +ItemWidth) > FClientRect.Width then begin
          CurRowWidth := ItemWidth;
          Inc(RowCount);
        end else
          CurRowWidth := CurRowWidth +ItemWidth;

        if (I = CountVisibleItems - 1) and (ItemWidth <= FClientRect.Width) then
          Inc(RowCount);

        TotalWidth := TotalWidth +ItemWidth;
      end;

      // Сhecking that it is not necessary to line-align
      if (TotalWidth+1) < FClientRect.Width then begin
        rtFRealigningTabs.SetValue(Self,False);
        inherited;
        Exit;
      end else
        TControl(rtFNoItemsContent.GetValue(Self).AsObject).Visible := False;

      // Calc of extra additive for full filling
      ExtraWidth := Trunc((RowCount*FClientRect.Width -TotalWidth)/CountVisibleItems);
      if ExtraWidth < 0 then
        ExtraWidth := 0;

      // Filling from left to right line by line getting row index for each item
      RowIdx := 0;
      CurRowWidth := 0;
      SetLength(ItemsRowIdx,CountVisibleItems);
      for I := 0 to CountVisibleItems - 1 do begin
        ItemsRowIdx[I] := RowIdx;
        ItemWidth := ItemsWidth[I] +ExtraWidth;
        if (CurRowWidth = 0) and (ItemWidth > FClientRect.Width) and (RowIdx < (RowCount-1)) then begin
          CurRowWidth := 0;
          Inc(RowIdx);
        end else if ((CurRowWidth +ItemWidth) > FClientRect.Width) and (RowIdx < (RowCount-1)) then begin
          CurRowWidth := ItemWidth;
          Inc(RowIdx);
          ItemsRowIdx[I] := RowIdx;
        end else
          CurRowWidth := CurRowWidth +ItemWidth;
      end;

      // Calc count items in row
      SetLength(CountInRow,RowCount);
      for I := 0 to RowCount - 1 do
        CountInRow[I] := 0;
      for I := 0 to CountVisibleItems - 1 do
        CountInRow[ItemsRowIdx[I]] := CountInRow[ItemsRowIdx[I]] +1;

      // Checking sum of items width in row and resort them
      for I := RowCount-1 downto 1 do begin
        if CountInRow[I] = 1 then
          Continue;
        while True do begin
          if CalcRowWidth(I,ItemsWidth,CountInRow) <= FClientRect.Width then
            Break;
          BegRowIdx := GetIdxBeg(I,CountInRow);
          ItemsRowIdx[BegRowIdx] := ItemsRowIdx[BegRowIdx] -1;
          CountInRow[I-1] := CountInRow[I-1] +1;
          CountInRow[I] := CountInRow[I] -1;
          if CountInRow[I] = 1 then
            Break;
        end;
        if CalcRowWidth(I-1,ItemsWidth,CountInRow) <= FClientRect.Width then
          Break;
      end;

      // Get row with active tab
      ActiveRow := -1;
      for I := 0 to CountVisibleItems - 1 do
        if VisibleLItems[I] = ActiveTab then begin
          ActiveRow := ItemsRowIdx[I];
          Break;
        end;

      // Initialization of bounds
      FTabContentSize := TSizeF.Create(FClientRect.Width, MaxHeight*RowCount);
      rtFTabContentSize.SetValue(Self,TValue.From<TSizeF>(FTabContentSize));
      FTabBarRect := TRectF.Create(TPointF.Zero, FClientRect.Width, MaxHeight*RowCount);
      case EffectiveTabPosition of
        TTabPosition.Top:
          FTabBarRect.Offset(FClientRect.TopLeft);
        TTabPosition.Bottom:
          FTabBarRect.Offset(FClientRect.Left, FClientRect.Bottom - FTabBarRect.Height);
      end;
      rtFTabBarRect.SetValue(Self,TValue.From<TRectF>(FTabBarRect));
      FContent.BoundsRect := TabBarRect;

      // Update tab positions
      TotalHeight := 0;
      if EffectiveTabPosition = TTabPosition.Bottom then
        TotalHeight := MaxHeight;
      BegRowIdx := 0;
      for I := 0 to RowCount - 1 do begin
        if I > 0 then BegRowIdx := BegRowIdx +CountInRow[I-1];
        RowWidth := 0;
        for J := BegRowIdx to BegRowIdx+CountInRow[I] -1 do
          RowWidth := RowWidth +ItemsWidth[J];
        LLeftOffset := rtFLeftOffset.GetValue(VisibleLItems[BegRowIdx]).AsType<Single>;
        LRightOffset := rtFLeftOffset.GetValue(VisibleLItems[BegRowIdx+CountInRow[I] -1]).AsType<Single>;
        ExtraWidthRow := Trunc((FClientRect.Width +LLeftOffset +LRightOffset -RowWidth)/CountInRow[I]);
        Surplus := Trunc(Max(FClientRect.Width +LLeftOffset +LRightOffset -RowWidth -ExtraWidthRow*CountInRow[I], 0));
        CurX := TabContentPosition - LLeftOffset;
        if I = ActiveRow then begin
          if EffectiveTabPosition = TTabPosition.Bottom then
            CurY := 0
          else
            CurY := (RowCount - 1)*MaxHeight
        end else
          CurY := TotalHeight;
        for J := BegRowIdx to BegRowIdx+CountInRow[I] -1 do begin
          LItem := VisibleLItems[J];
          ItemRect := TRectF.Create(TPointF.Create(CurX, CurY), LItem.Info.Size.cx +ExtraWidthRow, MaxHeight);
          ItemRect := LItem.Margins.PaddingRect(ItemRect);
          if J = BegRowIdx+CountInRow[I] -1 then
            ItemRect.Width := ItemRect.Width + Surplus;
          LItem.BoundsRect := ItemRect;
          CurX := CurX + ItemRect.Width + LItem.Margins.Left + LItem.Margins.Right;
        end;

        if I <> ActiveRow then
          TotalHeight := TotalHeight+MaxHeight;
      end;

      if not FDisableAlign then
        Realign;
    finally
      rtFRealigningTabs.SetValue(Self,False);
    end;
  end else
    FContent.Height := 0;
end;

procedure TBFSTabControl.SetMultiLineTabs(const Value: Boolean);
begin
  FMultiLineTabs := Value;
  Realign;
end;

end.

FMX TTabControl 中的多行选项卡

Multiline Tabs in an FMX TTabControl

delphi

tabcontrol

firemonkey