PHP DM Gate v0.9 » Delphi XE2 - проблемы вывода OpenGL на Bitmap

Prok186 © (25.11.11 16:29) [20]

> AttachTexture наверное не пригодился.
> GL_EXT_FrameBufferObject обычно есть в модулях типа GLExt.
> В случае использования dot его подключение выглядело так
> Load_GL_EXT_framebuffer_object;
> В принципе могу dot выложить.

С рисованием на невидимой текстуре - а"ля подложке на невидимой форме для накапливания рисунка - разобрался: в тестовой программе под 32бита идёт нормально! Обошёлся без внешних библиотек (только дельфовая OpenGL - GLu, GLut, GLext не понадобились): все необходимые константы и gl-функции работы с текстурами подгружаю сам (код новой FrameBufferUnit выложу, когда доделаю). Вызывать AttachTexture всё-таки надо (!): сразу после создания FrameBuffer (иначе на выходе битмам - чёрный квадрат Малевича). Одно НО. Завершающая процедура копирования битов с текстуры в битмап написана неудачно: не учтено, что Delphi для 64бит запрещает записывать указатели в целые переменные, а там похоже это есть - чувствую, но найти не могу (в итоге под 64бит - AccessViolation):
function TFrameBuffer.GetBitmap: TBitmap;
var buf: Pointer; l: PRGBLine; b: ^TRGBTriple; i,j, h,w: Integer;
function PtrAllign(APointer: Pointer; bytes: cardinal): Pointer;
begin
Result := Ptr(cardinal(APointer) +
(bytes - cardinal(APointer) mod bytes) mod bytes);
end;
begin
w := width; h := height;
result := TBitmap.Create;
result.PixelFormat := pf24bit;
result.Width := w; result.Height := h;
GetMem(buf, w*h*3);
glBindTexture(GL_TEXTURE_2D, texture);
ZeroMemory(buf, w*h*3);
glGetTexImage(GL_TEXTURE_2D,0, GL_RGB,GL_UNSIGNED_BYTE, buf);
glBindTexture(GL_TEXTURE_2D,0);
b := buf;
for i := h-1 downto 0 do begin
l := result.ScanLine[i];
for j:=0 to w-1 do begin
l[j].rgbtBlue := b.rgbtRed;
l[j].rgbtGreen := b.rgbtGreen;
l[j].rgbtRed := b.rgbtBlue;
Inc(b);
end;
b := PtrAllign(b,4);
end;
FreeMemory(buf);
end;

Думаю, ошибка во встроенной ф-ии PtrAllign. Поможете найти?

<Цитата>
CrytoGen (25.11.11 17:22) [21]

http://docwiki.embarcadero.com/RADStudio/en/Converting_32-bit_Delphi_Applications_to_64-bit_Windows

Замените Cardinal на NativeInt

<Цитата>
Prok186 © (25.11.11 17:43) [22]

> Замените Cardinal на NativeInt

Не помогает! Это первое, что я сделал. В этом коде вообще довольно вольно обходятся с указателями - я стараюсь избегать такого заумного и глючного кода. Нельзя ли как-то по-простому текстуру скопировать в битмап: осталось то только это для 64бит? Быстродействие для меня ни малейшей роли не играет: просто в двойном цикле. Как? Там же, насколько помню, и цвета и строки перевёрнуты как-то?

<Цитата>
Prok186 © (26.11.11 12:16) [23]

С этим уже тоже разобрался. Вот работающий код под 32 и 64 бита.
function TFrameBuffer.GetBitmap: TBitmap;
var tbuf,buf,Pline: Pointer; i,h,w: Integer; waserror: boolean;
begin
waserror := TRUE; buf := nil;
Try
w := width; h := height;
Result := TBitmap.Create;
Result.PixelFormat := pf24bit;
Result.Width := width; Result.Height := height;
GetMem(buf, w*h*3);
glPixelStorei(GL_PACK_ALIGNMENT, 1);
glBindTexture(GL_TEXTURE_2D, texture);
glGetTexImage(GL_TEXTURE_2D, 0, GL_BGR, GL_UNSIGNED_BYTE, buf);
tbuf := buf;
For i := h-1 downto 0 do begin
Pline := Result.ScanLine[i];
Move(tbuf^, Pline^, w*3);
Inc(NativeInt(tbuf), w*3);
end;
waserror := FALSE;
finally
If waserror then FreeAndNil(Result);
FreeMemory(buf);
end;
end;

Осталась одна (?) проблема. Рендеринг в текстуру работает у меня только на одном компе (карта NVIDIA GTS450). На пяти (!!) других не выходит подгрузить вспомогательные процедуры работы с текстурой и FrameBuffer. Пытаюсь подгружать функцией:
function dglGetProcAddress(ProcName: PAnsiChar;
LibHandle: Pointer = nil): Pointer;
begin
If LibHandle = nil then LibHandle := GL_LibHandle;
Result := GetProcAddress(HMODULE(LibHandle), ProcName);
If result <> nil then exit;
If Addr(wglGetProcAddress) <> nil then
Result := wglGetProcAddress(ProcName);
If Result = nil then ShowMessage('No Proc.ADDRES ' + ProcName);
end;

У меня задана LibHandle=nil (возможно, это не верно, но на одном компе всё-таки работает). Задаю, скажем, второй параметр ProcName='glGenTextures' ---> получаю фиг (точнее nil). Как правильно подгружать процедуры, связанные с видеокартой?

<Цитата>
Prok186 © (26.11.11 14:13) [24]

Похоже, понятно... Функции типа glFramebufferTexture2DEXT и др. для работы с FrameBufferObject (FBO) большинством современных видеокарт не поддерживаются. Мёртвые они... Скачал пример-EXE для работы с FBO - идёт опять же только на одном компе. Так что, рендеринг в текстуру - не выходит.

<Цитата>
Prok186 © (26.11.11 16:02) [25]

В догонку (общаюсь похоже сам с собой)... Вот теперь к своему изумлению выяснил следующее. Не всякая поверхность строится нормально - некоторые сразу дают ошибку External Exception 8000003.
Итак, тестовая поверхность, заданная просто на сетке.
Индекс i = 0.....1000 Индекс j = 0.....1200
Координата X = i*0.02 Координата Y = j*0.02
Т.е, просто декартова сетка (ради теста).
Сама поверхность:
Z = 0.2 + 0.2*sin((i+j) / 30) - слабо волнистая - строится нормально
Z = 0.2 + 0.2*sin((i+j) / 5) - сильно волнистая - не строится вообще
Нормали к поверхности задавать или нет - без разницы.
Пробовал в каждой ячейке сетки строить пару треугольников (понятно как) - режим gl_Triangles
Пробовал так же полосами - режим gl_Quad_strip. Тоже без разницы.
Что это за бред такой? Не хватает какого-то буфера глубины? Или это глюк нового компилятора??

<Цитата>
CrytoGen (26.11.11 21:15) [26]

Они не мёртвые, скорее всего у вас драйвера от Микрософта - в них нет поддержки OpenGL.

<Цитата>
Prok12 (26.11.11 21:21) [27]

> Они не мёртвые, скорее всего у вас драйвера от Микрософта
> - в них нет поддержки OpenGL.

А вообще - это "продвинутая" технология - Frame Buffer Object, или она в дальнейшем сойдёт на нет и поддерживаться не будет, как считаете?

<Цитата>
Prok12 (27.11.11 09:10) [28]

Вот что с текстурами на сег. день вышло:
1) Полностью рендеринг в них работает только на одном из 7 компов (не густо!)
2) На одних компах подгружаемые функции-расширения OpenGL не находятся функцией типа ....:=wglGetProcAddress('glFramebufferTexture2DEXT') - это стандартная функция поиска в библиотеках dll . Драйверы, скачанные с офиц. сайтов видеокарт, не всегда помогают...
3) На другом компе (ноутбук, карта NVIDIA 9600M GT) функции подгрузились успешно, но в самом начале инициализации работы с FrameBuffer стоят 2 строки:
glGenRenderbuffersEXT(1, @depthb);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, depthb);

Затыкается уже на второй (первая проходит)... Ошибку не выдаёт, но функция проверки завершения:
Res := glCheckFramebufferStatusEXT(GL_FRAMEBUFFER_EXT);

не даёт желаемое
Res = GL_FRAMEBUFFER_COMPLETE_EXT

(только если вторую строку закомментировать - ОК, все операции инициализации буферов идут до конца)
У меня задано:
GL_RENDERBUFFER_EXT = $8D41;
......
type TglBindRenderbufferEXT = procedure(target: GLenum;
renderbuffer: GLuint); stdcall;;
...................
var glBindRenderbufferEXT: TglBindRenderbufferEXT;

<Цитата>
CrytoGen (27.11.11 20:44) [29]

У меня на всех компьютерах работает.
Из последних карт: GT 9600M, GTX460, GTX550, всякие GTS 250 и так далее, из AMD Radeon 2600 XT

<Цитата>
Prok12 (28.11.11 00:59) [30]

Может я как-то не так подгружаю библиотеки? Вот начало Вашей слегка переделанной Unit:
unit FrameBufferUnit;

interface

uses Windows, SysUtils, Graphics, OpenGL, Dialogs;

type TFrameBuffer = class
private
width, height: Integer;
frameb, depthb, texture: GLuint;
ftex: boolean;
public
constructor Create(const nWidth, nHeight: Integer;
ctexture: Integer = 0);
destructor Destroy;override;
procedure BindFrameBuffer;
procedure UnbindFrameBuffer;
function GetBitmap:TBitmap;
procedure AttachTexture;
procedure DettachTexture;
end;
{---------------------------------------------------------------------}
procedure glGenTextures(n: GLsizei; textures: PGLuint);
stdcall; external 'opengl32.dll';
procedure glBindTexture(target: GLenum; texture: GLuint);
stdcall; external 'opengl32.dll';
procedure glDeleteTextures(n: GLsizei;
const textures: PGLuint); stdcall; external 'opengl32.dll';
{---------------------------------------------------------------------}
implementation { TFrameBuffer }

type TglFramebufferTexture2DEXT = procedure(target: GLenum;
attachment: GLenum; textarget: GLenum;
texture: GLuint; level: GLint); stdcall;
TglBindFramebufferEXT = procedure(target: GLenum;
framebuffer: GLuint); stdcall;
TglGenFramebuffersEXT = procedure(n: GLsizei;
framebuffers: PGLuint); stdcall;
TglGenRenderbuffersEXT = procedure(n: GLsizei;
renderbuffers: PGLuint); stdcall;
TglBindRenderbufferEXT = procedure(target: GLenum;
renderbuffer: GLuint); stdcall;
TglRenderbufferStorageEXT = procedure(target: GLenum;
internalformat: GLenum; width: GLsizei; height: GLsizei); stdcall;
TglFramebufferRenderbufferEXT = procedure(target: GLenum; attachment:
GLenum; renderbuffertarget: GLenum; renderbuffer: GLuint); stdcall;
TglCheckFramebufferStatusEXT = function(target:GLenum):GLenum; stdcall;
TglDeleteFramebuffersEXT = procedure(n: GLsizei;
const framebuffers: PGLuint); stdcall;
TglDeleteRenderbuffersEXT = procedure(n: GLsizei;
const renderbuffers: PGLuint); stdcall;

var glFramebufferTexture2DEXT: TglFramebufferTexture2DEXT;
glBindFramebufferEXT: TglBindFramebufferEXT;
glGenFramebuffersEXT: TglGenFramebuffersEXT;
glGenRenderbuffersEXT: TglGenRenderbuffersEXT;
glBindRenderbufferEXT: TglBindRenderbufferEXT;
glRenderbufferStorageEXT: TglRenderbufferStorageEXT;
glFramebufferRenderbufferEXT: TglFramebufferRenderbufferEXT;
glCheckFramebufferStatusEXT: TglCheckFramebufferStatusEXT;
glDeleteFramebuffersEXT: TglDeleteFramebuffersEXT;
glDeleteRenderbuffersEXT: TglDeleteRenderbuffersEXT;

const
GL_FRAMEBUFFER_EXT = $8D40;
GL_COLOR_ATTACHMENT0_EXT = $8CE0;
GL_GENERATE_MIPMAP = $8191;
GL_RGBA8 = $8058;
GL_RGB8 = $8051;
GL_RENDERBUFFER_EXT = $8D41;
GL_DEPTH_ATTACHMENT_EXT = $8D00;
GL_FRAMEBUFFER_COMPLETE_EXT = $8CD5;
GL_BGR = $80E0;
GL_STENCIL_ATTACHMENT_EXT = $8D20;
GL_DEPTH_COMPONENT24 = $81A6;

var GL_LibHandle: Pointer = nil;

{=====================================================================}
function dglGetProcAddress(ProcName: PAnsiChar;
LibHandle: Pointer = nil): Pointer;
begin
If LibHandle = nil then LibHandle := GL_LibHandle;
Result := GetProcAddress(HMODULE(LibHandle), ProcName);
If result <> nil then exit;
If Addr(wglGetProcAddress) <> nil then
Result := wglGetProcAddress(ProcName);
If Result = nil then ShowMessage('No Proc.ADDRES ' + ProcName);
end;

{=====================================================================}
procedure TFrameBuffer.AttachTexture;
begin
glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT,
GL_COLOR_ATTACHMENT0_EXT, GL_TEXTURE_2D, texture, 0);
end;

{=====================================================================}
procedure TFrameBuffer.BindFrameBuffer;
begin
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, frameb);
end;

{=====================================================================}
constructor TFrameBuffer.Create(const nWidth, nHeight: Integer;
ctexture: Integer);
var Res: Integer;
begin
glFramebufferTexture2DEXT :=
dglGetProcAddress(PAnsiChar('glFramebufferTexture2DEXT'));
glBindFramebufferEXT := dglGetProcAddress('glBindFramebufferEXT');
glGenFramebuffersEXT := dglGetProcAddress('glGenFramebuffersEXT');
glGenRenderbuffersEXT := dglGetProcAddress('glGenRenderbuffersEXT');
glBindRenderbufferEXT := dglGetProcAddress('glBindRenderbufferEXT');
glRenderbufferStorageEXT :=
dglGetProcAddress('glRenderbufferStorageEXT');
glFramebufferRenderbufferEXT :=
dglGetProcAddress('glFramebufferRenderbufferEXT');
glCheckFramebufferStatusEXT :=
dglGetProcAddress('glCheckFramebufferStatusEXT');
glDeleteFramebuffersEXT:= dglGetProcAddress('glDeleteFramebuffersEXT');
glDeleteRenderbuffersEXT :=
dglGetProcAddress('glDeleteRenderbuffersEXT');
{.....................................................................}
Width := nWidth; Height:=nHeight;
ftex := ctexture <> 0;
If ftex then texture := ctexture else glGenTextures(1, @texture);
glBindTexture(GL_TEXTURE_2D,texture);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER,
GL_LINEAR_MIPMAP_LINEAR);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
glTexParameterf(GL_TEXTURE_2D, GL_GENERATE_MIPMAP,0);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA8, Width, Height,
0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
glBindTexture(GL_Texture_2D, 0);
{.....................................................................}
glGenRenderbuffersEXT(1, @depthb);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, depthb);
glGenFramebuffersEXT(1, @frameb);
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, frameb);
glRenderbufferStorageEXT(GL_RENDERBUFFER_EXT, GL_DEPTH_COMPONENT,
width, height);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, 0);
glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT,
GL_COLOR_ATTACHMENT0_EXT, GL_TEXTURE_2D, texture, 0);
glFramebufferRenderbufferEXT(GL_FRAMEBUFFER_EXT,
GL_DEPTH_ATTACHMENT_EXT, GL_RENDERBUFFER_EXT, depthb);
{.....................................................................}
Res := glCheckFramebufferStatusEXT(GL_FRAMEBUFFER_EXT);
If Res <> GL_FRAMEBUFFER_COMPLETE_EXT then
raise Exception.Create('Frame Buffer error');
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0);
{ Присоединяем текстуру }
AttachTexture;
end;

Спотыкается почти а всех компах именно на glBindRenderbufferEXT уже в Constructor, даже когда находит все необходимые функции-расширения (на карте 9600M GT)

<Цитата>
CrytoGen (28.11.11 07:33) [31]

контекст выбран?

<Цитата>
Prok12 (28.11.11 08:35) [32]

> контекст выбран?

Конечно! Без его выбора программа тоже не найдёт функции-расширения OpenGL. Да и, как говорил, на одном компе всё идёт...

{= Получение контекста для вывода ф-ми OpenGL на экран ========}
function TFormMain.GetScreenContext(const CanHandle: THandle): HGLRC;
var nPixelFormat: Integer; PFD: TPixelFormatDescriptor;
begin { См. Краснов, Ex25 - MDI, Глава 1 }
{................. Устанавливаем формат пикселей .....................}
FillChar(PFD, SizeOf(PFD), 0);
With PFD do begin
nSize := SizeOf(PFD); nVersion := 1;
dwFlags := pfd_Draw_to_Window or pfd_Generic_Accelerated or
pfd_Support_OpenGL or pfd_DoubleBuffer;
iPixelType := pfd_Type_RGBA;
cColorBits := 24; cDepthBits := 32;
iLayerType := pfd_Main_Plane;
end;
nPixelFormat := ChoosePixelFormat(CanHandle, @PFD);
SetPixelFormat(CanHandle, nPixelFormat, @PFD);
Result := wglCreateContext(CanHandle); { Rendering Context }
end;

{=============================================}
function TFormMain.DrawToText(ww,hh: Integer): TBitmap;
var FrameBuffer: TFrameBuffer;
var MyDC: HDC; MainGLContext: HGLRC;
begin
Hide; { Скрываем форму - чтобы рисовать на невидимом объекте }
MyDC := GetDC(Panel1.Handle);
MainGLContext := GetScreenContext(MyDC);
wglMakeCurrent(MyDC, MainGLContext);
FrameBuffer := TFrameBuffer.Create(ww, hh);
FrameBuffer.BindFrameBuffer;
TestPaint; SwapBuffers(MyDC);
glFinish;
Result := FrameBuffer.GetBitmap;
FrameBuffer.UnbindFrameBuffer;
FrameBuffer.Free;
Sleep(300); Show; { Снова показываем форму }
end;

<Цитата>
Prok186 © (28.11.11 13:34) [33]

Дополнение к сообщению от 26.11.11 16:02
Говорил там о совершенно бредовой ошибке: успех вывода на битмап (и DIB тоже) зависит от того, насколько сложная поверхность рисуется. Ну не бред ли? Этот баг проявляется только при компиляции под 64бит.
Всё-таки сделал отдельный тестовый проект и выложил на файлообменник.
1) http://exfile.ru/232178 - полная версия, где для картинки с синусами есть нормали, блеск, можно повращать и помасштабировать её обычными средствами (Ctrl-Shifr-Alt-mouse). Там в основной форме 2 кнопки. Первая просто рисует графику OpenGL на ещё одну форму. Вторая (справа) рисует, а потом рендерит в битмап (DIB) и сохраняет в файл. Успех работы второй зависит от значения DENOMINATOR, выбираемого на форме - это знаменатель в формуле с синусом, определяющей поверхность. Под 32бит идёт всё. Под 64бит идёт только при Denominator >100: когда "волны" синуса не сильно затеняют друг-друга.
2) http://exfile.ru/232180 - усечённая версия: кода меньше, с ней проще работать, анализировать - картинки не столь красивы, неподвижны, но баги те же (на любом компе).
Привожу там полные тексты PAS и все EXE (64bit и 32bit). Всё делалось под Delphi XE2 Update2 (сборка 4316).
Похоже, у Embarcadero возникла проблема с буфером глубины именно для DIB или Bitmap под 64бит.

<Цитата>
CrytoGen (29.11.11 21:26) [34]

Начал переписывать под xe2 64 bit. Сам пока заткнулся на d3d, но нашёл одну возможную проблему.
Покажите ваш прототип wglGetProcAddress

<Цитата>
Prok12 (30.11.11 00:01) [35]

> Покажите ваш прототип wglGetProcAddress

Не совсем понимаю, о чём речь? У меня с текстурами сейчас по-прежнему - на одном компе идёт выложенный выше код. На другом - никак не проходит пресловутая ф-я
glGenRenderbuffersEXT(1, @depthb);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, depthb);

Причём все остальные функции - расширения OpenGL идут нормально...
Не могли бы Вы выложить на какой-то файлообменник полностью код примера с FBO и необходимыми библиотеками?
Кстати, вот здесь выложил совсем укороченный пример кода с OpenGL и Bitmap, который идёт под 32бита, но не идёт под 64 http://exfile.ru/232453 Там опять же - нажать правую кнопку - откроется окно с "синусоидой". При закрытии его - должен пойти рендеринг в битмап (DIB)... Но на 64битах он пойдёт только если периодов синусоиды немного: Denominator=100. При 20 - крах. Сам код там уже довольно простой, без арифметики: только OpenGL .

<Цитата>