Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.08.2021, 14:30   #1
stalkernet
Пользователь
 
Регистрация: 28.02.2009
Сообщений: 42
По умолчанию FMX Вывод image размером больше 8К

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

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

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

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

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

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

Если есть мысли - Буду рад услышать.
stalkernet вне форума Ответить с цитированием
Старый 27.08.2021, 12:51   #2
stalkernet
Пользователь
 
Регистрация: 28.02.2009
Сообщений: 42
По умолчанию

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

после изучения 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 вне форума Ответить с цитированием
Старый 29.08.2021, 13:24   #3
stalkernet
Пользователь
 
Регистрация: 28.02.2009
Сообщений: 42
По умолчанию

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

создание 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;
Думаю все понятно.

Последний раз редактировалось stalkernet; 29.08.2021 в 13:29.
stalkernet вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вывод строки где больше символов Luchfan12 PHP 4 19.11.2015 16:12
Дана матрица A размером nxm. Определить k - количество особых элементов массива A, считая его элемент особым, если он больше суммы GalaiAnton Общие вопросы Delphi 1 22.03.2015 23:03
Задана матрица размером NxM. Определить k – количество “особых” элементов матрицы, считая элемент “особым”, если он больше суммы о Маленыч Общие вопросы Delphi 3 20.05.2013 00:08
Вывод на экран фамилий больше определенного возвраста SasukeUciha Помощь студентам 0 21.10.2011 22:31
пожалуста киньте ссылку где скачать Delphi размером не больше 100 мб. misher666 Общие вопросы Delphi 2 26.09.2009 10:40