Как создать Bitmap из массива пикселей

Материал из DRKB


Один из способов создания битмапа из массива пикселей заключается в использовании Windows API функции CreateDiBitmap(). Это позволит использовать один из многих форматов битмапа, которые Windows использует для хранения пикселей. Следующий пример создаёт 256-цветный битмап из массива пикселей. Битмап состоит из 256 оттенков серого цвета плавно переходящих от белого к чёрному. Обратите внимание, что Windows резервирует первые и последние 10 цветов для системных нужд, поэтому Вы можете получить максимум 236 оттенков серого.


{$IFNDEF WIN32}
type
{ Used for pointer math under Win16 }
  PPtrRec = ^TPtrRec;
  TPtrRec = record
    Lo : Word;
    Hi : Word;
  end;
{$ENDIF}

{ Used for huge pointer math }
function GetBigPointer(lp: Pointer; Offset: Longint): Pointer;
begin
{$IFDEF WIN32}
  GetBigPointer := @PByteArray(lp)^[Offset];
{$ELSE}
  Offset := Offset + TPtrRec(lp).Lo;
  GetBigPointer := Ptr(TPtrRec(lp).Hi + TPtrRec(Offset).Hi *
                       SelectorInc,
                       TPtrRec(Offset).Lo);
{$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hPixelBuffer: THandle; { Handle to the pixel buffer }
  lpPixelBuffer: pointer; { pointer to the pixel buffer }
  lpPalBuffer: PLogPalette; { The palette buffer }
  lpBitmapInfo: PBitmapInfo; { The bitmap info header }
  BitmapInfoSize: Longint; { Size of the bitmap info header }
  BitmapSize: Longint; { Size of the pixel array }
  PaletteSize: Integer; { Size of the palette buffer }
  i: Longint; { loop variable }
  j: Longint; { loop variable }
  OldPal: hPalette; { temp palette }
  hPal: hPalette; { handle to our palette }
  hBm: hBitmap; { handle to our bitmap }
  Bm: TBitmap; { temporary TBitmap }
  Dc: hdc; { used to convert the DOB to a DDB }
  IsPaletteDevice: bool;
begin
  Application.ProcessMessages;
  { If range checking is on - turn it off for now }
  { we will remember if range checking was on by defining }
  { a define called CKRANGE if range checking is on. }
  { We do this to access array members past the arrays }
  { defined index range without causing a range check }
  { error at runtime. To satisfy the compiler, we must }
  { also access the indexes with a variable. ie: if we }
  { have an array defined as a: array[0..0] of byte, }
  { and an integer i, we can now access a[3] by setting }
  { i := 3; and then accessing a[i] without error }
{$IFOPT R+}
  {$DEFINE CKRANGE}
  {$R-}
{$ENDIF}

  { Lets check to see if this is a palette device - if so, then }
  { we must do palette handling for a successful operation. }
  { Get the screen's dc to use since memory dc's are not reliable }
  dc := GetDc(0);
  IsPaletteDevice := GetDeviceCaps(dc, RASTERCAPS) and (RC_PALETTE = RC_PALETTE);
  { Give back the screen dc }
  dc := ReleaseDc(0, dc);

  { Размер информации о рисунке должен равняться размеру BitmapInfo }
  { плюс размер таблицы цветов, минус одна таблица }
  { так как она уже объявлена в TBitmapInfo }
  BitmapInfoSize := SizeOf(TBitmapInfo) + (SizeOf(TRGBQUAD) * 255);

  { The bitmap size must be the width of the bitmap rounded }
  { up to the nearest 32 bit boundary }
  BitmapSize := (SizeOf(byte) * 256) * 256;

  { Размер палитры должен равняться размеру TLogPalette }
  { плюс количество ячеек цветовой палитры - 1, так как }
  { одна палитра уже объявлена в TLogPalette }
  if IsPaletteDevice then
    PaletteSize := SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 255);

  { Выделяем память под BitmapInfo, PixelBuffer, и Palette }
  GetMem(lpBitmapInfo, BitmapInfoSize);
  hPixelBuffer := GlobalAlloc(GHND, BitmapSize);
  lpPixelBuffer := GlobalLock(hPixelBuffer);

  if IsPaletteDevice then
    GetMem(lpPalBuffer, PaletteSize);

  { Заполняем нулями BitmapInfo, PixelBuffer, и Palette }
  FillChar(lpBitmapInfo^, BitmapInfoSize, #0);
  FillChar(lpPixelBuffer^, BitmapSize, #0);
  if IsPaletteDevice then
    FillChar(lpPalBuffer^,PaletteSize, #0);

  { Заполняем структуру BitmapInfo }
  lpBitmapInfo^.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
  lpBitmapInfo^.bmiHeader.biWidth := 256;
  lpBitmapInfo^.bmiHeader.biHeight := 256;
  lpBitmapInfo^.bmiHeader.biPlanes := 1;
  lpBitmapInfo^.bmiHeader.biBitCount := 8;
  lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
  lpBitmapInfo^.bmiHeader.biSizeImage := BitmapSize;
  lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
  lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
  lpBitmapInfo^.bmiHeader.biClrUsed := 256;
  lpBitmapInfo^.bmiHeader.biClrImportant := 256;

  { Заполняем таблицу цветов BitmapInfo оттенками серого: от чёрного до белого }
  for i := 0 to 255 do
  begin
    lpBitmapInfo^.bmiColors[i].rgbRed := i;
    lpBitmapInfo^.bmiColors[i].rgbGreen := i;
    lpBitmapInfo^.bmiColors[i].rgbBlue := i;
  end;


Source: http://forum.sources.ru
ID: 03764