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

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

Сразу оговорюсь, что все это работает только под 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
 (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;

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

Другое по теме:

• Bitmap без формы
• Bitmap.Scanline для PixelFormat
• Вращать Bitmap вокруг точки