FireMonkey TControl.MakeScreenshot在Mobile平台上生成一个尺寸不足的位图

Question

我试图从TLayout控件生成位图.要做到这一点,我正在使用TControl.Makescreenshot功能.在Windows上测试应用程序时,一切都按预期工作:

但是,运行在iOS,安卓(包括模拟器和真实设备)的应用程序时,结果是这样的(图像周围的红色边框绘制只是位图的边界内):

在移动版本中,图像是一半大小并且边框被裁剪.

这是我使用的代码:

(.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

问题是与像素密度有关还是FireMonkey错误？

Answer 1

Firemonkey 对TBitmap有特殊属性，它允许在 Canvas 上使用不同的 sacle 来绘制该位图。例如，比例 = 2。请使用下一种方法：

1. 使用物理尺寸制作位图（例如在 Scale=2 屏幕上，PhysicalWidth = LogicalWidth * Scale）
2. （位图为 IBitmapAccess）.BitmapScale = 2

之后，TCanvas 将以更高的质量绘制此位图。

请看这篇文章：http://fire-monkey.ru/page/articles/_/articles/graphics/graphics-screenshot

它在俄罗斯，但代码在英语:-) 并使用本文中的代码和我上面的建议（（位图为 IBitmapAccess）.BitmapScale = 2）

谢谢