Как изменить размер bitmap в памяти?

← →
Dr. Andrew (2007-08-29 17:58) [0]

Добрый день, Мастера!
В процедуре 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)? Пожалуйста, если можно, небольшой практический пример как это можно реализовать. Всем спасибо!

← →
{RASkov} © (2007-08-29 18:25) [1]

> [0] Dr. Andrew (29.08.07 17:58)

А где этот битмап потом используется?
И смысл на OnResize делать так:
bitmap.Height := 2000;
bitmap.Width := 3000;
???

> можно просто изменить параметры ширины и высоты Bitmap в
> TBitmapInfo непосредстенно в памяти, чтобы не создавать
> новый bitmap с новыми шириной и высотой.

Ну так и меняй BMP.Width:=NewWidth.... без создания его заного..

А лучше задачу "нарисуй" поподробнее....

← →
{RASkov} © (2007-08-29 18:31) [2]

> потом стандартными методами загружаю в него туже картинку.

Стандартным - это каким? LoadFromFile?
Если Да - то все эти установки размеров и прочего к чертям собачьим....
Нет смысла настраивать Битмап перед загрузкой его из файла...

← →
Dr. Andrew (2007-08-29 18:34) [3]

procedure TForm1.onCtreate(Sender : TObject);
begin
bitmap := Tbitmap.Create;
bitmap.Pixelformat := pf24bit;
bitmap.Height := 200;
bitmap.Width := 300;
bitmap.LoadfromFile(D:/My Folder/Img_001.bmp);
Canvas.Draw(0,0, bitmap);
end;

Далее я разворачиваю окно на весь экран, а в процедуре 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;

← →
Dr. Andrew (2007-08-29 18:35) [4]

хорошо пусть я просто рисую на нем линии квадраты и так далее, а затем нужно увеличит размер это битмапа с наименьгей загрузкой памяти

← →
{RASkov} © (2007-08-29 18:43) [5]

Посмотри вот это:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
BmpOrig, BmpTmp: TBitmap;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
BmpOrig:=TBitMap.Create;
BmpOrig.LoadFromFile("D:\My Folder\Img_001.bmp");
end;

procedure TForm1.FormResize(Sender: TObject);
begin
try
if not Assigned(BmpTmp) then BmpTmp:=TBitMap.Create;
BmpTmp.Width:=Width div 2;
BmpTmp.Height:=Height div 2;
BmpTmp.Canvas.StretchDraw(BmpTmp.Canvas.ClipRect, BmpOrig);
Invalidate;
except
if Assigned(BmpTmp) then FreeAndNil(BmpTmp);
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(10, 10, BmpTmp);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(BmpTmp) then FreeAndNil(BmpTmp);
if Assigned(BmpOrig) then FreeAndNil(BmpOrig);
end;

end.
И опять...

> procedure TForm1.onCtreate(Sender : TObject);
> begin
> bitmap := Tbitmap.Create;

> bitmap.Pixelformat := pf24bit;
> bitmap.Height := 200;
> bitmap.Width := 300;
Это все рухнет после:
> bitmap.LoadfromFile(D:/My Folder/Img_001.bmp);
> Canvas.Draw(0,0, bitmap);
> end;

← →
Dr. Andrew (2007-08-29 18:48) [6]

да бог сним с этим bitmap.LoadfromFile. Выаводим просто люой рисунок, напрмиер методом Scanline. а далее необходимо растянуть битмар на весь экран, но оставить прорисовку с использованием метода Scanline, например, а не применяя процедуру StretchDraw. Вот вопрос в чем. Как изменить размеры битмапа без создания нового с размерами экрана, потому что в данном случае он съедает кучу памяти. Спасибо.

← →
{RASkov} © (2007-08-29 19:15) [7]

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

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

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

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

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

← →
{RASkov} © (2007-08-29 19:20) [8]

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

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

> bitmap.Free;

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

← →
{RASkov} © (2007-08-29 19:25) [9]

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

← →
Dr. Andrew (2007-08-29 20:00) [10]

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

← →
{RASkov} © (2007-08-29 20:17) [11]

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

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:30) [12]

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

← →
{RASkov} © (2007-08-29 20:39) [13]

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

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

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

← →
Pavia © (2007-08-29 20:47) [14]

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 со всеми вытекающиме тормазами.

← →
Dr. Andrew (2007-08-29 20:53) [15]

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

← →
{RASkov} © (2007-08-29 21:02) [16]

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

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

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

← →
Efir © (2007-08-29 21:02) [17]

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

← →
Pavia © (2007-08-29 21:04) [18]

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

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;

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

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

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

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

← →
Dr. Andrew (2007-08-29 21:46) [21]

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

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

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

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

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

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

← →
Dr. Andrew (2007-08-29 23:02) [24]

Вот есть код создания битмапа, правда недостаточно знаний дописать его:
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 всего. Спасибо!

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

← →
Dr. Andrew (2007-08-30 00:13) [26]

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

Как изменить размер bitmap в памяти? Найти похожие ветки