Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

Delphi , Графика и Игры , Bitmap

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

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 do
  begin
    lpBitmapInfo^.bmiColors[i].rgbRed := i;
    lpBitmapInfo^.bmiColors[i].rgbGreen := i;
    lpBitmapInfo^.bmiColors[i].rgbBlue := i;
  end;
end;

Перевод контента на русский язык:

Похоже, вы пытаетесь создать битмап из массива пикселей. Вы используете функцию Windows API CreateDiBitmap для этого.

Вот разбивка вашего кода:

  1. Вы определяете переменные и константы.
  2. В процедуре Button1Click вы настраиваете некоторые памятные выделения для информации о битмапе, буфера пикселей и палитры.
  3. Затем вы заполняете эти памятные выделения нулями с помощью функции FillChar.
  4. Далее вы заполняете структуру BitmapInfo значениями.
  5. Наконец, вы создаете цикл для пополнения таблицы цветов (или палитры) оттенками серого от черного до белого.

Однако, в вашем коде есть некоторые проблемы:

  1. Вы не создаете битмап с помощью CreateDiBitmap. Эта функция используется для конвертации устройственно-независимого битмапа в устройственно-зависимый битмап.
  2. Ваш код не использует переменную lpPixelBuffer, которая обычно хранит массив пикселей.
  3. Логика создания палитры кажется неправильной. Вы не создаете палитру с 256 элементами.

Вот альтернативное решение:

Вы можете использовать функцию CreateBitmap из Windows API для создания битмапа из массива пикселей. Вот пример кода:

procedure TForm1.Button1Click(Sender: TObject);
var
  hBitmap: 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);

   // Заполните массив пикселей оттенками серого
  for i := 0 to 255 do
    for j := 0 to 255 do
      lpBits^[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




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Bitmap ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 13:22:31/0.0065782070159912/1