-
Добрый день, Мастера! В процедуре 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)? Пожалуйста, если можно, небольшой практический пример как это можно реализовать. Всем спасибо!
-
> [0] Dr. Andrew (29.08.07 17:58)
А где этот битмап потом используется? И смысл на OnResize делать так: bitmap.Height := 2000; bitmap.Width := 3000; ???
> можно просто изменить параметры ширины и высоты Bitmap в > TBitmapInfo непосредстенно в памяти, чтобы не создавать > новый bitmap с новыми шириной и высотой.
Ну так и меняй BMP.Width:=NewWidth.... без создания его заного..
А лучше задачу "нарисуй" поподробнее....
-
> потом стандартными методами загружаю в него туже картинку.
Стандартным - это каким? LoadFromFile? Если Да - то все эти установки размеров и прочего к чертям собачьим.... Нет смысла настраивать Битмап перед загрузкой его из файла...
-
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;
-
хорошо пусть я просто рисую на нем линии квадраты и так далее, а затем нужно увеличит размер это битмапа с наименьгей загрузкой памяти
-
Посмотри вот это: 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;
-
да бог сним с этим bitmap.LoadfromFile. Выаводим просто люой рисунок, напрмиер методом Scanline. а далее необходимо растянуть битмар на весь экран, но оставить прорисовку с использованием метода Scanline, например, а не применяя процедуру StretchDraw. Вот вопрос в чем. Как изменить размеры битмапа без создания нового с размерами экрана, потому что в данном случае он съедает кучу памяти. Спасибо.
-
> [6] Dr. Andrew (29.08.07 18:48) > Вот вопрос в чем. Как изменить размеры битмапа без создания > нового с размерами экрана,
Ну незнаю.... я же тебе пример кинул изменение размеров без создания его заного.... Вот вместо BmpTmp.Canvas.StretchDraw(BmpTmp.Canvas.ClipRect, BmpOrig); напиши свой метод на основе Scanline и все тут... А съедает у тебя потому, что ты его на каждый чих в OnResize'е создаешь но не уничтожаешь... Т.е. вот это > if bitmap <> nil then > bitmap.Free;
у тебя не срабатывает, а создается новый bitmap, старый(т.е. занятая память под него) не освобождается...
-
> А съедает у тебя потому, что ты его на каждый чих в OnResize'е > создаешь но не уничтожаешь... > Т.е. вот это > > > if bitmap <> nil then > > bitmap.Free; > > у тебя не срабатывает, а создается новый bitmap, старый(т.е. > занятая память под него) не освобождается...
Т.е. немного не так, но суть в том что
> bitmap.Free;
это сработает один раз и все, так как переменная bitmap не нилится.... а потом просто.... окончание [7]
-
Сорри... чёт я конец [7] и [8] запутался уже сам... сейчас соображу... напишу :)
-
изменения к уничтожению стаого битмапа ничего не дают
-
Впрочем... Вот это:
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)
?
-
RASkov. Спасибо, но речь не идет о LoadfromFile. да бог сней - забудьте ее. Мне необходимо изменит размер в боьшую сторону битмапа с экономией памяти. Вот в чем конректный вопрос, а не полкемика о процедуре загрузки файла.
-
> [12] Dr. Andrew (29.08.07 20:30)
Да я и не про LoadfromFile :) Он там так.... к примеру в тему....
Посмотри метод SetWidth(Height) у TBitmap... ведь если ты захочешь менять размер через Ж...(TBitmapInfo) то и "вручки" нужно делать распределение памяти под новый размер картинки... т.е. придется делать нечто тоже самое что и bitmap.Height := 2000; bitmap.Width := 3000; В общем может объяснил криво... сорри... Ты хоть пробывал пример [5]? Есть в нем утечки?
-
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 - метод SetWidth(Height) у TBitmap - а что это такое? и откуда у битмапа такие методы? Pavia - речь не о загрузке или выгрузке, а об изменении размера любого битмапа с экономичным использованием памяти.
-
> [15] Dr. Andrew (29.08.07 20:53) > метод SetWidth(Height) у TBitmap - а что это такое?
Это когда свойству Width(Heigth) присваеваешь новое значение, то выполняются его защищенные(protected) методы...
Впринципе... да, тут и не нужен второй битмап.... это я чет запарился с размерами :)... достаточно одного [14], в который в начале загрузить оригинал картинки, а масштабировать(выводить) как угодно на канву..... и не нужно менять никаких размеров....
-
А нафига его каждый раз создавать, удалять. Один раз создал и меняй размеры.
-
Так загружаем картинку в память, создаем новый битмоп копируем с увеличением. Освобождаем старый. Не устраивает такой метод. Пишем свой обработчик который будет читать по частям битмэп и записывать в другой файл. 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 Может объяснишь подробнее что нужно-то....:)
-
Записать в TBitmapInfoHeader.biWidth новое значение и не парится. - верно подмечено. А вот если без иронии что-то в этом плане придумать можно?
-
> [21] Dr. Andrew (29.08.07 21:46) > А вот если без иронии что-то в этом плане придумать можно?
Можно.... только уже придумали - TBitmap :) Впрочем если опишешь подробно что и для чего нужно, то может тебе и ответят... Я конкретно по вопросу в [21] тебе помочь не смогу....
-
> А вот если без иронии что-то в этом плане придумать можно?
Ты хочешь построить кирпичный дом без кирпичей?
Я тебе написал. Делай свой модуль для чтения/записи бмп. И читай частично.
-
Вот есть код создания битмапа, правда недостаточно знаний дописать его:
TMBitmap = class
private
FLineSize: Integer;
BM : THandle;
procedure Allocate(SX,SY:integer);
public
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;
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 end;
end;
end;
procedure TMBitmap.LoadFromFile(const FileName : string);
var HF:integer;
HM:THandle;
PF:pchar;
i,j:integer;
Ofs:integer;
BI: tagBITMAPINFO;
begin
HF:=FileOpen(FileName,fmOpenRead or fmShareDenyWrite);
if HF<0 then try
HM:=CreateFileMapping(HF,nil,PAGE_READONLY,0,0,nil);
if HM=0 then try
PF:=MapViewOfFile(HM,FILE_MAP_READ,0,0,0);
if PF=nil then try
if PBitmapFileHeader(PF)^.bfType<>$4D42 then Ofs:=PBitmapFileHeader(PF)^.bfOffBits;
with PBitmapInfo(PF+sizeof(TBitmapFileHeader))^.bmiHeader do
begin
if (biSize<>40) or (biPlanes<>1) then if (biCompression<>BI_RGB)or(biBitCount<>24) then
Allocate(biWidth,biHeight);
end;
for j:=0 to BI.bmiHeader.biHeight-1 do
for i:=0 to BI.bmiHeader.biWidth-1 do
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
-
А можно пример небольшой как скорректировать приведенный код? Спасибо.
|