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

Вот кусок одного моего класса, в котором есть две интересные вещицы -
проецирование файлов в память и работа с битмэпом в памяти через указатель.
Сразу оговорюсь, что все это работает только 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('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; 
 
{эта функция - реализация 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; 



Содержание  Назад  Вперед

---

---