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

Как из Handle битовой картинки получить адрес битового изображения в памяти?

01.01.2007
Автор: Nomadic

Вот кусок одного моего класса, в котором есть две интересные вещицы - проецирование файлов в память и работа с битмэпом в памяти через указатель.

Сразу оговорюсь, что все это работает только под 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 not create file mapping');
    try
      {собственно проецируем объект в адресное }
      PF := MapViewOfFile(HM, FILE_MAP_READ, 0, 0, 0);
      {получаем указатель на область памяти, в которую спроецирован файл}
      if PF = nil then
        Error('
cannot 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 (X < BI.bmiHeader.biWidth) and
    (Y >= 0) and (Y < BI.bmiHeader.biHeight) then
    Result := PRGB(PB + (Y) * FLineSize + X * 3)
  else
    Result := PRGB(PB);
end;

Если у вас на форме есть компонент TImage, то можно сделать так:

var BMP:TMBitmap;
  B
: TBitmap;
...
 
BMP
.LoadFromFile(..);
B
:=TBitmap.Create;
B
.Handle:=BMP.Handle;
Image1
.Picture.Bitmap:=B;

и загруженный битмэп появится на экране.

https://delphiworld.narod.ru/

DelphiWorld 6.0