FireMonkey TControl.MakeScreenshot генерирует растровое изображение меньшего размера на мобильных платформах
Я пытаюсь сгенерировать растровое изображение из элемента управления 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?
3 ответа
Firemonkey имеет специальное свойство для TBitmap, которое позволяет Canvas, что это растровое изображение мы должны рисовать с другой сакле. Например, со шкалой = 2. Пожалуйста, используйте следующий подход:
- Сделать растровое изображение с физическим размером (например, на экране Scale = 2, PhysicalWidth = LogicalWidth * Scale)
- (Растровое изображение как IBitmapAccess).BitmapScale = 2
После этого TCanvas будет рисовать это растровое изображение с повышенным качеством.
Пожалуйста, посмотрите на эту статью: http://fire-monkey.ru/page/articles/_/articles/graphics/graphics-screenshot
Это по России, но код на английском:-) И используйте код из этой статьи с моим предложением выше ((Bitmap as IBitmapAccess).BitmapScale = 2)
Спасибо
Похоже, это ошибка. Отправлено в Quality Central: http://qc.embarcadero.com/wc/qcmain.aspx?d=119609
У меня такая же проблема. Пока что я могу только обойти это: 1. Создать новый TBitmap (Temp) и работать с вновь созданным растровым изображением, чтобы сделать все, что должен был сделать растровое изображение. 2. После того, как все будет нарисовано в этом временном растровом изображении, присвойте временное растровое изображение примеру изображения: 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;