Як змінити розмір bitmap в пам'яті?
А краще задачу "намалюй" детальніше.
> Потім стандартними методами завантажую в нього тугіше картинку.
Стандартним - це яким? 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 (застосування процедури скорочує виключено!). Мені потрібен бітмар з великими розмірами (розмірами екрану):
добре нехай я просто малюю на ньому лінії квадрати і так далі, а потім потрібно збільшить розмір це бітмапами з наіменьгей завантаженням пам'яті
Подивися ось це:
unit Unit1;
interface
uses
# XA0; Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
# XA0; Dialogs;
type
# XA0; TForm1 = class (TForm)
# XA0; # XA0; procedure FormCreate (Sender: TObject);
# XA0; # XA0; procedure FormResize (Sender: TObject);
# XA0; # XA0; procedure FormPaint (Sender: TObject);
# XA0; # XA0; procedure FormClose (Sender: TObject; var Action: TCloseAction);
# XA0; private
# XA0; # XA0;
# XA0; public
# XA0; # XA0; BmpOrig, BmpTmp: TBitmap;
# XA0; # XA0;
# XA0; end;
var
# XA0; Form1: TForm1;
procedure TForm1.FormCreate (Sender: TObject);
begin
# XA0; BmpOrig: = TBitMap.Create;
# XA0; BmpOrig.LoadFromFile ( "D: \ My Folder \ Img_001.bmp");
end;
procedure TForm1.FormResize (Sender: TObject);
begin
# XA0; try
# XA0; if not Assigned (BmpTmp) then BmpTmp: = TBitMap.Create;
# XA0; BmpTmp.Width: = Width div 2;
# XA0; BmpTmp.Height: = Height div 2;
# XA0; BmpTmp.Canvas.StretchDraw (BmpTmp.Canvas.ClipRect, BmpOrig);
# XA0; Invalidate;
# XA0; except
# XA0; if Assigned (BmpTmp) then FreeAndNil (BmpTmp);
# XA0; end;
end;
procedure TForm1.FormPaint (Sender: TObject);
begin
# XA0; Canvas.Draw (10, 10, BmpTmp);
end;
procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction);
begin
# XA0; if Assigned (BmpTmp) then FreeAndNil (BmpTmp);
# XA0; 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 # XA0; (29.08.07 18:48)
> Ось питання в чому. Як змінити розміри бітмапами без створення
> Нового з розмірами екрану,
Ну не знаю. я ж тобі приклад кинув зміна розмірів без створення його по-новому.
Ось замість BmpTmp.Canvas.StretchDraw (BmpTmp.Canvas.ClipRect, BmpOrig);
напиши свій метод на основі Scanline і все тут.
А з'їдає у тебе тому, що ти його на кожен чих в OnResize "е створюєш але не губиш.
Тобто ось це
> If bitmap <> nil then
> # XA0; bitmap.Free;
у тебе не спрацьовує, а створюється новий bitmap, старий (тобто. зайнята пам'ять під нього) не звільняється.
> А з'їдає у тебе тому, що ти його на кожен чих в OnResize "е
> Створюєш але не губиш.
> Тобто ось це
>
>> if bitmap <> nil then
>> # XA0; bitmap.Free;
>
> У тебе не спрацьовує, а створюється новий bitmap, старий (тобто.
> Зайнята пам'ять під нього) не звільняється.
Тобто трохи не так, але суть в тому що
> Bitmap.Free;
це спрацює один раз і все, так як змінна bitmap НЕ нілітся. а потім просто. закінчення [7]
Соррі. чет я кінець [7] і [8] заплутався вже сам. Зараз второпаю. напишу :)
зміни до знищення стаого бітмапами нічого не дають
Втім. Ось це:
var bitmap. Tbitmap; // глобальна змінна.
procedure TForm1.onCtreate (Sender. TObject);
begin
# XA0; bitmap: = Tbitmap.Create;
# XA0; bitmap.LoadfromFile (D: / My Folder / Img_001.bmp);
end;
procedure TForm1.onResize (Sender. TObject);
begin
# XA0; if bitmap <> nil then bitmap.Free;
# XA0; bitmap: = Tbitmap.Create;
# XA0; bitmap.LoadfromFile (D: / My Folder / Img_001.bmp);
end;
Ніяких витоків не повинно бути, гальма - так. Дивись в іншому місці витоку.
Але даний код "неправильний". Див мій приклад в [5] там немає багаторазового створення / видалення.
> [10] Dr. Andrew # XA0; (29.08.07 20:00)
?
RASkov. Спасибі, але мова не йде про LoadfromFile. та бог сней - забудьте її. Мені необхідно змінить розмір в прийнятніший сторону бітмапами з економією пам'яті. Ось у чому конректний питання, а не полкеміка про процедуру завантаження файлу.
> [12] Dr. Andrew # XA0; (29.08.07 20:30)
Так я і не про LoadfromFile :) Він там так. наприклад в тему.
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 # XA0; (29.08.07 20:53)
> Метод SetWidth (Height) у TBitmap - а що це таке?
Це коли властивості Width (Heigth) присвоюється нове значення, то виконуються його захищені (protected) методи.
В принципі. да, тут і не потрібен другий бітмапами. це я чет запарился з розмірами :). досить одного [14], в який на початку завантажити оригінал картинки, а масштабувати (виводити) як завгодно на канву. і не потрібно міняти ніяких розмірів.
А нафіга його кожен раз створювати, видаляти. Один раз створив і міняй розміри.
var
bmp, tmp: TBitmap;
NewWidth, NewHeight: Integer;
begin
NewWidth: = 1000;
NewHeight: = 1000;
orgbmp.Assign (bmp); - це не потрібно
Просто працюємо з bmp
> Dr. Andrew
Може поясниш докладніше що потрібно щось. )
Записати в TBitmapInfoHeader.biWidth нове значення і не париться. - вірно підмічено. А ось якщо без іронії щось в цьому плані придумати можна?
> [21] Dr. Andrew # XA0; (29.08.07 21:46)
> А ось якщо без іронії щось в цьому плані придумати можна?
Можна, можливо. тільки вже придумали - TBitmap
:)
Втім якщо опишеш докладно що і для чого потрібно, то може тобі і дадуть відповідь.
Я конкретно по питанню в [21] тобі допомогти не зможу.
> А ось якщо без іронії щось в цьому плані придумати можна?
Ти хочеш побудувати цегельний будинок без цегли?
Я тобі написав. Роби свій модуль для читання / запису бмп. І читай частково.
Ось є код створення бітмапами, правда недостатньо знань дописати його:
TMBitmap = class
# XA0; private
# XA0; # XA0;
# XA0; # XA0; # XA0; FLineSize: Integer;
# XA0; # XA0; # XA0; BM. THandle;
# XA0; # XA0; # XA0; procedure Allocate (SX, SY: integer);
# XA0; public
# XA0; # XA0;
# XA0; # XA0; property Handle. THandle read BM;
# XA0; # XA0; constructor Create (Width, Height. Integer);
# XA0; # XA0; destructor Destroy; override;
# XA0; # XA0; procedure LoadFromFile (const FileName: string);
# XA0; end;
type
# XA0; TarrRGBTriple = array [byte] of TRGBTriple;
# XA0; ParrRGBTriple = ^ TarrRGBTriple;
constructor TMBitmap.Create (Width, Height. Integer);
begin
# XA0; inherited Create;
# XA0; Allocate (Width, Height);
end;
destructor TMBitmap.Destroy;
begin
# XA0; inherited;
end;
procedure TMBitmap.Allocate (SX, SY: integer);
var DC: HDC;
# XA0; # XA0; PB: Pointer;
# XA0; # XA0; BI: tagBITMAPINFO;
begin
# XA0; if BM<>0 then DeleteObject (BM);
# XA0; BM: = 0; # XA0; PB: = nil;
# XA0; fillchar (BI, sizeof (BI), 0);
# XA0; with BI.bmiHeader do
# XA0; begin
# XA0; # XA0; biSize: = sizeof (BI.bmiHeader);
# XA0; # XA0; biWidth: = SX;
# XA0; # XA0; biHeight: = SY;
# XA0; # XA0; biPlanes: = 1;
# XA0; # XA0; biBitCount: = 24;
# XA0; # XA0; biCompression: = BI_RGB;
# XA0; # XA0; biSizeImage: = 0;
# XA0; # XA0; biXPelsPerMeter: = 0;
# XA0; # XA0; biYPelsPerMeter: = 0;
# XA0; # XA0; biClrUsed: = 0;
# XA0; # XA0; biClrImportant: = 0;
# XA0; # XA0; FLineSize: = (biWidth + 1) * 3 and (-1 shl 2);
# XA0; # XA0; if (biWidth or biHeight)<>0 then
# XA0; # XA0; begin
# XA0; # XA0; # XA0; DC: = CreateDC ( "DISPLAY", nil, nil, nil);
# XA0; # XA0; # XA0; BM: = CreateDIBSection (DC, BI, DIB_RGB_COLORS, pointer (PB), 0, 0);
# XA0; # XA0; # XA0; DeleteDC (DC);
# XA0; # XA0; # XA0; if BM = 0 then // Error ( "error creating DIB");
# XA0; # XA0; end;
# XA0; end;
end;
# XA0; # XA0; # XA0; # XA0; for j: = 0 to BI.bmiHeader.biHeight-1 do
# XA0; # XA0; # XA0; # XA0; # XA0; for i: = 0 to BI.bmiHeader.biWidth-1 do
# XA0; # XA0; # XA0; # XA0; # XA0;
# XA0; # XA0; # XA0; # XA0; # XA0; //Pixels[i,j]^.Tr:=ParrRGBTriple(PF+j*FLineSize+Ofs)^[i];
# XA0; # XA0; # XA0; finally
# XA0; # XA0; # XA0; # XA0; UnmapViewOfFile (PF);
# XA0; # XA0; # XA0; end;
# XA0; # XA0; finally
# XA0; # XA0; # XA0; CloseHandle (HM);
# XA0; # XA0; end;
# XA0; finally
# XA0; # XA0; FileClose (HF);
# XA0; end;
end;
створити бітмапами можна (чорного кольору поле):
procedure TForm1.FormCreate (Sender: TObject);
begin
# XA0; BMP: = TMBitmap.Create (40, 20);
end;
але намалювати на ньому або завантажити в нього (особливо потрібно через потік) нічого не можна. Як можна цей код змінити щоб працювати з ним як зі звичайним бітмапами. Тільки завантаження процедурою LoadFromfile цікавить меньit всього. Дякуємо!
А чим тоді TBitmap не догодив?
Потік, просто зчитує в буфер. Далі, розбираємо заголовок. А бітове поле заносимо через SetDIBits
А можна приклад невеликої як скорегувати наведений код? Дякуємо.