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?
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:
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