Работа с изображением в памяти

Материал из DRKB


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

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('Cannot 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;
begin
  BMP.LoadFromFile(FileName);
  B := TBitmap.Create;
  B.Handle := BMP.Handle;
  Image1.Picture.Bitmap := B;


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


Author: Alexander Burnashov, E-mail alex@arta.spb.su (2:5030/254.36)
ID: 03722
ID: 03769
ID: 03782