Как правильно использовать GetDIBits?

[Katerina1993]

На этом же форуме, пост - Get(Set)DIBits нашла пример использования GetDIBits.

Однако при запуске GetDIBits всегда возвращает "0" и соответственно ошибку которая здесь указано в условии.
ShowMessage('Error on Get');
Как работает GetDIBits? Мне бы простой пример?

procedure TForm1.Button1Click(Sender: TObject);
var
  dc: HDC;
  BI: tagBITMAPINFO;
  pBits:Pointer;
  OK: integer;
begin
  DC:=GetDC(0); //handle ekrana
  image1.Width:=screen.Width;
  image1.Height:=screen.Height;
  //не забываем про размер самого битмапа
  image1.Picture.Bitmap.Width:=image1.Width;
  image1.Picture.Bitmap.Height:=image1.Height;
   // ustonavlivaem snimok ekrana v kartinku
  BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
  with BI.bmiHeader do begin
    biSize:= SizeOf(BI.bmiHeader);//установливаем только размер структуры
  end;
  //первый вызов - заполняем структуру
  OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, BI.bmiHeader.biHeight, nil, BI, DIB_RGB_COLORS);
  Form1.Caption:=IntToStr(OK);
  if ok=0 then ShowMessage('Error on Get');
  //занимаем память под массив
  pBits:=PChar(GlobalAlloc(GPTR,BI.bmiHeader.biSizeImage));
  //второй вызов - заполняем массив
  OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, BI.bmiHeader.biHeight, pBIts, BI, DIB_RGB_COLORS);
  if ok=0 then ShowMessage('Error on Get');
  //задаем размеры второго рисунка
  image2.Width:=image1.Width;
  image2.Height:=image1.Height;
  //и его битмапа
  image2.Picture.Bitmap.Width:=image1.Width;
  image2.Picture.Bitmap.Height:=image1.Height;
  ok:=SetDIBits(Canvas.Handle,image2.Picture.Bitmap.Handle,0,BI.bmiHeader.biHeight,pBits,BI,DIB_RGB_COLORS);
  if ok=0 then ShowMessage('Error on Get');
  //освобождаем занятую память
  GlobalFree(Cardinal(pBits));
  //а это - просто что не мешался
  image1.Width:=0;
  image1.Height:=0;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  ABitmap: TBitmap;
begin
ABitmap:=TBitmap.Create;
ABitmap.LoadFromFile('.\bitmap\main.bmp');
Image1.Canvas.Draw(0,0,ABitmap);
end;

[macomics]

Тут вся проблема в том, что структура tagBITMAPINFO объявлена фактически без палитры

  PBitmapInfo = ^TBitmapInfo;
  {$EXTERNALSYM tagBITMAPINFO}
  tagBITMAPINFO = packed record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..0] of TRGBQuad; // <<<----- нет места под палитры т.к. 0 элементов в массиве
  end;
  TBitmapInfo = tagBITMAPINFO;
  {$EXTERNALSYM BITMAPINFO}
  BITMAPINFO = tagBITMAPINFO;

Чтобы функция GetDIBits правильно заполнила структуру, то ей нужно место для палитры максимум в 256 цветов. Т.е. выделяем место вручную и передаем в функцию не структуру, а указатель на динамическую память.

procedure TForm1.Button1Click(Sender: TObject);
var
  dc: HDC;
  BI: Pointer;
  pBI: PBitmapInfo;
  pBits:Pointer;
  OK, Sz: integer;
begin
  Sz := SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad);
  GetMem(BI, Sz);
  pBI := BI; // Если сразу передать в GetMem, то будет выделено в несколько раз больше памяти
{ т.к. Pointer - не знает о размерах структуры TBitmapInfo, а PBitmapInfo знает и величина
 (SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad)) будет не в байтах а в структурах TBitmapInfo
 Но типизированный указатель потом проще будет использовать для доступа к полям структуры }
  DC:=GetDC(0); //handle ekrana
  image1.Width:=screen.Width;
  image1.Height:=screen.Height;
  //не забываем про размер самого битмапа
  image1.Picture.Bitmap.Width:=image1.Width;
  image1.Picture.Bitmap.Height:=image1.Height;
   // ustonavlivaem snimok ekrana v kartinku
  BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
  with pBI^ do begin
    bmiHeader.biSize:= SizeOf(bmiHeader);//установливаем только размер структуры
    bmiHeader.biBitCount := 0; // !!!!!!  ЭТО ТОЖЕ НАДО ИНИЦИАЛИЗИРОВАТЬ !!!!!!
  end;
  //первый вызов - заполняем структуру
  OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, nil, pBI^, DIB_RGB_COLORS);
  Form1.Caption:=IntToStr(OK);
  if ok=0 then ShowMessage('Error on Get');
  //занимаем память под массив
  GetMem(pBits, pBI^.bmiHeader.biSizeImage);
  //второй вызов - заполняем массив
  OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, pBIts, pBI^, DIB_RGB_COLORS);
  if ok=0 then ShowMessage('Error on Get');
  //задаем размеры второго рисунка
  image2.Width:=image1.Width;
  image2.Height:=image1.Height;
  //и его битмапа
  image2.Picture.Bitmap.Width:=image1.Width;
  image2.Picture.Bitmap.Height:=image1.Height;
  ok:=SetDIBits(Canvas.Handle,image2.Picture.Bitmap.Handle,0,pBI^.bmiHeader.biHeight,pBits,pBI^,DIB_RGB_COLORS);
  if ok=0 then ShowMessage('Error on Get');
  //освобождаем занятую память
  FreeMem(pBits, );
  //а это - просто что не мешался
  image1.Width:=0;
  image1.Height:=0;
  FreeMem(BI, Sz);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  ABitmap: TBitmap;
begin
ABitmap:=TBitmap.Create;
ABitmap.LoadFromFile('.\bitmap\main.bmp');
Image1.Canvas.Draw(0,0,ABitmap);
end;

[Katerina1993]

Почему-то когда я добавляю новые параметры.

 PBitmapInfo = ^TBitmapInfo;
  {$EXTERNALSYM tagBITMAPINFO}
  tagBITMAPINFO = packed record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..0] of TRGBQuad; // <<<----- нет места под палитры т.к. 0 элементов в массиве
  end;
  TBitmapInfo = tagBITMAPINFO;
  {$EXTERNALSYM BITMAPINFO}
  BITMAPINFO = tagBITMAPINFO;

появляется ряд ошибок.


Прикреплённый файлimg123.jpg (86,55 Кбайт, скачиваний: 9)

[macomics]

А не надо добавлять ничего в описание. Этот кусок скопирован из стандартного модуля Windows.pas.

Описание правильное для большинства случаев, но вот тут нужно выделять память динамически.

Надо просто сделать как показано. Можете сделать функции обертки, чтобы не создавать лишних переменных:

const
  SizeOfBitmapInfoWithColorArray = SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad);
 
function GetBitmapInfoBufferWithColorArray: PBitmapInfo;
var
  P: Pointer;
begin
  GetMem(P, SizeOfBitmapInfoWithColorArray);
  with PBitmapInfo(P)^ do begin
    bmiHeader.biSize     := SizeOf(bmiHeader);
    bmiHeader.biBitCount := 0;
  end;
  Result                 := P;
end;
 
procedure FreeBitmapInfoBufferWithColorArray(aBuffer: PBitmapInfo);
begin
  FreeMem(aBuffer, SizeOfBitmapInfoWithColorArray);
end;

Тогда можно сделать так

procedure TForm1.Button1Click(Sender: TObject);
var
  dc: HDC;
  pBI: PBitmapInfo;
  pBits:Pointer;
  OK, Sz: integer;
begin
  DC:=GetDC(0); // Получение DC экрана
  pBI := GetBitmapInfoBufferWithColorArray; // Получение буфера для BitmapInfo
 
  // Установка размеров компонента и буфера для хранения изображения
  image1.Width:=screen.Width;
  image1.Height:=screen.Height;
  image1.Picture.Bitmap.Width:=image1.Width;
  image1.Picture.Bitmap.Height:=image1.Height;
 
  // Копирование изображения экрана в буфер изображения компонента Image1
  BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
 
  // Получение актуальной информации о формате изображения
  OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, nil, pBI^, DIB_RGB_COLORS); // Получение информации
  Form1.Caption:=IntToStr(OK);
  if ok=0 then ShowMessage('Error on Get 1'); // Проверка на наличие ошибок
 
  // Получение массива пикселей изображения
  Sz := pBI^.bmiHeader.biSizeImage; // Выделение памяти под массив пикселей
  GetMem(pBits, Sz);
  OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, pBIts, pBI^, DIB_RGB_COLORS); // Получение массива
  if ok=0 then ShowMessage('Error on Get 2'); // Проверка на наличие ошибок
 
  // Изменение размеров во втором компоненте
  image2.Width:=image1.Width;
  image2.Height:=image1.Height;
  image2.Picture.Bitmap.Width:=image1.Width;
  image2.Picture.Bitmap.Height:=image1.Height;
 
  // Перенос массива пикселей в буфер второго компонента
  ok:=SetDIBits(Canvas.Handle,image2.Picture.Bitmap.Handle,0,pBI^.bmiHeader.biHeight,pBits,pBI^,DIB_RGB_COLORS);
  if ok=0 then ShowMessage('Error on Get'); // Проверка на наличие ошибок
 
  // Изменение размеров в первом компоненте
  image1.Width:=0;
  image1.Height:=0;
 
  // Освобождение памяти
  FreeMem(pBits, Sz); // Массив пикселей
  FreeBitmapInfoBufferWithColorArray(pBI); // Информация о формате изображения
end;

[Katerina1993]

Все работает, в этом посту Как сделать линию пунктиром у Rectangle в Delphi? упоминали GetBitmapBits как аналог getImageData(HTML5). Но в интернете очень мало примеров. Как использовать GetBitmapBits на картинке которая загружается в компонент Image?

procedure TForm1.FormCreate(Sender: TObject);
var
  ABitmap: TBitmap;
begin
 ABitmap:=TBitmap.Create;
 ABitmap.LoadFromFile('.\main.bmp');
 Image1.Canvas.Draw(0,0,ABitmap);
end;

[macomics]

По WinAPI все примере есть в MSDN и описаны они достаточно подробно.

К тому же вам уже дали пример современного аналога этой функции GetDIBits. В GetBitmapBits можно передавать только HBITMAP без HDC, чтобы получить пиксели. Но в GetDIBits надо передать оба хэндла (и HDC и HBITMAP). Это дополнительная возня, но можно пользоваться только последней.

HBITMAP у TImage можно найти в Image1.Picture.Bitmap.Handle, а HDC в Image1.Canvas.Handle