Как создать bitmap из массива пикселей?
01.01.2007
Один из способов создания битмапа из массива пикселей заключается в использовании 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;
Взято из https://forum.sources.ru