CODEWITHSUNDEEP
delphifiremonkeydelphi-xe8
Luiz Alves
Luiz Alves

Reputation: 2645

How to set TvertScollBox to scroll items in Delphi FireMonkey

I have a form with a TFlowLayout inside the TVertScrollbox.

I fill the TFlowLayout with some frames at runtime, that can have variable height.

I´d like to set the VertScrollBox.ContentBounds to be able to scroll from the first to the last frame added.

It seems I have to use CalcContentBounds of the TVertScrollBox. How could I do it?

procedure TForm1.Button2Click(Sender: TObject);
var
  fr:TfrFrameItem;
  i:integer;
begin
  FlowLayout1.BeginUpdate;
  for i:=FlowLayout1.ControlsCount-1 downto 0 do begin
    FlowLayout1.Controls[i].Free;
  end;
  for i:=0 to 100 do begin
    fr:=TfrFrameItem.Create(FlowLayout1);
    fr.Name:='fr'+FlowLayout1.ControlsCount.ToString();
    fr.Parent:=FlowLayout1;
    fr.Visible:=True;
  end;
  FlowLayout1.EndUpdate;
  VertScrollBox1.RealignContent;
end;

procedure TForm1.VertScrollBox1CalcContentBounds(Sender: TObject;
  var ContentBounds: TRectF);
begin
  ContentBounds.Bottom:=?????
end;

Unit1.pas

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts,
  FMX.Controls.Presentation, FMX.StdCtrls,Math, FMX.Objects, FMX.Edit,
  FMX.ListBox, FMX.ScrollBox, FMX.Memo, FMX.TabControl, FMX.MultiView;

type
  TForm1 = class(TForm)
    VertScrollBox1: TVertScrollBox;
    FlowLayout1: TFlowLayout;
    Panel1: TPanel;
    ToolBar1: TToolBar;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses uFrameitem;
{$R *.fmx}

procedure TForm1.Button2Click(Sender: TObject);
var
  lFrame:TfrFrameItem;
  i:integer;
  lHeight:single;
begin

  FlowLayout1.BeginUpdate;
  try
    for i := FlowLayout1.ControlsCount - 1 downto 0 do
      FlowLayout1.Controls[i].Free;

    lHeight := 0;
    for i := 0 to 100 do
    begin
     lFrame := TfrFrameItem.Create(FlowLayout1);
     lFrame.Name := 'fr' + FlowLayout1.ControlsCount.ToString;
     lFrame.Parent := FlowLayout1;
     lFrame.Visible := True;
     lHeight := Max(lHeight, lFrame.Position.Y + lFrame.Height);
    end;
    FlowLayout1.Height := lHeight;
  finally
    FlowLayout1.EndUpdate;
  end;
  VertScrollBox1.RealignContent;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i:integer;
begin
  for i:=FlowLayout1.ControlsCount-1 downto 0 do begin
    FlowLayout1.Controls[i].Free;
  end;
end;

end.

Unit1.fmx

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 647
  ClientWidth = 1057
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnDestroy = FormDestroy
  DesignerMasterStyle = 0
  object VertScrollBox1: TVertScrollBox
    Align = Client
    Size.Width = 1057.000000000000000000
    Size.Height = 568.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    Viewport.Width = 1057.000000000000000000
    Viewport.Height = 568.000000000000000000
    object FlowLayout1: TFlowLayout
      Align = Top
      Size.Width = 1057.000000000000000000
      Size.Height = 177.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
      Justify = Left
      JustifyLastLine = Left
      FlowDirection = LeftToRight
    end
  end
  object Panel1: TPanel
    Align = Bottom
    Position.Y = 608.000000000000000000
    Size.Width = 1057.000000000000000000
    Size.Height = 39.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 2
  end
  object ToolBar1: TToolBar
    Size.Width = 1057.000000000000000000
    Size.Height = 40.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 3
    object Button2: TButton
      Align = Right
      Position.X = 977.000000000000000000
      Size.Width = 80.000000000000000000
      Size.Height = 40.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
      Text = 'Preencher'
      OnClick = Button2Click
    end
  end
end

uFrameItem.pas

unit uFrameItem;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Objects, FMX.Layouts;

type
  TfrFrameItem = class(TFrame)
    Layout1: TLayout;
    Rectangle1: TRectangle;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Layout2: TLayout;
    Label3: TLabel;
    Label6: TLabel;
    Layout3: TLayout;
    Label7: TLabel;
    Label8: TLabel;
    Button1: TButton;
    Rectangle2: TRectangle;
    Label5: TLabel;
    procedure Layout2Resize(Sender: TObject);
    procedure Label2Resize(Sender: TObject);
  private
    { Private declarations }
    function ListChildren(Obj : TFMXObject; Level : Integer):double;
  public
    { Public declarations }
  end;

implementation

{$R *.fmx}

function TfrFrameItem.ListChildren(Obj : TFMXObject; Level : Integer):double;
var  i: Integer;
begin
  for i := 0 to Obj.ChildrenCount-1 do begin
    if Obj.Children[i].Tag=1 then begin
      if (Obj.Children[i] is TLayout) then
        result:=result+TLayout(Obj.Children[i]).Height;
      if (Obj.Children[i] is TLabel) then
        result:=result+TLabel(Obj.Children[i]).Height;
      if (Obj.Children[i] is TImageControl) then
        result:=result+TImageControl(Obj.Children[i]).Height;
      if (Obj.Children[i] is TButton) then
        result:=result+TButton(Obj.Children[i]).Height;
    end;
    result:=result+ListChildren(Obj.Children[i],Level+1);
  end;
end;

procedure TfrFrameItem.Label2Resize(Sender: TObject);
const
  ExtraHeigthOfLayout = 10;
var
  Lbl: TLabel;
  Layout: TLayout;
begin
  Layout2Resize(Sender);
end;

procedure TfrFrameItem.Layout2Resize(Sender: TObject);
const
  ExtraHeigthOfLayout = 10;
var
  Lay: Tlayout;
  Layout: TLayout;
  i:integer;
  hh:double;
begin
  hh:=ListChildren(Layout1,0);
  Layout1.Height:=hh+60;
end;

end.

uFrameItem.fmx

object frFrameItem: TfrFrameItem
  Size.Width = 210.000000000000000000
  Size.Height = 391.000000000000000000
  Size.PlatformDefault = False
  object Layout1: TLayout
    StyleName = 'mystyle'
    Position.X = 5.000000000000000000
    Position.Y = 5.000000000000000000
    Size.Width = 201.000000000000000000
    Size.Height = 381.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 2
    object Rectangle1: TRectangle
      Align = Client
      Fill.Color = claLimegreen
      Padding.Left = 5.000000000000000000
      Padding.Right = 5.000000000000000000
      Size.Width = 201.000000000000000000
      Size.Height = 381.000000000000000000
      Size.PlatformDefault = False
      object Label1: TLabel
        Tag = 1
        Align = Top
        StyledSettings = [Family, FontColor]
        Padding.Top = 10.000000000000000000
        Padding.Bottom = 10.000000000000000000
        Margins.Top = 10.000000000000000000
        Margins.Bottom = 10.000000000000000000
        Position.X = 5.000000000000000000
        Position.Y = 10.000000000000000000
        Size.Width = 191.000000000000000000
        Size.Height = 17.000000000000000000
        Size.PlatformDefault = False
        TextSettings.Font.Size = 18.000000000000000000
        TextSettings.Font.Style = [fsBold]
        TextSettings.HorzAlign = Center
        Text = 'Raio x de quadril'
      end
      object Label2: TLabel
        Tag = 1
        Align = Top
        AutoSize = True
        StyledSettings = [Family, FontColor]
        Padding.Top = 10.000000000000000000
        Padding.Bottom = 10.000000000000000000
        Margins.Top = 10.000000000000000000
        Margins.Bottom = 10.000000000000000000
        Position.X = 5.000000000000000000
        Position.Y = 84.000000000000000000
        Size.Width = 191.000000000000000000
        Size.Height = 24.000000000000000000
        Size.PlatformDefault = False
        TextSettings.Font.Size = 18.000000000000000000
        TextSettings.Font.Style = [fsBold]
        Text = 'Raio x de quadril '
        OnResize = Label2Resize
      end
      object Label4: TLabel
        Tag = 1
        Align = Top
        StyledSettings = [Family, FontColor]
        Padding.Top = 10.000000000000000000
        Padding.Bottom = 10.000000000000000000
        Margins.Top = 10.000000000000000000
        Margins.Bottom = 10.000000000000000000
        Position.X = 5.000000000000000000
        Position.Y = 47.000000000000000000
        Size.Width = 191.000000000000000000
        Size.Height = 17.000000000000000000
        Size.PlatformDefault = False
        TextSettings.Font.Size = 18.000000000000000000
        TextSettings.Font.Style = [fsBold]
        TextSettings.HorzAlign = Center
        Text = 'Raio x de quadril'
      end
      object Layout2: TLayout
        Tag = 1
        Align = Top
        Position.X = 5.000000000000000000
        Position.Y = 151.000000000000000000
        Size.Width = 191.000000000000000000
        Size.Height = 37.000000000000000000
        Size.PlatformDefault = False
        TabOrder = 3
        OnResize = Layout2Resize
        object Label3: TLabel
          Align = FitLeft
          StyledSettings = [Family, FontColor]
          Margins.Top = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Position.Y = 5.000000000000000000
          Size.Width = 42.678131103515620000
          Size.Height = 27.000000000000000000
          Size.PlatformDefault = False
          TextSettings.Font.Size = 18.000000000000000000
          TextSettings.Font.Style = [fsBold]
          Text = 'De:'
        end
        object Label6: TLabel
          Align = Client
          StyledSettings = [Family, FontColor]
          Size.Width = 148.321868896484400000
          Size.Height = 37.000000000000000000
          Size.PlatformDefault = False
          TextSettings.Font.Size = 16.000000000000000000
          TextSettings.Font.Style = [fsBold]
          Text = 'R$ 10,00'
        end
      end
      object Layout3: TLayout
        Tag = 1
        Align = Top
        Position.X = 5.000000000000000000
        Position.Y = 118.000000000000000000
        Size.Width = 191.000000000000000000
        Size.Height = 33.000000000000000000
        Size.PlatformDefault = False
        TabOrder = 4
        object Label7: TLabel
          Align = FitLeft
          StyledSettings = [Family, FontColor]
          Margins.Top = 5.000000000000000000
          Margins.Bottom = 5.000000000000000000
          Position.Y = 5.000000000000000000
          Size.Width = 43.193511962890620000
          Size.Height = 23.000000000000000000
          Size.PlatformDefault = False
          TextSettings.Font.Size = 18.000000000000000000
          TextSettings.Font.Style = [fsBold]
          Text = 'Por:'
        end
        object Label8: TLabel
          Align = Client
          StyledSettings = [Family, FontColor]
          Size.Width = 147.806488037109400000
          Size.Height = 33.000000000000000000
          Size.PlatformDefault = False
          TextSettings.Font.Size = 16.000000000000000000
          TextSettings.Font.Style = [fsBold]
          Text = 'R$ 10,00'
        end
      end
    end
    object Button1: TButton
      StyledSettings = [Family, FontColor]
      Position.X = 32.000000000000000000
      Position.Y = 320.000000000000000000
      Size.Width = 129.000000000000000000
      Size.Height = 41.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
      Text = 'Comprar'
      TextSettings.Font.Size = 20.000000000000000000
      TextSettings.Font.Style = [fsBold]
    end
    object Rectangle2: TRectangle
      Opacity = 0.800000011920928900
      Position.X = 156.000000000000000000
      Position.Y = -7.000000000000000000
      Size.Width = 50.000000000000000000
      Size.Height = 25.000000000000000000
      Size.PlatformDefault = False
      Stroke.Color = claChocolate
      object Label5: TLabel
        Align = Client
        StyledSettings = [Size, FontColor]
        Size.Width = 50.000000000000000000
        Size.Height = 25.000000000000000000
        Size.PlatformDefault = False
        TextSettings.Font.Family = 'Segoe UI Semibold'
        TextSettings.Font.Style = [fsBold]
        TextSettings.HorzAlign = Center
        Text = '100%'
      end
    end
  end
end

Upvotes: 1

Views: 3920

Answers (2)

Bill Walton
Bill Walton

Reputation: 13

Although this is for TVertScrollBox, I think this issue may be related/similar to the issues I've had with TScrollBox. TScrollBox wasn't updating (immediately) its boundaries/targets when the size\position of control within it, changed. It did update eventually after a repaint etc. I had several hours of headbanging before I got this solution.

I don't like subclassing, but in this case, I had to do it to TScrollCalculations so as I could access the protected procedure DoChanged.

  TMyScrollCalculations=class(TScrollCalculations)
  public
    procedure DoChanged;override;
  end;

When I changed the size of a control within my TScrollBox called ScrollBox1, I then called

TMyScrollCalculations(ScrollBox1).DoChanged;

And this allowed me to set the properties (in my case ViewportPosition) of the ScrollBox with the control's new boundaries correctly updated.

Upvotes: 0

Triber
Triber

Reputation: 1555

You don't need to change the TVertScrollBox at all. It automatically adjusts to its content. All you need is to change the size of the TFlowLayout. In this case it is necessary to recalculate the size whenever the size of the form is changed.

So you must replace VertScrollBox1.RealignContent with Self.Resize and then assign form's OnResize event.

procedure TForm1.FormResize(Sender: TObject);
begin
  if FlowLayout1.ControlsCount > 0 then
    FlowLayout1.Height := FlowLayout1.Controls.Last.BoundsRect.Bottom
  else
    FlowLayout1.Height := VertScrollBox1.Height; 
end;

Upvotes: 1

Related Questions