Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.207.160.209] |
|
Сообщ.
#1
,
|
|
|
На этом же форуме, пост - 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; |
Сообщ.
#2
,
|
|
|
Тут вся проблема в том, что структура tagBITMAPINFO объявлена фактически без палитры
PBitmapInfo = ^TBitmapInfo; {$EXTERNALSYM tagBITMAPINFO} tagBITMAPINFO = packed record bmiHeader: TBitmapInfoHeader; bmiColors: array[0..0] of TRGBQuad; // <<<----- нет места под палитры т.к. 0 элементов в массиве end; TBitmapInfo = tagBITMAPINFO; {$EXTERNALSYM BITMAPINFO} BITMAPINFO = tagBITMAPINFO; 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; |
Сообщ.
#3
,
|
|
|
Почему-то когда я добавляю новые параметры.
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 Кбайт, скачиваний: 22) |
Сообщ.
#4
,
|
|
|
А не надо добавлять ничего в описание. Этот кусок скопирован из стандартного модуля 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; |
Сообщ.
#5
,
|
|
|
Все работает, в этом посту Как сделать линию пунктиром у 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; |
Сообщ.
#6
,
|
|
|
По WinAPI все примере есть в MSDN и описаны они достаточно подробно.
К тому же вам уже дали пример современного аналога этой функции GetDIBits. В GetBitmapBits можно передавать только HBITMAP без HDC, чтобы получить пиксели. Но в GetDIBits надо передать оба хэндла (и HDC и HBITMAP). Это дополнительная возня, но можно пользоваться только последней. HBITMAP у TImage можно найти в Image1.Picture.Bitmap.Handle, а HDC в Image1.Canvas.Handle |