компонент TImage при больших размерах

← →
SvetaZ © (2015-02-18 13:58) [0]

Здравствуйте. При размере TImage = 3000x3000 вылетает ошибка:
"Недостаточно памяти для обработки команды." Это в Delphi7. Как это можно побороть? Или может следует перейти на более новую версия Delphi?

← →
MBo © (2015-02-18 14:42) [1]

1. Такой TImage содержит картинку (битмап) размером 36 мегабайт, а место в системе под картинки ограничено.

2. Такой размер TImage не нужен.
Нужно подумать, как решить реальную задачу. Для этого хорошо бы узнать её суть.

← →
SvetaZ © (2015-02-18 14:48) [2]

> Для этого хорошо бы узнать её суть.

Ну для примера хотя бы залить фото 2448х3264

← →
sniknik © (2015-02-18 15:12) [3]

странно, а у меня легко открыло... в d7
вот эту переконвертил в bmp
http://www.artfile.ru/i.php?i=636376
открыл Image1.Picture.LoadFromFile("C:\Data\Test.bmp")

← →
MBo © (2015-02-18 15:15) [4]

>хотя бы залить фото 2448х3264
Уменьшить его до нужного размера - ведь мало у кого есть мониторы с таким разрешением. Если нужно показывать кусок 1:1 - вырезать кусок, который помещается, и отобразить.

← →
SvetaZ © (2015-02-18 15:16) [5]

не через LoadFromFile, а из BitMap CopyRect

← →
sniknik © (2015-02-18 15:16) [6]

> следует перейти на более новую версия Delphi?
если только для написания программ под 64-бита если уж в память "упор". там больше выделяется.

> Ну для примера хотя бы залить фото 2448х3264
ну "заливать" можно файлом, открывать в TImage не обязательно.

← →
sniknik © (2015-02-18 15:17) [7]

> не через LoadFromFile, а из BitMap CopyRect
аааааа... так это у вас ошибка в программе. а причем тут память?

← →
SvetaZ © (2015-02-18 15:23) [8]

> MBo © (18.02.15 15:15) [4]

Эти куски все равно будут хранится в память, так тогда какая разница, если мы займем одинаковый объем памяти. Просто получается TImage не правильно работает.

← →
SvetaZ © (2015-02-18 15:25) [9]

> так это у вас ошибка в программе. а причем тут память?

Да не ошибки, можно просто создать такого размера TImage, ну и попробовать вывести хотя бы просто текст и будет такая ошибка.

← →
sniknik © (2015-02-18 15:30) [10]

> ну и попробовать вывести хотя бы просто текст и будет такая ошибка.
Image1.Picture.LoadFromFile("C:\Data\Test.bmp");
Image1.Canvas.TextOut(10, 10, "просто текст");
нету... ????

ты обещал. ;(

← →
backuper (2015-02-18 15:46) [11]

там в TImage случаем jpeg не загружен?..

← →
SvetaZ © (2015-02-18 16:01) [12]

> sniknik © (18.02.15 15:30) [10]

Image1.width := 3000;
Image1.height := 3000;

Image1.canvas.textout(10,10,"asdasd");

LoadFromFile - не нужно.

← →
sniknik © (2015-02-18 16:12) [13]

> Image1.width := 3000;
> Image1.height := 3000;

> Image1.canvas.textout(10,10,"asdasd");
и опять таки ошибки нет, хотя и не выводит ничего... вот так выводит
Image1.Width := 3000; Image1.Height:= 3000; Image1.Picture.Bitmap.Width:= 3000; Image1.Picture.Bitmap.Height:= 3000; Image1.Canvas.TextOut(100, 100, "asdasd");

← →
SvetaZ © (2015-02-18 16:21) [14]

> > Image1.width := 3000;
> > Image1.height := 3000;

ну это наверное от свободной памяти зависит, попробуйте больше.

← →
sniknik © (2015-02-18 16:24) [15]

больше -
const xy = 23170; begin Image1.Width := xy; Image1.Height:= xy; Image1.Picture.Bitmap.Width := xy; Image1.Picture.Bitmap.Height:= xy; Image1.Canvas.TextOut(100, 100, "asdasd"); end;

а 23171 дает ошибку -
---------------------------
Project1
---------------------------
Окно не имеет полос прокрутки.
---------------------------
ОК
---------------------------

← →
sniknik © (2015-02-18 16:30) [16]

> Окно не имеет полос прокрутки.
что наводит на мысль...
const xy = 223170; begin PaintBox1.Width := xy; PaintBox1.Height:= xy; PaintBox1.Canvas.TextOut(100, 100, "asdasd"); end;
работает.

← →
sniknik © (2015-02-18 16:41) [17]

кстати прикольно, у паинта нет ошибок до максимума -
const xy = MaxInt;
но отключаются полосы прокрутки (их просто не видно), обе, при xy = MaxInt - 8; восстанавливается вертикальная, а xy = MaxInt - 16; и горизонтальная, проблем нет в общем.

← →
invis © (2015-02-18 16:52) [18]

Image1.Picture.Bitmap := BitmapWithPhoto;

← →
icWasya © (2015-02-18 17:54) [19]

Ткт фишка такая. Внутри TImage по умолчанию сидит TBitmap, корорый, опять же по умолчанию создаётся в режиме PixelFormat = pfDevice. И в этом случае максимально возможный размер зависит от текущего режима графического адаптера.

← →
sniknik © (2015-02-18 18:20) [20]

> возможный размер зависит от текущего режима графического адаптера.
т.е. у автора поста "проблема" памяти в железе? и если в начале, перед изменениями размеров, поставить например
Image1.Picture.Bitmap.PixelFormat:= pf24bit;
то ошибки не будет?

подтверждается проверкой на xy = 23171; которая у меня не работала до смены PixelFormat, а c pf24bit работает, и даже чуть с большим размером... (а совсем большой уже не про прокрутку ошибку дает, а именно про память)

> т.е. у автора поста "проблема" памяти в железе?

- это означает что у системы/сеанса выжран весь подгружаемый пул
http://blogs.technet.com/b/mark_russinovich/archive/2010/04/06/3323382.aspx

при работе с большими растрами нужно использовать DIB-секцию(размещенную в памяти приложения), а никак не DDB(https://msdn.microsoft.com/en-us/liBRary/dd183561%28v=vs.85%29.aspx)

DIB - секция используется при смене PixelFormat?

Почему тогда не выводится текст?
Image1.Picture.Bitmap.PixelFormat := pf24bit;
Image1.Canvas.TextOut(10,10,"Привет");

> Почему тогда не выводится текст?
у меня выводится, т.что это наверное тоже зависит от железа, попробуй другие.
TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom);

> DIB - секция используется при смене PixelFormat?

Image1.Picture.Bitmap.PixelFormat <> pfDevice
либо явно
Image1.Picture.Bitmap.HandleType:= bmDIB;

> Почему тогда не выводится текст?

- Stretch? AutoSize??? полосы прокрутки у тебя есть?
может ты просто "не видишь сурка"(с)?

> sniknik © (20.02.15 11:00) [23]
>
> > Почему тогда не выводится текст?
> у меня выводится, т.что это наверное тоже зависит от железа,
> попробуй другие.
> TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit,
> pf16bit, pf24bit, pf32bit, pfCustom);

не работает, где-то в док. написано, что после загрузки изображения тоже должна использоваться DIB-секция. И тоже самое ничего не выводится:

Image1.Picture.LoadFromFile("test.bmp");
Image1.Canvas.TextOut(100,100,"dddddd");

Ну да и ладно.

TmyClass = class(TGraphicControl) private m_theBitmap: TBitmap; protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; TForm1 = class(TForm) ScrollBox1: TScrollBox; procedure FormCreate(Sender: TObject); private { Private declarations } m_theMy: TmyClass; public { Public declarations } end; constructor TmyClass.Create(AOwner: TComponent); begin inherited; m_theBitmap := TBitmap.Create; m_theBitmap.LoadFromFile("test1.bmp"); m_theBitmap.Canvas.Font.Assign(Font); Width := m_theBitmap.Width; Height := m_theBitmap.Height; end; destructor TmyClass.Destroy; begin inherited; m_theBitmap.Free; end; procedure TmyClass.Paint; var aRect: Trect; begin m_theBitmap.Canvas.TextOut(100, 100, "dddddd"); GetClipBox(Canvas.Handle, aRect); bitblt(Canvas.Handle, aRect.Left, aRect.Top, aRect.Right - aRect.Left, aRect.Bottom - aRect.Top, m_theBitmap.Canvas.Handle, aRect.Left, aRect.Top, SRCCOPY); end; procedure TForm1.FormCreate(Sender: TObject); begin m_theMy := TmyClass.Create(Self); m_theMy.Parent := ScrollBox1; end;

Тестил на битмапе размером 20000х18000 - норм. Единстаенное, что битмап долго грузится.

> Andy BitOff © (21.02.15 14:47) [26]

Но тут отрисовка идет в OnPaint

Так и не поняла почему так происходит:

1) Отображается только в OnPaint

procedure TForm1.Button1Click(Sender: TObject); var aRect: TRect; begin Image1.Picture.Bitmap.PixelFormat := pf1bit; Image1.Canvas.TextOut(10,10,"Привет"); end;

procedure TForm1.FormPaint(Sender: TObject); begin bitblt(Canvas.Handle, 0, 0, 100, 100,Image1.Canvas.Handle, 0, 0, SRCCOPY); end;

2) Отображается без OnPaint, но тогда не используем DIB-секцию

> procedure TForm1.Button1Click(Sender: TObject);
> var
> aRect: TRect;
> begin
> //Image1.Picture.Bitmap.PixelFormat := pf1bit;
> Image1.Canvas.TextOut(10,10,"Привет");
> end;

3) Так не отображается

> procedure TForm1.Button1Click(Sender: TObject);
> var
> aRect: TRect;
> begin
> Image1.Picture.Bitmap.PixelFormat := pf1bit;
> Image1.Canvas.TextOut(10,10,"Привет");
> bitblt(Canvas.Handle, 0, 0, 100, 100,Image1.Canvas.Handle,
> 0, 0, SRCCOPY);
> end;

> 3) Так не отображается
копируешь черно белый без полутонов рисунок? pf1bit это 1 битовая маска, т.е. 0 vs 1 значения, другое скорее всего не примет, авто преобразования с корекцией цвета в стандартном компоненте скорее всего нет.

компонент TImage при больших размерах Найти похожие ветки