Cегодня вот... оживленно треплюсь с парнем, сидящим за соседним компом... и от возбуждения разговором слегка теряю равновесие и почти падаю на него :))... Он мне говорит: "отойди от меня...", - "отойти на 20 пунктов?" - несмело интересуюсь я... "Нет", - задумчиво продолжает он... - "отойди на 30 пикселей"...
Один из способов создания битмапа из массива пикселей заключается в использовании 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 dobegin
lpBitmapInfo^.bmiColors[i].rgbRed := i;
lpBitmapInfo^.bmiColors[i].rgbGreen := i;
lpBitmapInfo^.bmiColors[i].rgbBlue := i;
end;
end;
Перевод контента на русский язык:
Похоже, вы пытаетесь создать битмап из массива пикселей. Вы используете функцию Windows API CreateDiBitmap для этого.
Вот разбивка вашего кода:
Вы определяете переменные и константы.
В процедуре Button1Click вы настраиваете некоторые памятные выделения для информации о битмапе, буфера пикселей и палитры.
Затем вы заполняете эти памятные выделения нулями с помощью функции FillChar.
Далее вы заполняете структуру BitmapInfo значениями.
Наконец, вы создаете цикл для пополнения таблицы цветов (или палитры) оттенками серого от черного до белого.
Однако, в вашем коде есть некоторые проблемы:
Вы не создаете битмап с помощью CreateDiBitmap. Эта функция используется для конвертации устройственно-независимого битмапа в устройственно-зависимый битмап.
Ваш код не использует переменную lpPixelBuffer, которая обычно хранит массив пикселей.
Логика создания палитры кажется неправильной. Вы не создаете палитру с 256 элементами.
Вот альтернативное решение:
Вы можете использовать функцию CreateBitmap из Windows API для создания битмапа из массива пикселей. Вот пример кода:
procedureTForm1.Button1Click(Sender:TObject);varhBitmap:HBITMAP;hPal:HPALETTE;hdcMem:HDC;lpBits:^TBitmapInfo;i,j:LongInt;begin// Создайте структуру информации о битмапеlpBits:=AllocMem(SizeOf(TBitmapInfo));// Заполните информацию о битмапе значениямиlpBits^.bmiHeader.biSize:=SizeOf(TBitmapInfoHeader);lpBits^.bmiHeader.biWidth:=256;lpBits^.bmiHeader.biHeight:=256;lpBits^.bmiHeader.biPlanes:=1;lpBits^.bmiHeader.biBitCount:=8;lpBits^.bmiHeader.biCompression:=BI_RGB;// Создайте палитру с 256 элементамиhPal:=CreateHalftonePalette(255);// Создайте битмапhBitmap:=CreateBitmap(lpBits^.bmiHeader.biWidth,lpBits^.bmiHeader.biHeight,1,8,lpBits^);// Закройте битмап-битыhdcMem:=CreateCompatibleDC(0,0,0);SelectObject(hdcMem,hBitmap);lpBits^:=GetBitmapBits(hBitmap);// Заполните массив пикселей оттенками серогоfori:=0to255doforj:=0to255dolpBits^[j*256+i]:=i;// или какое-то другое вычисление// Откройте и освободите памятьReleaseDC(0,hdcMem);FreeMem(lpBits);end;
В этом коде мы создаем структуру информации о битмапе, заполняем ее значениями, а затем используем ее для создания битмапа. Мы закрываем битмап-биты с помощью CreateCompatibleDC и SelectObject, а затем заполняем массив пикселей оттенками серого с помощью цикла. Наконец, мы открываем и освобождаем память.
Обратите внимание, что это только пример кода, и вам может потребоваться его адаптация для вашего конкретного случая.
Создать битмап из массива пикселей можно с помощью Windows API функции CreateDiBitmap() или создавая свои структуры и заполняя их необходимыми данными.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.