Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как из HBitmap получить адрес bitmap в памяти?

01.01.2007

Вот кусок одного моего класса, в котором есть две интересные вещицы -

проецирование файлов в память и работа с битмэпом в памяти через указатель.

Сразу оговорюсь, что все это работает только Delphi 2 и Win95/NT.

type 
   
TarrRGBTriple=array[byte] of TRGBTriple;
   
ParrRGBTriple=^TarrRGBTriple;
 
{организует битмэп размером SX,SY;true_color}
procedure
TMBitmap.Allocate(SX,SY:integer);
var DC:HDC;
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); {размер строки(кратна 4 байтам)}
 
   
if (biWidth or biHeight)<>0 then
     
begin
       DC
:=CreateDC('DISPLAY',nil,nil,nil);
{замечательная функция (см.HELP), возвращает HBITMAP, позволяет сразу
 
разместить выделяемый битмэп в спроецированном файле, что позволяет
 
ускорять работу и экономить память при генерировании большого битмэпа}
{!}      BM:=CreateDIBSection(DC,BI, DIB_RGB_COLORS, pointer(PB), nil, 0);
       
DeleteDC(DC);   PB получаем указатель на битмэп-----^^}
       
if BM=0 then Error('error creating DIB');
     
end;
 
end;
end;
 
{эта процедура загружает из файла true-color'ный битмэп}
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;
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('
cant create file mapping');
   try
{собственно проецируем объект в адресное }
       PF:=MapViewOfFile(HM,FILE_MAP_READ,0,0,0);
{получаем указатель на область памяти, в которую спроецирован файл}
       if PF=nil then Error('
cant 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;
 
{эта функция - реализация Pixels read}
function TMBitmap.GetPixel(X,Y:integer):PRGB;
begin
  if (X>=0) and (Xand
     (Y>=0) and (Ythen Result:=PRGB(PB+(Y)*FLineSize+X*3)
  else Result:=PRGB(PB);
end;