FireMonkey TControl.MakeScreenshot在移动平台上生成小号位图

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，这让说画布，这个位图，我们应该用不同的sacle绘制特殊属性。对于具有实施例量表= 2请使用旁边的方法：

1. 使位图与物理尺寸（例如标度= 2屏幕上，PhysicalWidth = LogicalWidth *比例）
2. （位图作为IBitmapAccess）.BitmapScale = 2

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

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

这是对俄罗斯，但代码英语:-) 而从本文上面我的建议（（位图作为IBitmapAccess）.BitmapScale = 2）使用代码

谢谢

Answer 2

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

Answer 3

我有同样的问题。我目前唯一的解决方法是： 1.创建一个新的TBitmap（Temp）并使用新创建的位图来完成图像位图应该完成的所有操作。 2.在Temp Bitmap上绘制所有内容后，将Temp Bitmap分配给图像示例：Image1.MultiResBitmap.Items [1] .assign（TempBitmap）。 3.将图像的换行模式设置为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;