Форум: "Media";
Текущий архив: 2008.12.07;
Скачать: [xml.tar.bz2];
Вниз
Как изменить размер 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;
← →
Pavia © (2007-08-29 21:06) [19]orgbmp.Assign(bmp); - это не нужно
Просто работаем с bmp
← →
{RASkov} © (2007-08-29 21:18) [20]> [18] Pavia © (29.08.07 21:04)
вот нечто такое и делается в [5].... только автору что-то все не нравится :(
Все бы ему размер незаметно поменять, да без утечек и тормозов.... чёб всё гладко было как по маслу :)
Записать в TBitmapInfoHeader.biWidth новое значение и не парится....а память автоматом под этот размер выстроется...
> Dr. Andrew
Может объяснишь подробнее что нужно-то....:)
← →
Dr. Andrew (2007-08-29 21:46) [21]Записать в TBitmapInfoHeader.biWidth новое значение и не парится. - верно подмечено. А вот если без иронии что-то в этом плане придумать можно?
← →
{RASkov} © (2007-08-29 21:53) [22]> [21] Dr. Andrew (29.08.07 21:46)
> А вот если без иронии что-то в этом плане придумать можно?
Можно.... только уже придумали - TBitmap
:)
Впрочем если опишешь подробно что и для чего нужно, то может тебе и ответят...
Я конкретно по вопросу в [21] тебе помочь не смогу....
← →
Pavia © (2007-08-29 21:55) [23]
> А вот если без иронии что-то в этом плане придумать можно?
Ты хочешь построить кирпичный дом без кирпичей?
Я тебе написал. Делай свой модуль для чтения/записи бмп. И читай частично.
← →
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 всего. Спасибо!
← →
Pavia © (2007-08-29 23:38) [25]А чем тогда TBitmap не угодил?
Поток, просто считываешь в буфер. Дальше, разбираем заголовок. А битовое поле заносим через SetDIBits
← →
Dr. Andrew (2007-08-30 00:13) [26]А можно пример небольшой как скорректировать приведенный код? Спасибо.
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2008.12.07;
Скачать: [xml.tar.bz2];
Память: 0.54 MB
Время: 0.006 c