Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 716

Раздел: Delphi » Графика (2D и 3D) в приложениях
/ вопрос открыт /

Здравствуйте, эксперты!
Подскажите пожалуйста как сохранить в файл .bmp то, что нарисовано в окне формы при помощи OpenGL. Другими словами - воспроизводится некая анимация посредством OpenGL и в определенный момент нужно захватить то, что отрисовано в окне в графический файл. Стандартными средствами решить вопрос не получилось, поэтому очень расчитываю на Вашу помощь.

Приложение:
  1.  


Сергей П. Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Сергей П. (статус: Посетитель)
Вопрос отправлен: 23 июня 2008, 13:20
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, Сергей П.!
Попробуйте такой вот простой пример:

// gr - объект, на канве которого рисуется с помощью OpenGL 
bt := TBitmap.Create;
with bt do
begin
   Width := gr.Width;
   Height := gr.Height;
   Canvas.CopyRect(ClientRect, gr.Canvas, gr.ClientRect);
   SaveToFile('с:\bt.bmp');
   Free;
end;

Желаю удачи.

Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 23 июня 2008, 14:43

Ответ #2. Отвечает эксперт: Вадим К

Здравствуйте, Сергей П.!
Результат конвертирования в приложении. Вроде должно работать. Но помните, что это будет работать только если выставлен 24 битный цвет при инициализации OpenGl.

Приложение:
  1. procedure Screens(contr:TWinControl);
  2. var
  3. rect :TRect;
  4. cx, cy:integer;
  5. bitmap:HBITMAP;
  6. pDC, MemDC:HDC;
  7. NbBytes:integer;
  8. pPixelData:^byte;
  9. header:BITMAPINFOHEADER;
  10. _handle:THandle;
  11. pData:PChar;
  12. begin
  13.  
  14. rect := contr.ClientRect;
  15. cx := rect.Right;
  16. cy := rect.Bottom;
  17.  
  18.  
  19.  
  20. cx := cx - cx mod 4;
  21.  
  22. pDC := GetDC(contr.Handle);
  23.  
  24. MemDC := CreateCompatibleDC(pDC);
  25. bitmap := CreateCompatibleBitmap(pDC,cx,cy);
  26. SelectObject(MemDC, bitmap);
  27.  
  28.  
  29. NbBytes := 3 * cx * cy;
  30. GetMem(pPixelData, NbBytes);
  31.  
  32.  
  33. glReadPixels(0,0,cx,cy,GL_RGB,GL_UNSIGNED_BYTE,pPixelData);
  34.  
  35.  
  36. header.biWidth := cx;
  37. header.biHeight := cy;
  38. header.biSizeImage := NbBytes;
  39. header.biSize := 40;
  40. header.biPlanes := 1;
  41. header.biBitCount := 3 * 8; // RGB
  42. header.biCompression := 0;
  43. header.biXPelsPerMeter := 0;
  44. header.biYPelsPerMeter := 0;
  45. header.biClrUsed := 0;
  46. header.biClrImportant := 0;
  47.  
  48.  
  49. _handle := GlobalAlloc (GHND,sizeof(BITMAPINFOHEADER) + NbBytes);
  50. if(_handle <> 0) then
  51. begin
  52.  
  53. pData := GlobalLock(_handle);
  54.  
  55. CopyMemory(pData,@header,sizeof(BITMAPINFOHEADER));
  56. CopyMemory(pData+sizeof(BITMAPINFOHEADER),pPixelData,NbBytes);
  57.  
  58. GlobalUnlock(_handle);
  59.  
  60.  
  61. OpenClipboard(Application.Handle);
  62. EmptyClipboard();
  63. SetClipboardData(CF_DIB,_handle);
  64. CloseClipboard();
  65. end;
  66.  
  67.  
  68. DeleteDC(MemDC);
  69. DeleteObject(Bitmap);
  70. FreeMem(pPixelData);
  71. end;
  72. procedure TForm3.Button1Click(Sender: TObject);
  73. begin
  74.  
  75. Screens(Panel1);
  76. end;


Ответ отправил: Вадим К (статус: Академик)
Время отправки: 23 июня 2008, 22:21
Оценка за ответ: 5


Мини-форум вопроса

Всего сообщений: 12; последнее сообщение — 26 июня 2008, 01:49; участников в обсуждении: 2.
Сергей П.

Сергей П. (статус: Посетитель), 23 июня 2008, 15:22 [#1]:

Спасибо за отклик, но не захватывает кадр такая конструкция. Уже весь инет облазил решения не могу найти. Хотел попробывать то, которое на http://sources.ru/cpp/cpp_3d.shtml , но там не на Delphi.
Сергей П.

Сергей П. (статус: Посетитель), 23 июня 2008, 17:23 [#2]:

Или может кто знает как на Delphi следующие 3 фрагмента перевести:

// Создаём bitmap и устанавливаем его в контексте устройства
CBitmap bitmap;
CDC *pDC = GetDC();
CDC MemDC;
ASSERT(MemDC.CreateCompatibleDC(NULL));
ASSERT(bitmap.CreateCompatibleBitmap(pDC,size.cx,size.cy));
MemDC.SelectObject(&bitmap);


// Рассчитываем кол-во необходимых байт для изображения
int NbBytes = 3 * size.cx * size.cy;
unsigned char *pPixelData = new unsigned char[NbBytes];


char *pData = (char *)
Сергей П.

Сергей П. (статус: Посетитель), 23 июня 2008, 23:27 [#3]:

Огромное спасибо ! Заработало с 1-го раза. Единственный нюанс - цвета изменились, красный стал похож на что-то ближе к синему и .т.п. Буду добивать дальше.
Вадим К

Вадим К (статус: Академик), 24 июня 2008, 10:01 [#4]:

Ну с цветами я предупреждал. Покажите код, как инициализируете OpenGl. Вполне возможно, что вы используете 16битный цвет или другой.этот код будет работать нормально только для 24битного с правильной последовательностью бит.
Галочка "подтверждения прочтения" - вселенское зло.
Сергей П.

Сергей П. (статус: Посетитель), 24 июня 2008, 11:03 [#5]:

procedure TForm1.SetDCPixelFormat;
var
PixelFormat: integer;
PFD: TPixelFormatDescriptor;
begin
FillChar(PFD,SizeOf(PFD),0);
with PFD do
begin
nSize:=SizeOf(PFD);
nVersion:=1;
dwFlags:=PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or
PFD_DOUBLEBUFFER;
iPixelType:=PFD_TYPE_RGBA;
cColorBits:=24;
cDepthBits:=32;
iLayerType:=PFD_MAIN_PLANE;
end;
PixelFormat:=ChoosePixelFormat(DC,@PFD);
if PixelFormat=0 then
Raise
Exception.Create('Формат пикселей не поддерживается');
SetPixelFormat(DC,PixelFormat,@PFD);
DescribePixelFormat(DC,PixelFormat,SizeOf(TPixelFormatDescriptor),PFD);
with PFD do
if ((dwFlags and PFD_DRAW_TO_WINDOW)=0) or
((dwFlags and PFD_SUPPORT_OPENGL)=0) or
((dwFlags and PFD_DOUBLEBUFFER)=0) or
(iPixelType<>PFD_TYPE_RGBA) or
(cColorBits<16) then
Raise
Exception.Create('Выбран не подходящий формат пикселей');
end;
Сергей П.

Сергей П. (статус: Посетитель), 24 июня 2008, 12:57 [#6]:

Насчет 24 бит. С этим всё в порядке помоему. А вот кадр захватывается в формате BGR, а отображается в RGB, вот и получается искажение цвета.
Вадим К

Вадим К (статус: Академик), 24 июня 2008, 23:31 [#7]:

Ну тогда, если с битностью нет проблем, то никто не мешает переставить байты при записи. пробежаться циклом и всё. Хотя вроде можно флажок для HBITMAP выставить и указать порядок цветов.
Галочка "подтверждения прочтения" - вселенское зло.
Сергей П.

Сергей П. (статус: Посетитель), 25 июня 2008, 17:54 [#8]:

Да, если б ещё знать где этот флажок выставить, а то все перестановки очень процесс замедляют. В любом случае ещё раз спасибо, а то бы дальше не смог двинуться.
Сергей П.

Сергей П. (статус: Посетитель), 25 июня 2008, 20:08 [#9]:

А вот здесь не подскажете ?
Получил я свой файл в конце концов.
Btm.LoadFromClipBoardFormat(CF_BITMAP,Clipboard.GetAsHandle(CF_BITMAP), 0);

Хотел BRG в RGB так переделать:

procedure TForm1.BGRtoRGB();
var
Line : pByteArray;
begin
Line:=PByteArray(Btm.Scanline[0]);
asm
pushad
mov edx, 3BFh // 960-1 Высота рисунка
@repy:
mov ecx, 4AFh // 1200-1 Ширина рисунка
@repx:
mov al, byte ptr[Line]
mov ah, byte ptr[Line+2]
mov byte ptr[Line+2], al
mov byte ptr[Line], ah
add Line,3
dec ecx
jge @repx
dec edx
jge @repy
popad
end;
end;

Но в результате ничего не меняется, подозреваю что указатель (Line) использую и передаю неправильно.
Заранее извиняюсь если вопрос наивен, давно этим не занимался (особенно вставками на ассемблере).
Вадим К

Вадим К (статус: Академик), 25 июня 2008, 21:39 [#10]:

Вы решили, что используя асемблер, сделаете быстрее и качественее? Напишите для начала это всё на самом обычном паскале. Это раз.
Во вторых, использовать Scanline незачем. у вас ведь есть массив пикселей. Вот его и надо проработать перед записью.
Опять пишу на глаз, но должно работать и принимайте код как идею.
//pPixelData:^byte; <-- было
pPixelData:Pbyte;
...
p1,p2:Pbyte; te:byte;
  c:DWORD;
begin
....
// Копируем из OpenGL
 glReadPixels(0,0,cx,cy,GL_RGB,GL_UNSIGNED_BYTE,pPixelData);
//Вставленный код
 p1 := pPixelData;//указатель на начало данных
 p2 := p1; inc(p2,2);//сдвиним на 2 байта
 for c := 0 to cx * cy - 1 do //пробежимся по всем пикселям в массиве
    begin
     //обмен
      te := p1^;
      p1^ := p2^;
      p2^ := te;
     //сдвинем указатели на 3 байта вперёд.
      inc(p1,3);
      inc(p2,3);
    end;
 
 // Заполняем заголовок
....
Галочка "подтверждения прочтения" - вселенское зло.
Сергей П.

Сергей П. (статус: Посетитель), 25 июня 2008, 23:47 [#11]:

Всё работает , спасибо. На ассеммблере вставочку решил сделать потому что весь процесс захвата кадра занимает в моём случае около 0.5 сек. По моему это долго (есть же программы которые видео захватывают и пользователь этого даже не замечает). Я думал что почти всё это время уходит на перестановку R<->B, но оказывается что это выполняется почти мгновенно, а оно (0.45 сек.) уходит на одну строчку -
glReadPixels(0,0,cx,cy,GL_RGB,GL_UNSIGNED_BYTE,pPixelData);
В данной задаче скорость выполнения мне не важна, поэтому в принципе вопрос можно считать закрытым (а можно и пообсуждать ещё). Если возможно, подскажите в каком направлении поискать чтоб сорость уменьшить. Может ссылочка на материал какой-нибудь по этой теме есть ?
P.S. Очень рад что зашел на этот сайт, и получил от Вас ответы. Спасибо.
Вадим К

Вадим К (статус: Академик), 26 июня 2008, 01:49 [#12]:

Вот вот. перед тем, как начинать что то оптимизировать и переписывать на ассемблере, вначале надо пройтись профайлером и посмотреть, что тормозит. Для простых эксперементов обычно хватает функции GetTickCount + запись в файл/массив.

То, что тормозит функция чтения пикселей - я даже не сомневаюсь, так как попиксельный доступ - самая медленная операция в данном контексте. С DirectX еще хуже - там нет операции доступа к пикселям в явном виде, но там другие методы.

P.S. Заходите ещё, задавайте умные вопросы, приводите других.
Галочка "подтверждения прочтения" - вселенское зло.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:57
Выполнено за 0.02 сек.