delphifiremonkeyscalingtscrollbox

Scaling contents in FMX TScrollBox


A Scrollbox containing a series of TImageControls stacked vertically. When I scale the images and readjust the ImageControl positions, the Scrollbox.contents does not size properly. If I scale less than 1, there is extra space at the bottom; when it is more than 1, the last image is cut off. I've tried to call various routines (AdjustSizeValue, InvalidateContentSize, RecalcUpdateRect, RecalcSize etc) but these do nothing.

Here is a complete test project illustrating the problem:

unit Unit3;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.TabControl, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Edit,
  FMX.EditBox, FMX.SpinBox, FMX.Layouts;

type
  Tform1 = class(TForm)
    Button1: TButton;
    SpinBox1: TSpinBox;
    ScrollBox: TScrollBox;
    Layout1: TLayout;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    Label2: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);

    { Private declarations }
  public
    { Public declarations }
  end;

var
  form1: Tform1;

implementation
{$R *.fmx}

const
  PH = 1000;
  PW = 750;

procedure Tform1.Button1Click(Sender: TObject);

Function MakeImage(const aOwner:TControl; aNumber:integer): TImageControl;
begin
  result := TImageControl.Create(aOwner);
  result.EnableOpenDialog := false;
  result.SetBounds(0,0,PW,PH);
  result.Parent := ScrollBox;
  result.bitmap.SetSize( round(PW), round(PH)   );
  with Result.Bitmap.Canvas do
    if BeginScene then
    try
      fill.Color := TAlphaColorRec.Black;
      fill.Kind := TBrushKind.Solid;
      Font.Family := 'Arial';
      Font.Size := 100;
      FillText( RectF(00,00,200,200),aNumber.ToString,false,1, [], TTextAlign.Center,TTextAlign.Leading );
    finally
      EndScene;
    end;
end;

var
  i: Integer; Image:TImageControl; vertical:single;
begin
  vertical := 0;
  for i := 1 to round(SpinBox1.Value) do
  begin
     Image := MakeImage(ScrollBox,i);
     Image.Position.Y := vertical;
     vertical := vertical + Image.Height;
     Image.OnMouseMove := ImageMouseMove;
  end;
end;

procedure Tform1.Button2Click(Sender: TObject);
begin
  Scrollbox.AdjustSizeValue;
  Scrollbox.InvalidateContentSize;
  Scrollbox.RecalcUpdateRect;
  Scrollbox.RecalcAbsoluteNow;
  Scrollbox.Content.RecalcSize;
  Scrollbox.Content.RecalcUpdateRect;
  Scrollbox.Content.RecalcAbsoluteNow;
end;

procedure Tform1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
 Label1.Text := 'X:' + FloatToStrF(X,TFloatFormat.ffFixed,4,2) + ' Y:' + FloatToStrF(Y,TFloatFormat.ffFixed,4,2);
end;

procedure Tform1.TrackBar1Change(Sender: TObject);
var
  i: Integer; vertical,ScaleValue:Single;
begin
  vertical := 0;
  ScaleValue := TrackBar1.Value;
  Label2.Text := 'Scale: '+round(ScaleValue*100).ToString +'%';
  for i := 0 to ScrollBox.Content.ControlsCount - 1 do
  if ScrollBox.Content.Controls[i] is TImageControl then
    with ScrollBox.Content.Controls[i] as TImageControl do
    begin
      Scale.Y := TrackBar1.Value;
      Scale.X := TrackBar1.Value;
      Position.y := Vertical;
      Vertical := vertical + (PH*ScaleValue);
    end;
end;

end.

and

object form1: Tform1
  Left = 0
  Top = 0
  Caption = 'Form3'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Layout1: TLayout
    Align = Left
    Size.Width = 249.000000000000000000
    Size.Height = 480.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 1
    object Button1: TButton
      Position.X = 64.000000000000000000
      Position.Y = 56.000000000000000000
      TabOrder = 1
      Text = 'Start'
      OnClick = Button1Click
    end
    object SpinBox1: TSpinBox
      Touch.InteractiveGestures = [LongTap, DoubleTap]
      TabOrder = 3
      Cursor = crIBeam
      Max = 500.000000000000000000
      Value = 10.000000000000000000
      Position.X = 56.000000000000000000
      Position.Y = 104.000000000000000000
    end
    object Label1: TLabel
      Align = Bottom
      Position.Y = 192.000000000000000000
      Size.Width = 249.000000000000000000
      Size.Height = 288.000000000000000000
      Size.PlatformDefault = False
      TextSettings.HorzAlign = Center
      TabOrder = 4
    end
    object TrackBar1: TTrackBar
      CanParentFocus = True
      Max = 1.700000047683716000
      Min = 0.300000011920929000
      Orientation = Horizontal
      Position.X = 111.000000000000000000
      Position.Y = 152.000000000000000000
      TabOrder = 5
      Value = 1.000000000000000000
      OnChange = TrackBar1Change
    end
    object Label2: TLabel
      Position.X = 39.000000000000000000
      Position.Y = 152.000000000000000000
      Size.Width = 73.000000000000000000
      Size.Height = 17.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 6
    end
    object Button2: TButton
      Position.X = 64.000000000000000000
      Position.Y = 208.000000000000000000
      TabOrder = 7
      Text = 'Adjust'
      OnClick = Button2Click
    end
  end
  object ScrollBox: TScrollBox
    Align = Client
    Size.Width = 391.000000000000000000
    Size.Height = 480.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 2
    ShowSizeGrip = True
    Viewport.Width = 391.000000000000000000
    Viewport.Height = 480.000000000000000000
  end
end

Can anyone solve this?


Solution

  • I was able to reproduce the problem, and I did leave some comments on your question before, but deleted as I realized they were wrong.

    The solution is rather simple (as they usually are) when the correct code is applied. So here it is:

    procedure TForm5.TrackBar1Change(Sender: TObject);
    //var
    //  i: Integer; vertical,ScaleValue:Single;
    begin
      ScrollBox.Scale.X := TrackBar1.Value;
      ScrollBox.Scale.Y := TrackBar1.Value;
      ScrollBox.RecalcSize; // This was missing
      
      Label2.Text := TrackBar1.Value.ToString(ffFixed, 3, 3);
    end;