FireMonkey TControl.MakeScreenshot 在移动平台上生成尺寸过小的位图

Question

我正在尝试从 TLayout 控件生成位图。为此，我使用了 TControl.Makescreenshot 函数。在 Windows 上测试应用程序时，一切正常：

但是，在 iOS、Android（模拟器和真实设备）上运行应用程序时，结果如下所示（图像周围的红色边框正好绘制在位图边框内）：

在移动版中，图像为一半大小，并且边框被裁剪。

这是我使用的代码：

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

看起来这是一个错误。提交至质量中心：http://qc.embarcadero.com/wc/qcmain.aspx?d=119609

Answer 2

我也有同样的问题。到目前为止，我唯一的解决方法是： 1.创建一个新的TBitmap（Temp），并使用新创建的位图来完成Image的Bitmap应该做的所有事情。 2. 在这个 Temp Bitmap 上绘制完所有内容后，将 Temp Bitmap 分配给 Image 示例：Image1.MultiResBitmap.Items[1].assign(TempBitmap)。 3.设置Image的换行方式为IWStretch。

此解决方法确实对我有用，但是它导致图像的渲染速度变慢。真心希望尽快解决。

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; 

Answer 3

Firemonkey 具有 TBitmap 的特殊属性，它允许说 Canvas，这个位图我们应该用不同的 sacle 绘制。例如 Scale = 2。请使用下一种方法：

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

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

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

它在俄罗斯，但代码是英文 :-) 并使用本文中的代码和我上面的建议 ((Bitmap as IBitmapAccess).BitmapScale = 2)

谢谢