{$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; end;
|