Delphi FMX PaintTo() in different file

  

I have a small problem, I’m trying to save a portion of a TLayout (LayoutScale) in an Timage (ImmagineCreata). Being TLayout (LayoutScala) very large I would like to break it in many images 8000×8000, but what I get are many images of correct size but all white and only the first image filled with all the content of the TLayout but climbed on 8000×8000

procedure TForm1.Button1Click(Sender: TObject);
var ImmagineCreata : FMX.Graphics.TBitmap;
NumImgX, NumImgY, x, y, dimensioneX, dimensioneY : integer;
begin
if (LayoutScala.Width > 8000) or (LayoutScala.Height > 8000) then
begin
//valuta il numero di immagini da fare in x e in y
NumImgX := 1 + (Round(LayoutScala.Width) div 8000);
NumImgY := 1 + (Round(LayoutScala.Height) div 8000);
//salva le immagini
for y := 1 to NumImgY do
begin
//dimensione lato in y
dimensioneY := 8000;
if (y = NumImgY) then dimensioneY := Round((NumImgY * 8000) – LayoutScala.Height);
//valuta l’altro verso
for x := 1 to NumImgX do
begin
//dimensione lato in x
dimensioneX := 8000;
if (x = NumImgX) then dimensioneX := Round((NumImgX * 8000) – LayoutScala.Width);
// Crea il rettangolo di disegno con le dimensioni dell’immagine
ImmagineCreata := FMX.Graphics.TBitmap.Create(dimensioneX, dimensioneY);
ImmagineCreata.Clear(TAlphaColorRec.White);
ImmagineCreata.Canvas.BeginScene;
//Traccia il controllo e i suoi figli nel bitmap di destinazione
try LayoutScala.PaintTo(ImmagineCreata.Canvas, RectF((x-1)*8000, (y-1)*8000, ((x-1)*8000)+dimensioneX, ((y-1)*8000)+dimensioneY));
finally ImmagineCreata.Canvas.EndScene;
end;
// Salva l’immagine
ImmagineCreata.SaveToFile(‘C:\Immagine’+x.ToString+’.’+y.ToString+’.jpg’);
//svuota la memoria
ImmagineCreata.Free;
end;
end;
end;
end;

I use Delphi 10.2.3 and FireMonkey

Comments are closed.