Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.5 MB
Время: 0.045 c
2-1195904979
PASZLIB
2007-11-24 14:49
2007.12.23
Большие числа


15-1195943981
lookin
2007-11-25 01:39
2007.12.23
Криминальный талант (фильм) - где бы скачать...


1-1191514077
Андрей_Св
2007-10-04 20:07
2007.12.23
Выравнивание текста


2-1196247523
Petrovich
2007-11-28 13:58
2007.12.23
Как передать данные из TMemoryStream в динамический массив?


15-1195680552
Суслик
2007-11-22 00:29
2007.12.23
Виртуальная конференция от CodeGear!!!





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский