| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как изменить размер bitmap в памяти? [D7, WinXP]

Страницы:   < 1 2 >

Dr. Andrew ©   (2007-08-29 17:58:00) 

Добрый день, Мастера!
В процедуре onCtreate создал Bitmap:

procedure TForm1.onCtreate(Sender : TObject);
begin
 bitmap := Tbitmap.Create;
 bitmap.Pixelformat := pf24bit;
 bitmap.Height := 200;
 bitmap.Width := 300;
 потом стандартными методами загружаю в него картинку.
end;

A процедуре onResize мне необходимо изменить размеры Bitmap:

procedure TForm1.onResize(Sender : TObject);
begin
  if bitmap <> nil then
    bitmap.Free;
  bitmap := Tbitmap.Create;
  bitmap.Pixelformat := pf24bit;
  bitmap.Height := 2000;
  bitmap.Width := 3000;
  потом стандартными методами загружаю в него туже картинку.
end;

При этом данный процесс "съедает" уйму памяти.  можно просто изменить параметры ширины и высоты Bitmap в TBitmapInfo непосредстенно в памяти, чтобы не создавать новый bitmap с новыми шириной и высотой. Как связать bitmap и память (TBitmapInfo)? Пожалуйста, если можно, небольшой практический пример как это можно реализовать. Всем спасибо!

---

Dr. Andrew   (2007-08-30 00:13:00) [1]

А можно пример небольшой как скорректировать приведенный код? Спасибо.

---

Pavia   (2007-08-29 23:38:00) [2]

А чем тогда TBitmap не угодил?
Поток, просто считываешь в буфер. Дальше, разбираем заголовок. А битовое поле заносим через SetDIBits

---

Dr. Andrew   (2007-08-29 23:02:00) [3]

Вот есть код создания битмапа, правда недостаточно знаний дописать его:

TMBitmap = class
 private
   { Private declarations }
     FLineSize: Integer;
     BM : THandle;
     procedure Allocate(SX,SY:integer);
 public
   { Public declarations }
   property Handle : THandle read BM;

   constructor Create(Width, Height : Integer);
   destructor Destroy; override;

   procedure LoadFromFile(const FileName:string);
 end;

type
  TarrRGBTriple=array[byte] of TRGBTriple;
  ParrRGBTriple=^TarrRGBTriple;

constructor TMBitmap.Create(Width, Height : Integer);
begin
 inherited Create;
 Allocate(Width, Height);
end;

destructor TMBitmap.Destroy;
begin
 inherited;
end;

{организует битмэп размером SX,SY;true_color}
procedure TMBitmap.Allocate(SX,SY:integer);
var DC:HDC;
   PB: Pointer;
   BI: tagBITMAPINFO;
begin
 if BM<>0 then DeleteObject(BM);
 BM:=0;  PB:=nil;
 fillchar(BI,sizeof(BI),0);
 with BI.bmiHeader do
 begin
   biSize:=sizeof(BI.bmiHeader);
   biWidth:=SX;
   biHeight:=SY;
   biPlanes:=1;
   biBitCount:=24;
   biCompression:=BI_RGB;
   biSizeImage:=0;
   biXPelsPerMeter:=0;
   biYPelsPerMeter:=0;
   biClrUsed:=0;
   biClrImportant:=0;

   FLineSize:=(biWidth+1)*3 and (-1 shl 2);

   if (biWidth or biHeight)<>0 then
    begin
      DC:=CreateDC('DISPLAY',nil,nil,nil);
      BM:=CreateDIBSection(DC,BI, DIB_RGB_COLORS, pointer(PB), 0, 0);
      DeleteDC(DC);
      if BM=0 then //Error('error creating DIB');
    end;
 end;
end;

procedure TMBitmap.LoadFromFile(const FileName : string);
var HF:integer; {file handle}
   HM:THandle; {file-mapping handle}
   PF:pchar;   {pointer to file view in memory}
   i,j:integer;
   Ofs:integer;
   BI: tagBITMAPINFO;
begin
{открываем файл}
 HF:=FileOpen(FileName,fmOpenRead or fmShareDenyWrite);
 if HF<0 then //Error('open file '''+FileName+'''');
 try
  { создаем объект-проецируемый файл }
   HM:=CreateFileMapping(HF,nil,PAGE_READONLY,0,0,nil);
   if HM=0 then //Error('can''t create file mapping');
   try
    {собственно проецируем объект в адресное }
     PF:=MapViewOfFile(HM,FILE_MAP_READ,0,0,0);
    {получаем указатель на область памяти, в которую спроецирован файл}
     if PF=nil then //Error('can''t create map view of file');
     try
      { работаем с файлом как с областью памяти через указатель PF}
       if PBitmapFileHeader(PF)^.bfType<>$4D42 then  //Error('file format');
         Ofs:=PBitmapFileHeader(PF)^.bfOffBits;
       with PBitmapInfo(PF+sizeof(TBitmapFileHeader))^.bmiHeader do
       begin
         if (biSize<>40) or (biPlanes<>1) then //Error('file format');
         if (biCompression<>BI_RGB)or(biBitCount<>24) then //Error('only true-color BMP supported');
          { выделяем память под битмэп }
           Allocate(biWidth,biHeight);
       end;

       for j:=0 to BI.bmiHeader.biHeight-1 do
         for i:=0 to BI.bmiHeader.biWidth-1 do
          { Pixels - это property, возвр. указатель на соотв. RGBTriple в битмэпе}
          //Pixels[i,j]^.Tr:=ParrRGBTriple(PF+j*FLineSize+Ofs)^[i];
     finally
       UnmapViewOfFile(PF);
     end;
   finally
     CloseHandle(HM);
   end;
 finally
   FileClose(HF);
 end;
end;

создать битмап можно (черного цвета поле):

procedure TForm1.FormCreate(Sender: TObject);
begin
 BMP := TMBitmap.Create(40, 20);
end;

но нарисовать на нем или загрузить в него (особенно нужно через поток) ничего нельзя. Как можно этот код изменить чтобы работать с ним как с обычным битмапом. Только загрузка процедурой LoadFromfile интересует меньit всего. Спасибо!

---

Pavia   (2007-08-29 21:55:00) [4]

> А вот если без иронии что-то в этом плане придумать можно?

Ты хочешь построить кирпичный дом без кирпичей?

Я тебе написал. Делай свой модуль для чтения/записи бмп. И читай частично.

---

{RASkov}   (2007-08-29 21:53:00) [5]

> [21] Dr. Andrew   (29.08.07 21:46)
> А вот если без иронии что-то в этом плане придумать можно?

Можно.... только уже придумали - TBitmap
:)
Впрочем если опишешь подробно что и для чего нужно, то может тебе и ответят...
Я конкретно по вопросу в [21] тебе помочь не смогу....

---

Dr. Andrew   (2007-08-29 21:46:00) [6]

Записать в TBitmapInfoHeader.biWidth новое значение и не парится.- верно подмечено. А вот если без иронии что-то в этом плане придумать можно?

---

{RASkov}   (2007-08-29 21:18:00) [7]

> [18] Pavia ©   (29.08.07 21:04)

вот нечто такое и делается в [5].... только автору что-то все не нравится :(
Все бы ему размер незаметно поменять, да без утечек и тормозов.... чёб всё гладко было как по маслу :)
Записать в TBitmapInfoHeader.biWidth новое значение и не парится....а память автоматом под этот размер выстроется...

> Dr. Andrew
Может объяснишь подробнее что нужно-то....:)

---

Pavia   (2007-08-29 21:06:00) [8]

orgbmp.Assign(bmp); - это не нужно
Просто работаем с bmp

---

Pavia   (2007-08-29 21:04:00) [9]

Так загружаем картинку в память, создаем новый битмоп копируем с увеличением. Освобождаем старый.
Не устраивает такой метод. Пишем свой обработчик который будет читать по частям битмэп и записывать в другой файл.

var
bmp,tmp:TBitmap;
NewWidth,NewHeight:Integer;
begin
NewWidth:=1000;
NewHeight:=1000;

Bmp:=TBitmap.Create;
Bmp.LoadFromFile('c:\pp.bmp');
TMP:=TBitmap.Create;
TMP.Width:=NewWidth;
TMP.Height:=NewHeight;
TMP.Canvas.StretchDraw(Rect(0,0,NewWidth,NewHeight),BMP);
bmp.Free;
bmp:=TMP;
TMP:=nil;
orgbmp.Assign(bmp);
end;

---

Efir   (2007-08-29 21:02:00) [10]

А нафига его каждый раз создавать, удалять. Один раз создал и меняй размеры.

---

{RASkov}   (2007-08-29 21:02:00) [11]

> [15] Dr. Andrew   (29.08.07 20:53)
> метод SetWidth(Height) у TBitmap - а что это такое?

Это когда свойству Width(Heigth) присваеваешь новое значение, то выполняются его защищенные(protected) методы...

Впринципе... да, тут и не нужен второй битмап.... это я чет запарился с размерами :)... достаточно одного [14], в который в начале загрузить оригинал картинки, а масштабировать(выводить) как угодно на канву..... и не нужно менять никаких размеров....

---

Dr. Andrew   (2007-08-29 20:53:00) [12]

RASkov - метод SetWidth(Height) у TBitmap - а что это такое? и откуда у битмапа такие методы?
Pavia - речь не о загрузке или выгрузке, а об изменении размера любого битмапа с экономичным использованием памяти.

---

Pavia   (2007-08-29 20:47:00) [13]

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.StretchDraw(ClientRect,OrgBMP);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=True;
OrgBMP:=TBitmap.Create;
OrgBMP.LoadFromFile('c:\pp.bmp');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
OrgBMP.Free
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Repaint;
end;

Не нравиться StretchDraw, создовай битмэп делой свой метод для увиличения. Память разумеется займется битмэпом.
Можно через SetPixel, canvas.Pixels со всеми вытекающиме тормазами.

---

{RASkov}   (2007-08-29 20:39:00) [14]

> [12] Dr. Andrew   (29.08.07 20:30)

Да я и не про LoadfromFile :) Он там так.... к примеру в тему....

Посмотри метод SetWidth(Height) у TBitmap... ведь если ты захочешь менять размер через Ж...(TBitmapInfo) то и "вручки" нужно делать распределение памяти под новый размер картинки... т.е. придется делать нечто тоже самое что и
 bitmap.Height := 2000;
 bitmap.Width := 3000;
В общем может объяснил криво... сорри... Ты хоть пробывал пример [5]? Есть в нем утечки?

---

Dr. Andrew   (2007-08-29 20:30:00) [15]

RASkov. Спасибо, но речь не идет о LoadfromFile. да бог сней - забудьте ее. Мне необходимо изменит размер в боьшую сторону битмапа с экономией памяти. Вот в чем конректный вопрос, а не полкемика о процедуре загрузки файла.

---

{RASkov}   (2007-08-29 20:17:00) [16]

Впрочем... Вот это:

var bitmap : Tbitmap; //глобальная переменная....

procedure TForm1.onCtreate(Sender : TObject);
begin
 bitmap := Tbitmap.Create;
 bitmap.LoadfromFile(D:/My Folder/Img_001.bmp);
end;

procedure TForm1.onResize(Sender : TObject);
begin
 if bitmap <> nil then bitmap.Free;
 bitmap := Tbitmap.Create;
 bitmap.LoadfromFile(D:/My Folder/Img_001.bmp);
end;

Никаких утечек не должно быть, тормоза - да. Смотри в другом месте утечки...
Но данный код "не правильный"... См мой пример в [5] там нет многократного создания/удаления...

> [10] Dr. Andrew   (29.08.07 20:00)

?

---

Dr. Andrew   (2007-08-29 20:00:00) [17]

изменения к уничтожению стаого битмапа ничего не дают

---

{RASkov}   (2007-08-29 19:25:00) [18]

Сорри... чёт я конец [7] и [8] запутался уже сам... сейчас соображу... напишу :)

---

{RASkov}   (2007-08-29 19:20:00) [19]

> А съедает у тебя потому, что ты его на каждый чих в OnResize'е
> создаешь но не уничтожаешь...
> Т.е. вот это
>
> > if bitmap <> nil then
> >   bitmap.Free;
>
> у тебя не срабатывает, а создается новый bitmap, старый(т.е.
> занятая память под него) не освобождается...

Т.е. немного не так, но суть в том что

> bitmap.Free;

это сработает один раз и все, так как переменная bitmap не нилится.... а потом просто.... окончание [7]

---

{RASkov}   (2007-08-29 19:15:00) [20]

> [6] Dr. Andrew   (29.08.07 18:48)
> Вот вопрос в чем. Как изменить размеры битмапа без создания
> нового с размерами экрана,

Ну незнаю.... я же тебе пример кинул изменение размеров без создания его заного....
Вот вместо BmpTmp.Canvas.StretchDraw(BmpTmp.Canvas.ClipRect, BmpOrig);
напиши свой метод на основе Scanline и все тут...

А съедает у тебя потому, что ты его на каждый чих в OnResize'е создаешь но не уничтожаешь...
Т.е. вот это

> if bitmap <> nil then
>   bitmap.Free;

у тебя не срабатывает, а создается новый bitmap, старый(т.е. занятая память под него) не освобождается...

---

Страницы:   < 1 2 >

Наверх