Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как из Handle битовой картинки, получить адрес битового изображения в памяти

Автор: 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''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;

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

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.