FireMonkey TControl.MakeScreenshot generates an undersized bitmap on Mobile platforms

Question

I am trying to generate a bitmap from a TLayout control. To do this I'm using the TControl.Makescreenshot function. When testing the application on Windows, everything works as expected:

However, when running the application on iOS, Android (both emulators and real devices), the result looks like this (The red border around the image is drawn just inside the border of the bitmap):

In the mobile version the image is half size and the border is cropped.

Here's the code I used:

(.pas)

unit Unit15;

interface

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

type
  TForm15 = class(TForm)
    Layout1: TLayout;
    Image1: TImage;
    Button1: TButton;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    Switch1: TSwitch;
    ArcDial1: TArcDial;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form15: TForm15;

implementation

{$R *.fmx}

procedure TForm15.Button1Click(Sender: TObject);
begin
  Image1.Bitmap := Layout1.MakeScreenshot;
  Image1.Bitmap.Canvas.BeginScene;
  try
    Image1.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Red;
    Image1.Bitmap.Canvas.DrawRect(RectF(1, 1, Image1.Bitmap.Width - 1, Image1.Bitmap.Height - 2), 0, 0, [], 1);
  finally
    Image1.Bitmap.Canvas.EndScene;
  end;

  Edit1.Text := format('Image = Width: %d - Height: %d', [Image1.Bitmap.Width, Image1.Bitmap.Height]);
  Edit2.Text := format('Original = Width: %d - Height: %d', [Round(Layout1.Width), Round(Layout1.Height)]);
end;

procedure TForm15.FormResize(Sender: TObject);
begin
  Layout1.Height := ClientHeight div 2;
end;

end.

(.fmx)

object Form15: TForm15
  Left = 0
  Top = 0
  Caption = 'Form15'
  ClientHeight = 460
  ClientWidth = 320
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [dkDesktop]
  OnResize = FormResize
  DesignerMobile = True
  DesignerWidth = 320
  DesignerHeight = 480
  DesignerDeviceName = 'iPhone'
  DesignerOrientation = 0
  DesignerOSVersion = '6'
  object Layout1: TLayout
    Align = alTop
    ClipChildren = True
    Height = 233.000000000000000000
    Width = 320.000000000000000000
    object Button1: TButton
      Height = 44.000000000000000000
      Position.X = 8.000000000000000000
      Position.Y = 8.000000000000000000
      TabOrder = 0
      Text = 'Click to create Bitmap'
      Trimming = ttCharacter
      Width = 201.000000000000000000
      OnClick = Button1Click
    end
    object CheckBox1: TCheckBox
      Height = 23.000000000000000000
      Position.X = 24.000000000000000000
      Position.Y = 56.000000000000000000
      TabOrder = 1
      Text = 'CheckBox1'
      Width = 120.000000000000000000
    end
    object Label1: TLabel
      Height = 23.000000000000000000
      Position.X = 24.000000000000000000
      Position.Y = 88.000000000000000000
      Text = 'Label1'
      Width = 82.000000000000000000
      Trimming = ttCharacter
    end
    object Switch1: TSwitch
      Height = 27.000000000000000000
      IsChecked = False
      Position.X = 24.000000000000000000
      Position.Y = 120.000000000000000000
      TabOrder = 3
      Width = 78.000000000000000000
    end
    object ArcDial1: TArcDial
      Height = 81.000000000000000000
      Position.X = 216.000000000000000000
      Position.Y = 16.000000000000000000
      TabOrder = 4
      Width = 97.000000000000000000
    end
    object Edit1: TEdit
      Touch.InteractiveGestures = [igLongTap, igDoubleTap]
      TabOrder = 5
      Position.X = 8.000000000000000000
      Position.Y = 192.000000000000000000
      Width = 305.000000000000000000
      Height = 31.000000000000000000
      KillFocusByReturn = False
    end
    object Edit2: TEdit
      Touch.InteractiveGestures = [igLongTap, igDoubleTap]
      TabOrder = 6
      Position.X = 8.000000000000000000
      Position.Y = 152.000000000000000000
      Width = 305.000000000000000000
      Height = 31.000000000000000000
      KillFocusByReturn = False
    end
  end
  object Image1: TImage
    MultiResBitmap = <
      item
      end>
    Align = alClient
    Height = 227.000000000000000000
    MarginWrapMode = iwOriginal
    Width = 320.000000000000000000
    WrapMode = iwOriginal
  end
end

Is the problem something to do with pixel density or is it a FireMonkey bug?

Answer 1

Firemonkey has special property for TBitmap, which allow said Canvas, that this bitmap we should draw with different sacle. For Example with Scale = 2. Please, use next approach:

1. Make Bitmap with physical size (for example on Scale=2 screen, PhysicalWidth = LogicalWidth * Scale)
2. (Bitmap as IBitmapAccess).BitmapScale = 2

After that TCanvas will draw this bitmap with increased quality.

Please, look at this article: http://fire-monkey.ru/page/articles/_/articles/graphics/graphics-screenshot

It is on Russia, but code on English :-) And use code from this article with my suggestion above ((Bitmap as IBitmapAccess).BitmapScale = 2)

Thank you

Answer 2

It looks like this is a bug. Submitted to Quality Central: http://qc.embarcadero.com/wc/qcmain.aspx?d=119609

Answer 3

I have the same issue. My only workaround so far is to: 1. Create a new TBitmap (Temp) and work with the newly created bitmap to do everything that the Image's Bitmap should have done. 2. After everything is drawn on this Temp Bitmap assign the Temp Bitmap to the Image example: Image1.MultiResBitmap.Items[1].assign(TempBitmap). 3. Set the wrap mode of the Image to IWStretch.

This workaround did work for me, however it caused slower rendering for the image. I really hope the get solved soon.

procedure Form1.Draw;
var
 TempBmp : FMX.Graphics.TBitmap;
begin
  TempBmp := FMX.Graphics.TBitmap.Create;
  TempBmp.SetSize(round(Image1.Width),round(Image1.Height));
  with TempBmp.Canvas do
  begin
    //Work with the TempBmp here
  end;
  Image1.MultiResBitmap.Bitmaps[1].Assign(TempBmp);
  Image1.Bitmap := Image1.MultiResBitmap.Bitmaps[1];
  TempBmp.Free;
end;