Форум: "Основная";
Текущий архив: 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]

> Почему такие странные данные показывает диспетчер задач?

Диспетчеру в этом плане доверять ненадо. Сверни и разверни свою программу — удивись&#133

---

← →
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.51 MB
Время: 0.055 c