FMX Вывод image размером больше 8К

[stalkernet]

Всем хорошего дня.
возникла ситуация - вывести image формата А4 с dpi 2400 (размер 186141,280629 пикселей).

естественно TBitmap & TImage больше 8К пикселей нехочет. пишет - too big bitmap.
спросил гуглчя - предложений два:

вариант 1 - использовать дерективу
GlobalUseDirect2D := false;

не походит - слишком много кода завязано на этом рендере. Переписывать не будут.

вариант 2
Грузить в TBtmapSurFace;
поделить Image на куски 8К пикселей.
выводить куски на TImage в соответствии как надо.

Прежде чем изобретать трехколесный лисопед на пятигранных колесах - возник вопрос.
Может есть уже чтото готовое, о котором не знаю.

Если есть мысли - Буду рад услышать.

[stalkernet]

Мда. хотелось как лучше - получилось как всегда.....

после изучения direct2D

https://docs.microsoft.com/ru-ru/win...ct2d/reference

и метода научного тыка коечкго выяснилось.

по факту:

TBitmapSurface - обычный дыухмерный массив для хранения данных, с мин. оберткой заточеной под совместимость с TBitmap(текстуры).
TBitmap - заточен под Direct2D.
Откуда берется ограничение в 8К пикселей - мнения в инете разделились - или ограничение железа, или огранечение в версии DirectX(9 - 4К, 10 - 8К, 11 - 32К пикселей).

вобщем лосипед всеравно пришось изобретать.

на основе того что TBitmap.Assign(TBitmapSurface) само ужимает surface до мах в 8К пиклелей по мах стороне добавил окно панарамы. в нем выделяется участок который надо просмотреть и выделение копируется в TImage. В соответствии с задачей - более чем достаточно.

с чем столкнулся - TBitmapSurface не умеет копировать Rectangle. но решилось просто.

через Scanline копируем в temp массив. из него в temp1 капируем нужный участок. temp1 копируем в временный TBitmapSurface. его через TBitmap.Assigin присваеваем нужному битмапу.
геморойно но работает. главное не забывать что раьотаем с массивом типа байт.

пример кода позже.

да еще. пока возился нашел интересный код - от наших друзей китайцев. но не пробывал и особо не разбирался.

https://github.com/zhaoyipeng/FMXCom...tiveCanvas.pas

[stalkernet]

Собственно код и как делал.
не забываем что на вкус и цвет - все фломастеры разные. Но критика приветствуется.

создание Panaram картинки.
с помощью TBitmapCodecManager из файла грузим в TBitmapSurface.

var
 BMPSur : TBitmapsurface;

BmpSur := Tbitmapsurface.Create;
TBitmapCodecManager.LoadFromFile('0001.bmp',bmpsur);
Image1.Bitmap.Assign(BMPSur);

Не забываем, что теперь мы не можем сами выбрать кодек с помощю которого грузить. определяет по заголовку в файле.
Также не забывваем сначала Surface ужимается до TCanvasAttribute.MaxBitmapSize, а потом ухе TImage выводит со своими настройками.

получение махBitmap в пикселях.

var
 bmp: Tbitmap;

Bmp := TBitmap.Create;
edit1.Text := Bmp.Canvas.GetAttribute(TCanvasAttribute.MaxBitmapSize).ToString;

ну или так

edit1.Text := TCanvasManager.DefaultCanvas.GetAttribute(TCanvasAttribute.MaxBitmapSize).ToString;

проверено - работает.

копирование Rectangle в TImage

алгоритм описан(кратко) в предпосте.

код копирования куска изображения.
x,y - откуда копируем
w,h - сколько копируем

function TForm1.SetSelectSurface(inbmp: TbitmapSurface; x,y,w,h: integer): Tbitmap;
var
 CBmpS : TbitmapSurFace;
 CBmp : Tbitmap;
 xe,ye : integer;
 scan : integer;
 temp,temp1 : Tarray<byte>;
 len : integer;

begin
xe := (x*4);
len := (w) * 4;

CBmpS := TbitmapSurface.Create;
CBmpS.SetSize(w, h, TPixelFormat.RGBA);
CBmp := Tbitmap.Create;
  setlength(temp,inbmp.Width*4);
  setlength(temp1,len);

  for scan := y to ( y+ (h - 1)) do begin
   Move(inbmp.Scanline[scan]^, temp[0], inbmp.Width*4);
   temp1 := copy(temp, xe, len);
   Move(temp1[0], TBitmapSurface(CBmpS).Scanline[scan-y]^, len);
  end;
   CBmp.Assign(CBmpS);

result := CBmp;
end;

использование

var
 BMPSur : TBitmapsurface;

BmpSur := Tbitmapsurface.Create;
TBitmapCodecManager.LoadFromFile('0001.bmp',bmpsur);
Image1.Bitmap.Assign(bmpsur,0,0,10,10);

очистку памяти и проверку на оБШИЬки допишете сами - в соответствии какой флоастер нравится на вкус. Главное не забыть о наследовании указателей. (еще тот геморой).

опятьже не забываем о настройках вывода TImage.
желательно делать программно. меньше глюков - но больше кода.
код работает.Проверен при настройке TImage.WrapMode := TImageWrapMode.Original;
Главное - о выделении памяти - реализовано под 4 байт. поэтому на 100 Мпикселей потребуется 400 Мбайт памяти.(CBmpS.SetSize(w, h, TPixelFormat.RGBA)

теперь о рисовании на Surface. рисует линию в 1 пиксель длинной 51 пиксель на 19 позиции по Width.

procedure TForm1.Button6Click(Sender: TObject);
var
y : integer;
begin
for y := 0 to 50 do begin
 BMPSur.Pixels[20,y] := claBlue;
end;
 image1.Bitmap.Assign(SetSelectSurface(bmpsur,0 ,0,100,100));
end;

Думаю все понятно.