Конференция "Media" » Как изменить размер bitmap в памяти? [D7, WinXP]
 
  • Dr. Andrew (29.08.07 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} © (29.08.07 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} © (29.08.07 18:31) [2]
    > потом стандартными методами загружаю в него туже картинку.

    Стандартным - это каким? LoadFromFile?
    Если Да - то все эти установки размеров и прочего к чертям собачьим....
    Нет смысла настраивать Битмап перед загрузкой его из файла...
  • Dr. Andrew (29.08.07 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 (29.08.07 18:35) [4]
    хорошо пусть я просто рисую на нем линии квадраты и так далее, а затем нужно увеличит размер это битмапа с наименьгей загрузкой памяти
  • {RASkov} © (29.08.07 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 (29.08.07 18:48) [6]
    да бог сним с этим bitmap.LoadfromFile. Выаводим просто люой рисунок, напрмиер методом Scanline. а далее необходимо растянуть битмар на весь экран, но оставить прорисовку с использованием метода Scanline, например, а не применяя процедуру StretchDraw. Вот вопрос в чем. Как изменить размеры битмапа без создания нового с размерами экрана, потому что в данном случае он съедает кучу памяти. Спасибо.
  • {RASkov} © (29.08.07 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} © (29.08.07 19:20) [8]
    > А съедает у тебя потому, что ты его на каждый чих в OnResize'е
    > создаешь но не уничтожаешь...
    > Т.е. вот это
    >
    > > if bitmap <> nil then
    > >   bitmap.Free;
    >
    > у тебя не срабатывает, а создается новый bitmap, старый(т.е.
    > занятая память под него) не освобождается...

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

    > bitmap.Free;

    это сработает один раз и все, так как переменная bitmap не нилится.... а потом просто.... окончание [7]
  • {RASkov} © (29.08.07 19:25) [9]
    Сорри... чёт я конец [7] и [8] запутался уже сам... сейчас соображу... напишу :)
  • Dr. Andrew (29.08.07 20:00) [10]
    изменения к уничтожению стаого битмапа ничего не дают
  • {RASkov} © (29.08.07 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 (29.08.07 20:30) [12]
    RASkov. Спасибо, но речь не идет о LoadfromFile. да бог сней - забудьте ее. Мне необходимо изменит размер в боьшую сторону битмапа с экономией памяти. Вот в чем конректный вопрос, а не полкемика о процедуре загрузки файла.
  • {RASkov} © (29.08.07 20:39) [13]
    > [12] Dr. Andrew   (29.08.07 20:30)

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

    Посмотри метод SetWidth(Height) у TBitmap... ведь если ты захочешь менять размер через Ж...(TBitmapInfo) то и "вручки" нужно делать распределение памяти под новый размер картинки... т.е. придется делать нечто тоже самое что и
     bitmap.Height := 2000;
     bitmap.Width := 3000;
    В общем может объяснил криво... сорри... Ты хоть пробывал пример [5]? Есть в нем утечки?
  • Pavia © (29.08.07 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 (29.08.07 20:53) [15]
    RASkov - метод SetWidth(Height) у TBitmap - а что это такое? и откуда у битмапа такие методы?
    Pavia - речь не о загрузке или выгрузке, а об изменении размера любого битмапа с экономичным использованием памяти.
  • {RASkov} © (29.08.07 21:02) [16]

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

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

    Впринципе... да, тут и не нужен второй битмап.... это я чет запарился с размерами :)... достаточно одного [14], в который в начале загрузить оригинал картинки, а масштабировать(выводить) как угодно на канву..... и не нужно менять никаких размеров....
  • Efir © (29.08.07 21:02) [17]
    А нафига его каждый раз создавать, удалять. Один раз создал и меняй размеры.
  • Pavia © (29.08.07 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 © (29.08.07 21:06) [19]
    orgbmp.Assign(bmp); - это не нужно
    Просто работаем с bmp
  • {RASkov} © (29.08.07 21:18) [20]
    > [18] Pavia ©   (29.08.07 21:04)

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

    > Dr. Andrew
    Может объяснишь подробнее что нужно-то....:)
  • Dr. Andrew (29.08.07 21:46) [21]
    Записать в TBitmapInfoHeader.biWidth новое значение и не парится. - верно подмечено. А вот если без иронии что-то в этом плане придумать можно?
  • {RASkov} © (29.08.07 21:53) [22]
    > [21] Dr. Andrew   (29.08.07 21:46)
    > А вот если без иронии что-то в этом плане придумать можно?

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

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

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

    Я тебе написал. Делай свой модуль для чтения/записи бмп. И читай частично.
  • Dr. Andrew (29.08.07 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 © (29.08.07 23:38) [25]
    А чем тогда TBitmap не угодил?
    Поток, просто считываешь в буфер. Дальше, разбираем заголовок. А битовое поле заносим через SetDIBits
  • Dr. Andrew (30.08.07 00:13) [26]
    А можно пример небольшой как скорректировать приведенный код? Спасибо.
 
Конференция "Media" » Как изменить размер bitmap в памяти? [D7, WinXP]
Есть новые Нет новых   [134431   +10][b:0][p:0.004]