Форум: "Основная";
Текущий архив: 2007.12.23;
Скачать: [xml.tar.bz2];
Вниз
Недостаточно памяти для обработки команды. Найти похожие ветки
← →
ggg (2007-10-03 18:28) [0]Приложение должно хранить большой объём фотографий с предпросмотром. Ошибка возникает в момент, когда число достигает 70 или около того, когда необходимо для сглаженного масштабирования преобразовать jpeg в bitmap. Т.е. буквально при выделении памяти под этот bitmap: Bitmap.SetSize(Jpeg.Width, Jpeg.Height). Хотя к ресурсам стараюсь относиться экономно и все промежуточные битмапы освобождаю, всё равно получаю ошибку. По данным диспетчера задач в этот момент моё приложение занимает всего 30 Мб оперы, занято системных ресурсов – до 675 Мб, хотя на машине 1Гб оперы и ещё столько же под файл подкачки.
Необходимо как-то снять ограничение на использование памяти, либо ошибка где-то в коде?
← →
Kolan © (2007-10-03 18:32) [1]> либо ошибка где-то в коде?
99%
← →
ggg (2007-10-03 18:38) [2]Интересует всё-таки момент с использованием оперативной памяти. Почему такие странные данные показывает диспетчер задач?
← →
Kolan © (2007-10-03 19:05) [3]> Почему такие странные данные показывает диспетчер задач?
Диспетчеру в этом плане доверять ненадо. Сверни и разверни свою программу — удивись…
← →
ggg (2007-10-03 19:13) [4]> Сверни и разверни свою программу
Не помогло, по данным деспетчера пик = 700Мб, хотя о недостатке памяти мне уже говорит и бдс =\
← →
ggg (2007-10-03 19:30) [5]Или вы имели в виду то, что при сворачивании уменьшается значение в колонке "Память"? Так для этого ещё существуют столбцы Вирт.п. и Пиковое использование. Последнее, кстати, показывает максимум - 29 Мб.
← →
tesseract © (2007-10-03 22:03) [6]Такое случаеться при перераспределении памяти, особенно глобальной.
Например GlobalRealloc выдавал такое через раз, меняю на полное GlobalFree/GlobalAlloc - всё норм. Вот такая вот загадка.
← →
ggg (2007-10-04 04:06) [7]Удалось локализовать проблему. Нехватку памяти однозначно вызывает работа с изображениями. Ниже будет модуль, иллюстрирующий это. На форме 3 компонента: кнопка, Label (для показа сколько изображений загружено) и OpenPictureDialog. В последнем следует установить флаг AllowMultiselect, чтобы несколько изображений за раз загружать. У меня нехватка памяти происходит при >85 загруженных (и отмасштабированных) изображениях и по данным диспетчера задач 11 Мб занимаемой памяти.
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, JPEG, ExtDlgs, StdCtrls;
type
TRGBArray = array[0..32767] of TRGBTriple;
pRGBArray = ^TRGBArray;
TForm2 = class(TForm)
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
Images: array of TGraphic;
Images2: array of TGraphic;
implementation
{$R *.dfm}
function GetCenterScaledRect(const AFullRect: TRect; const AWidth,
AHeight: Integer): TRect;
var
w, h: Integer;
begin
w := AFullRect.Right - AFullRect.Left;
h := AFullRect.Bottom - AFullRect.Top;
Result.Bottom := AHeight * w div AWidth;
if Result.Bottom > h then
begin
Result.Top := AFullRect.Top;
Result.Bottom := AFullRect.Bottom;
Result.Right := AWidth * h div AHeight;
Result.Left := AFullRect.Left + ((w - Result.Right) div 2);
Result.Right := AFullRect.Right - Result.Left;
end
else
begin
Result.Left := AFullRect.Left;
Result.Right := AFullRect.Right;
Result.Top := AFullRect.Top + ((h - Result.Bottom) div 2);
Result.Bottom := AFullRect.Bottom - Result.Top;
end;
end;
function LoadImageFileToJPEG(const fn: string): TJPEGImage;
var
p: TPicture;
bmp: TBitmap;
begin
Result := TJPEGImage.Create;
p := TPicture.Create;
try
p.LoadFromFile(fn);
if Assigned(p.Graphic) then
begin
bmp := TBitmap.Create;
try
bmp.SetSize(p.Width, p.Height);
bmp.Canvas.Draw(0, 0, p.Graphic);
p.Free();
p := nil;
Result.Assign(bmp);
finally
bmp.Free();
end;
end;
finally
p.Free;
end;
end;
procedure SmoothResize2(
const ABmp: TBitmap; var ToBmp: TBitmap;
const NewWidth, NewHeight: Integer
);
var
xScale, yScale : Single;
sFrom_y, sFrom_x : Single;
iFrom_y, iFrom_x : Integer;
to_y, to_x : Integer;
weight_x, weight_y : array[0..1] of Single;
weight : Single;
new_red, new_green : Integer;
new_blue : Integer;
total_red, total_green : Single;
total_blue : Single;
ix, iy : Integer;
sli, slo : pRGBArray;
//pointers for scanline access
liPByte,
loPByte,
p : PByte;
//offset increment
liSize,
loSize : integer;
begin
ABmp.PixelFormat := pf24bit;
if not Assigned(ToBmp) then
ToBmp := TBitmap.Create;
ToBmp.PixelFormat := pf24bit;
ToBmp.SetSize(NewWidth, NewHeight);
if (ABmp.Width = NewWidth) and (ABmp.Height = NewHeight) then
begin
ToBmp.Canvas.Draw(0, 0, ABmp);
Exit;
end;
xScale := ToBmp.Width / (ABmp.Width - 1);
yScale := ToBmp.Height / (ABmp.Height - 1);
liPByte := ABmp.Scanline[0];
liSize := Integer(ABmp.Scanline[1]) - Integer(liPByte);
loPByte := ToBmp.Scanline[0];
loSize := Integer(ToBmp.Scanline[1]) - Integer(loPByte);
for to_y := 0 to ToBmp.Height - 1 do
begin
sFrom_y := to_y / yScale;
iFrom_y := Trunc(sFrom_y);
weight_y[1] := sFrom_y - iFrom_y;
weight_y[0] := 1 - weight_y[1];
for to_x := 0 to ToBmp.Width - 1 do
begin
sFrom_x := to_x / xScale;
iFrom_x := Trunc(sfrom_x);
weight_x[1] := sFrom_x - iFrom_x;
weight_x[0] := 1 - weight_x[1];
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do
for iy := 0 to 1 do
begin
p := liPByte;
Inc(p, liSize *(ifrom_y + iy));
sli := pRGBArray(p);
new_red := sli[ifrom_x + ix].rgbtRed;
new_green := sli[ifrom_x + ix].rgbtGreen;
new_blue := sli[ifrom_x + ix].rgbtBlue;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
p := loPByte;
Inc(p, loSize *to_y);
slo := pRGBArray(p);
slo[to_x].rgbtRed := Round(total_red);
slo[to_x].rgbtGreen := Round(total_green);
slo[to_x].rgbtBlue := Round(total_blue);
end;
end;
end;
function CenterFineResize(const AGraphic: TGraphic;
const AWidth, AHeight: Integer; const ABgColor: TColor = clBlack): TBitmap;
var
temp, tempSized: TBitmap;
r: TRect;
begin
temp := TBitmap.Create;
try
temp.PixelFormat := pf24bit;
temp.SetSize(AGraphic.Width, AGraphic.Height);
temp.Canvas.Draw(0, 0, AGraphic);
//
r := GetCenterScaledRect(
Rect(0, 0, AWidth, AHeight), AGraphic.Width, AGraphic.Height
);
tempSized := TBitmap.Create;
try
SmoothResize2(temp, tempSized, r.Right - r.Left, r.Bottom - r.Top);
Result := TBitmap.Create;
Result.Canvas.Brush.Color := ABgColor;
Result.SetSize(AWidth, AHeight);
Result.Canvas.Draw(r.Left, r.Top, tempSized);
finally
tempSized.Free();
end;
finally
temp.Free();
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i: Integer;
n: Integer;
begin
if OpenPictureDialog1.Execute then
for i := 0 to OpenPictureDialog1.Files.Count - 1 do
begin
n := Length(Images);
SetLength(Images, n + 1);
Images[n] := LoadImageFileToJPEG(OpenPictureDialog1.Files[i]);
SetLength(Images2, n + 1);
Images2[n] := CenterFineResize(Images[n], 200, 100, clBlack);
end;
Label1.Caption := IntToStr(Length(Images2));
end;
end.
2 массива с изображениями - аналогично будет и в программе, исходное изображение будет использоваться, а отмасштабированное выводится на кнопку.
Если бы изображения хранились в bitmap:
1024 * 768 * 24 * 85 = 1 604 321 280 = 1,5 Гб
Но ведь в памяти все изображения хранятся в jpeg?
← →
ggg (2007-10-04 04:29) [8]При выводе изображения (bmp.Assign(jpg)) jpeg сам создаёт свою копию в битмап, которая не освобождается? Её как-то можно удалить вручную, вроде jpg.DIBFree?
← →
homm © (2007-10-04 07:20) [9]Видимо тобой здесь написана только одна процедура :)) Больше нигде вроде не течет.
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
n: Integer;
begin
if OpenPictureDialog1.Execute then
SetLength(Images2, OpenPictureDialog1.Files.Count);
for i := 0 to OpenPictureDialog1.Files.Count - 1 do
begin
Images := LoadImageFileToJPEG(OpenPictureDialog1.Files[i]);
Images2[i] := CenterFineResize(Images, 200, 100, clBlack);
Images.Free;
Image1.Canvas.Draw(0, 0, Images2[i]);
Label1.Caption := IntToStr(i);
Application.ProcessMessages;
end;
Label1.Caption := IntToStr(Length(Images2));
end;
← →
Плохиш © (2007-10-04 09:55) [10]
> Но ведь в памяти все изображения хранятся в jpeg?
Тебя обманули...
← →
ggg (2007-10-04 11:25) [11]> Видимо тобой здесь написана только одна процедура
Ну зря вы так.
Я же пояснил, что есть необходимость времено хранить в памяти все первоначальные изображения.
> [10]
Насколько я знаю, изначально оно находится в сжатой форме имнно jpeg, а вот когда вызывается bmp.Assign(jpeg) или тому подобное, происходит вызов DIBNeeded и уже создаётся битмап.
Пока вижу решение только jpeg.SaveToStream(MemoryStream) - и в памяти хранить в таком виде. Будут ещё предложения?
← →
homm © (2007-10-04 12:05) [12]> [11] ggg (04.10.07 11:25)
> Я же пояснил, что есть необходимость времено хранить в памяти
> все первоначальные изображения.
Это тупизм.
← →
ggg (2007-10-04 12:42) [13]> Это тупизм.
Хранить данные в памяти? Ну не знаю, до сих пор всех устраивало :)
← →
homm © (2007-10-04 12:49) [14]Да, хранить в памяти данные, которые не предназначенны для отображения прмо здесь и сейчас. Неужеле для пользосателя могут представлять хоть сколь-либо большой интерес все 400 оригинальных картинок, выведеных на экран? Когда пользователью потребуется вывисти одну из них, тогда ее и загрузишь.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2007.12.23;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.047 c
