Привет, All!
юзаю OpenGL под Delphi
можно ли в приложении c OpenGL выводить изображение в несколько форм?
у меня написан класс базовой формы, если вызвать одного наследника все работат хорошо, если одновременно с первым вызвать второго, работа нарушается, прекращается правильная перерисовка формы, почему и как этого можно избежать?
возможно бага в настройках?
unit uGLForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL,
Db, ADODB, ExtCtrls;
type
TPoint3d = record
iIdStar : integer;
x,y,z : GLdouble;
MaterialColor: Array [0..3] of GLfloat;
Name : string;
end;
TGLForm = class(TForm)
Timer: TTimer;
tMain: TADOTable;
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
DC : HDC;
hrc : HGLRC;
AngleX, AngleY : GLfloat;
Perspective : GLFloat;
base : GLuint;
myfont : HFONT;
test : HGDIOBJ;
procedure SetDCPixelFormat;
procedure InitializeRC;
procedure Camera;
protected
procedure CalcSelectLine(mouse_x, mouse_y:integer; var p1, p2 : TPoint3D);
procedure DrawScene; virtual;
procedure Draw; virtual;
procedure DrawText(sMessage : string; x,y,z : GLfloat);
procedure InitText;
public
arPoint : array of TPoint3D;
stParams : TStrings;
procedure InitForm;
end;
implementation
{$R *.DFM}
{ TForm1 }
procedure TGLForm.Camera;
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(Perspective, ClientWidth / ClientHeight, 1.0, 20.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
gluLookAt(0.0, 30.0, 10.0, 0, 0, -5.0, 0, 1, 0);
end;
procedure TGLForm.DrawScene;
begin
// очистка буфера цвета и буфера глубины
glClearColor (0.0, 0.0, 0.0, 0.0); // цвет фона
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
Camera;
// трехмерность
glLoadIdentity;
glTranslatef( 0, 0, -3.0);
glRotatef(30.0, 1.0, 0.0, 0.0);
glRotatef(AngleX, 0.0, 1.0, 0.0); // поворот на угол
glRotatef(AngleY, 0.1, 0.0, 0.0); // поворот на угол
Draw;
SwapBuffers(DC); // конец работы
end;
procedure TGLForm.InitializeRC;
begin
glEnable(GL_DEPTH_TEST); // разрешаем тест глубины
glEnable(GL_LIGHTING); // разрешаем работу с освещенностью
glEnable(GL_LIGHT0); // включаем источник света 0
glEnable(GL_COLOR_MATERIAL);
end;
procedure TGLForm.SetDCPixelFormat;
var
nPixelFormat: 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;
nPixelFormat := ChoosePixelFormat(DC, @pfd);
SetPixelFormat(DC, nPixelFormat, @pfd);
end;
procedure TGLForm.FormPaint(Sender: TObject);
var
ps : TPaintStruct;
begin
BeginPaint(Handle, ps);
DrawScene;
EndPaint(Handle, ps);
end;
procedure TGLForm.DrawText(sMessage: string; x, y, z: GLfloat);
var
A: array[0..255] of Char;
begin
StrPCopy(A, sMessage);
glRasterPos3f(x,y,z);
glPushAttrib(GL_LIST_BIT);
glListBase(base - 32);
glCallLists(length(sMessage), GL_UNSIGNED_BYTE, @A);
glPopAttrib();
end;
procedure TGLForm.InitText;
begin
base := glGenLists(96);
DC := wglGetCurrentDC();
if(base = GL_INVALID_VALUE) and (base = GL_INVALID_OPERATION)then exit;
myfont := CreateFont(-9,
0,0,0,
FW_REGULAR,
0,0,0,
ANSI_CHARSET,
OUT_TT_PRECIS,
CLIP_DEFAULT_PRECIS,
ANTIALIASED_QUALITY,
FF_DONTCARE or DEFAULT_PITCH,
'Agency FB'); //шрифт
if myfont = 0 then exit;
test := SelectObject(DC, myfont);
wglUseFontBitmaps(DC, 32, 96, base);
SelectObject(DC, test);
DeleteObject(myfont);
end;
procedure TGLForm.CalcSelectLine(mouse_x, mouse_y: integer; var p1,
p2: TPoint3D);
var
viewport : array [0..3] of GLint; // параметры viewport-a.
projection : array [0..15] of GLdouble; // матрица проекции.
modelview : array [0..15] of GLdouble; // видовая матрица.
vx,vy,vz : GLdouble; // координаты курсора мыши в системе координат viewport-a.
wx,wy,wz : GLdouble; // возвращаемые мировые координаты.
begin
// mouse_x, mouse_y - оконные координаты курсора мыши.
// p1, p2 - возвращаемые параметры - концы селектирующего отрезка,
// лежащие соответственно на ближней и дальней плоскостях
// отсечения.
glGetIntegerv(GL_VIEWPORT,@viewport); // узнаём параметры viewport-a.
glGetDoublev(GL_PROJECTION_MATRIX,@projection); // узнаём матрицу проекции.
glGetDoublev(GL_MODELVIEW_MATRIX,@modelview); // узнаём видовую матрицу.
// переводим оконные координаты курсора в систему координат viewport-a.
vx := mouse_x;
vy := height - mouse_y - 1; // где height - текущая высота окна.
// вычисляем ближний конец селектирующего отрезка.
vz := -1;
gluUnProject(vx, vy, vz, @modelview, @projection, @viewport, wx, wy, wz);
p1.x := wx;
p1.y := wy;
p1.z := wz;
// вычисляем дальний конец селектирующего отрезка.
vz := 1;
gluUnProject(vx, vy, vz, @modelview, @projection, @viewport, wx, wy, wz);
p2.x := wx;
p2.y := wy;
p2.z := wz;
end;
procedure TGLForm.FormDestroy(Sender: TObject);
begin
stParams.Free;
end;
procedure TGLForm.TimerTimer(Sender: TObject);
begin
AngleX := AngleX + 0.05;
If (AngleX >= 360.0) then AngleX := 0.0;
If (AngleY >= 360.0) then AngleY := 0.0;
InvalidateRect(Handle, nil, False); // перерисовка региона (Windows API)
end;
procedure TGLForm.FormResize(Sender: TObject);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(30.0, Width / Height, 1.0, 10.0);
glViewport(0, 0, Width, Height);
glMatrixMode(GL_MODELVIEW);
end;
procedure TGLForm.Draw;
begin
end;
procedure TGLForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if WheelDelta < 0 then
Perspective := Perspective - 0.5
else
Perspective := Perspective + 0.5;
end;
procedure TGLForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_LEFT : AngleX := AngleX - 0.5;
VK_RIGHT: AngleX := AngleX + 0.5;
VK_UP : AngleY := AngleY - 0.5;
VK_DOWN : AngleY := AngleY + 0.5;
end;
end;
procedure TGLForm.InitForm;
begin
stParams := TStrings.Create;
Perspective := 40.0;
AngleX := 0.0;
AngleY := 0.0;
DC := GetDC(Handle);
SetDCPixelFormat;
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
InitializeRC;
InitText;
end;
end.
вызов в наследниках:
...
procedure TfmMap.FormCreate(Sender: TObject);
begin
inherited;
InitForm;
tMain.Open;
SetLength(arPoint, tMain.RecordCount);
InitMap;
Timer.Enabled := True;
end;
...
Спасибо.
А>А>unit uGLForm;
А>interface
А>uses
А> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL,
А> Db, ADODB, ExtCtrls;
А>type
А> TPoint3d = record
А> iIdStar : integer;
А> x,y,z : GLdouble;
А> MaterialColor: Array [0..3] of GLfloat;
А> Name : string;
А> end;
А> TGLForm = class(TForm)
А> Timer: TTimer;
А> tMain: TADOTable;
А> procedure FormPaint(Sender: TObject);
А> procedure FormDestroy(Sender: TObject);
А> procedure TimerTimer(Sender: TObject);
А> procedure FormResize(Sender: TObject);
А> procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
А> WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
А> procedure FormKeyDown(Sender: TObject; var Key: Word;
А> Shift: TShiftState);
А> private
А> DC : HDC;
А> hrc : HGLRC;
А> AngleX, AngleY : GLfloat;
А> Perspective : GLFloat;
А> base : GLuint;
А> myfont : HFONT;
А> test : HGDIOBJ;
А> procedure SetDCPixelFormat;
А> procedure InitializeRC;
А> procedure Camera;
А> protected
А> procedure CalcSelectLine(mouse_x, mouse_y:integer; var p1, p2 : TPoint3D);
А> procedure DrawScene; virtual;
А> procedure Draw; virtual;
А> procedure DrawText(sMessage : string; x,y,z : GLfloat);
А> procedure InitText;
А> public
А> arPoint : array of TPoint3D;
А> stParams : TStrings;
А> procedure InitForm;
А> end;
А>implementation
А>{$R *.DFM}
А>{ TForm1 }
А>procedure TGLForm.Camera;
А>begin
А> glMatrixMode(GL_PROJECTION);
А> glLoadIdentity;
А> gluPerspective(Perspective, ClientWidth / ClientHeight, 1.0, 20.0);
А> glMatrixMode(GL_MODELVIEW);
А> glLoadIdentity;
А> gluLookAt(0.0, 30.0, 10.0, 0, 0, -5.0, 0, 1, 0);
А>end;
А>procedure TGLForm.DrawScene;
А>begin
А> // очистка буфера цвета и буфера глубины
А> glClearColor (0.0, 0.0, 0.0, 0.0); // цвет фона
А> glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
А> Camera;
А> // трехмерность
А> glLoadIdentity;
А> glTranslatef( 0, 0, -3.0);
А> glRotatef(30.0, 1.0, 0.0, 0.0);
А> glRotatef(AngleX, 0.0, 1.0, 0.0); // поворот на угол
А> glRotatef(AngleY, 0.1, 0.0, 0.0); // поворот на угол
А> Draw;
А> SwapBuffers(DC); // конец работы
А>end;
А>procedure TGLForm.InitializeRC;
А>begin
А> glEnable(GL_DEPTH_TEST); // разрешаем тест глубины
А> glEnable(GL_LIGHTING); // разрешаем работу с освещенностью
А> glEnable(GL_LIGHT0); // включаем источник света 0
А> glEnable(GL_COLOR_MATERIAL);
А>end;
А>procedure TGLForm.SetDCPixelFormat;
А>var
А> nPixelFormat: 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;
А> nPixelFormat := ChoosePixelFormat(DC, @pfd);
А> SetPixelFormat(DC, nPixelFormat, @pfd);
А>end;
А>procedure TGLForm.FormPaint(Sender: TObject);
А>var
А> ps : TPaintStruct;
А>begin
А> BeginPaint(Handle, ps);
А> DrawScene;
А> EndPaint(Handle, ps);
А>end;
А>procedure TGLForm.DrawText(sMessage: string; x, y, z: GLfloat);
А>var
А> A: array[0..255] of Char;
А>begin
А> StrPCopy(A, sMessage);
А> glRasterPos3f(x,y,z);
А> glPushAttrib(GL_LIST_BIT);
А> glListBase(base - 32);
А> glCallLists(length(sMessage), GL_UNSIGNED_BYTE, @A);
А> glPopAttrib();
А>end;
А>procedure TGLForm.InitText;
А>begin
А> base := glGenLists(96);
А> DC := wglGetCurrentDC();
А> if(base = GL_INVALID_VALUE) and (base = GL_INVALID_OPERATION)then exit;
А> myfont := CreateFont(-9,
А> 0,0,0,
А> FW_REGULAR,
А> 0,0,0,
А> ANSI_CHARSET,
А> OUT_TT_PRECIS,
А> CLIP_DEFAULT_PRECIS,
А> ANTIALIASED_QUALITY,
А> FF_DONTCARE or DEFAULT_PITCH,
А> 'Agency FB'); //шрифт
А> if myfont = 0 then exit;
А> test := SelectObject(DC, myfont);
А> wglUseFontBitmaps(DC, 32, 96, base);
А> SelectObject(DC, test);
А> DeleteObject(myfont);
А>end;
А>procedure TGLForm.CalcSelectLine(mouse_x, mouse_y: integer; var p1,
А> p2: TPoint3D);
А>var
А> viewport : array [0..3] of GLint; // параметры viewport-a.
А> projection : array [0..15] of GLdouble; // матрица проекции.
А> modelview : array [0..15] of GLdouble; // видовая матрица.
А> vx,vy,vz : GLdouble; // координаты курсора мыши в системе координат viewport-a.
А> wx,wy,wz : GLdouble; // возвращаемые мировые координаты.
А>begin
А> // mouse_x, mouse_y - оконные координаты курсора мыши.
А> // p1, p2 - возвращаемые параметры - концы селектирующего отрезка,
А> // лежащие соответственно на ближней и дальней плоскостях
А> // отсечения.
А> glGetIntegerv(GL_VIEWPORT,@viewport); // узнаём параметры viewport-a.
А> glGetDoublev(GL_PROJECTION_MATRIX,@projection); // узнаём матрицу проекции.
А> glGetDoublev(GL_MODELVIEW_MATRIX,@modelview); // узнаём видовую матрицу.
А> // переводим оконные координаты курсора в систему координат viewport-a.
А> vx := mouse_x;
А> vy := height - mouse_y - 1; // где height - текущая высота окна.
А> // вычисляем ближний конец селектирующего отрезка.
А> vz := -1;
А> gluUnProject(vx, vy, vz, @modelview, @projection, @viewport, wx, wy, wz);
А> p1.x := wx;
А> p1.y := wy;
А> p1.z := wz;
А> // вычисляем дальний конец селектирующего отрезка.
А> vz := 1;
А> gluUnProject(vx, vy, vz, @modelview, @projection, @viewport, wx, wy, wz);
А> p2.x := wx;
А> p2.y := wy;
А> p2.z := wz;
А>end;
А>procedure TGLForm.FormDestroy(Sender: TObject);
А>begin
А> stParams.Free;
А>end;
А>procedure TGLForm.TimerTimer(Sender: TObject);
А>begin
А> AngleX := AngleX + 0.05;
А> If (AngleX >= 360.0) then AngleX := 0.0;
А> If (AngleY >= 360.0) then AngleY := 0.0;
А> InvalidateRect(Handle, nil, False); // перерисовка региона (Windows API)
А>end;
А>procedure TGLForm.FormResize(Sender: TObject);
А>begin
А> glMatrixMode(GL_PROJECTION);
А> glLoadIdentity;
А> gluPerspective(30.0, Width / Height, 1.0, 10.0);
А> glViewport(0, 0, Width, Height);
А> glMatrixMode(GL_MODELVIEW);
А>end;
А>procedure TGLForm.Draw;
А>begin
А>end;
А>procedure TGLForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
А> WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
А>begin
А> if WheelDelta < 0 then
А> Perspective := Perspective - 0.5
А> else
А> Perspective := Perspective + 0.5;
А>end;
А>procedure TGLForm.FormKeyDown(Sender: TObject; var Key: Word;
А> Shift: TShiftState);
А>begin
А> case Key of
А> VK_LEFT : AngleX := AngleX - 0.5;
А> VK_RIGHT: AngleX := AngleX + 0.5;
А> VK_UP : AngleY := AngleY - 0.5;
А> VK_DOWN : AngleY := AngleY + 0.5;
А> end;
А>end;
А>procedure TGLForm.InitForm;
А>begin
А> stParams := TStrings.Create;
А> Perspective := 40.0;
А> AngleX := 0.0;
А> AngleY := 0.0;
А> DC := GetDC(Handle);
А> SetDCPixelFormat;
А> hrc := wglCreateContext(DC);
А> wglMakeCurrent(DC, hrc);
А> InitializeRC;
А> InitText;
А>end;
А>end.
А>
А>вызов в наследниках:
А>А> ...
А>procedure TfmMap.FormCreate(Sender: TObject);
А>begin
А> inherited;
А> InitForm;
А> tMain.Open;
А> SetLength(arPoint, tMain.RecordCount);
А> InitMap;
А> Timer.Enabled := True;
А>end;
А>...
А>
А>Спасибо.
Нет никакой баги. Незнаю как в делфи, но вообще ты рисуешь на DC — device context. Это твое так сказать окно для рисования. Если в делфи реализация методов OpenGL из
Извини. Не законцил. Нельзя т.к.
procedure TGLForm.DrawScene;
begin
// очистка буфера цвета и буфера глубины
glClearColor (0.0, 0.0, 0.0, 0.0); // цвет фона
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
Camera;
// трехмерность
glLoadIdentity;
glTranslatef( 0, 0, -3.0);
glRotatef(30.0, 1.0, 0.0, 0.0);
glRotatef(AngleX, 0.0, 1.0, 0.0); // поворот на угол
glRotatef(AngleY, 0.1, 0.0, 0.0); // поворот на угол
Draw;
SwapBuffers(DC); << -- Это твой девайс - контекст.
end;
Можешь попробовать переключать контекст устройства, но одновременно.... Увы.
Здравствуйте, FunnyRabbit, Вы писали:
FR>Извини. Не законцил. Нельзя т.к.
FR>
FR>procedure TGLForm.DrawScene;
FR>begin
FR> // очистка буфера цвета и буфера глубины
FR> glClearColor (0.0, 0.0, 0.0, 0.0); // цвет фона
FR> glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
FR> Camera;
FR> // трехмерность
FR> glLoadIdentity;
FR> glTranslatef( 0, 0, -3.0);
FR> glRotatef(30.0, 1.0, 0.0, 0.0);
FR> glRotatef(AngleX, 0.0, 1.0, 0.0); // поворот на угол
FR> glRotatef(AngleY, 0.1, 0.0, 0.0); // поворот на угол
FR> Draw;
FR> SwapBuffers(DC); << -- Это твой девайс - контекст.
FR>end;
FR>
FR>Можешь попробовать переключать контекст устройства, но одновременно.... Увы.
а можно здесь немного поподробней, здесь API'шные функции используются, я их не очень часто юзаю
как можно реализовать переключение контекста устройства (пожалуйста без библиотек типа MFC)
можно и не одновременно, устроит вариант когда вторая форма вызывается как модальная, и после работы с ней мы возвращаемся к работе с первой, но как сначала сохранить а потом восстановить рабочие настройки
procedure TGLForm.InitForm;
begin
stParams := TStrings.Create;
Perspective := 40.0;
AngleX := 0.0;
AngleY := 0.0;
DC := GetDC(Handle); <<-- вот тут ты его включаешь
SetDCPixelFormat;
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
InitializeRC;
InitText;
end;
А вот как можно сделать:
procedure TGLForm.InitDC(Handle: HWND) //Прошлый твой InitForm;
begin
stParams := TStrings.Create;
Perspective := 40.0;
AngleX := 0.0;
AngleY := 0.0;
DC := GetDC(Handle);
SetDCPixelFormat;
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
InitializeRC;
InitText;
end;
и как там у тебя
// вызов в наследниках:
...
procedure TfmMap.FormCreate(Sender: TObject);
begin
inherited;
InitDC(Self.Handle) // InitForm;
tMain.Open;
SetLength(arPoint, tMain.RecordCount);
InitMap;
Timer.Enabled := True;
end;
...
где InitDC(Self.Handle) Дескриптор твой формы.
Я бы на твоем месте реализовал (а точнее так и делал раньше) класс в который можно передать HWND любого окна и т.п.
Типа
type
TOpenGLRender = class
.......
hDC: HDC;
hWnd: HWND;
fGLRC: HGLRC;
public
.....
procedure InitDC(hwnd: HWND);
....
end;
А потом:
procedure ....();
var
oglr: TOpenGLRender;
begin
oglr := TOpenGLRender.Create;
oglr.InitDC(Self.Handle);
end;
Не знаю. Может если вставить вместо hwnd 0, то получиться рендерить на рабочем столе?
Have fun!
