[virtustilus]

Работаю над проектом на Delphi, недавно решил прикрутить OpenGL. Для упрощения решил использовать библиотеку dglOpenGL. Всё работает отлично почти до самого конца. Т.е. при закрытии приложения прога вылетает с какой-нибудь ошибкой, обычно в работе с окнами.

Сначала я использовал вывод в дочернее окно TPanel.
Кода в проекте много, даже самого OpenGL, приведу основное:

инициализация:

Код:

  dc:=GetDC(HandleW);
  if not InitOpenGL then begin
     Halt;
  end;

  hrc:=CreateRenderingContext(dc,[opDoubleBuffered],16,16,0,0,0,5);
  ActivateRenderingContext(dc,hrc);

  glClearColor(c_r,c_g,c_b,0.0);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_CULL_FACE);

А при закрытии окна (OnClose):

Код:

  
  DeactivateRenderingContext; //внутри wglMakeCurrent(0, 0);
  DestroyRenderingContext(hrc); //внутри wglDeleteContext(HRC);

также пробовал после этого добавлять вот это:

Код:

  
  ReleaseDC(handleW,dc)
  DeleteDC(dc)

, но они обе завершаются с ошибкой (проверял условиями).

При этом после закрытия окна программа вылетает с различными ошибками модулей работы с окнами.

Далее я подумал, что это проблема делфи и решил сделать отдельный класс, который будет создавать своё дочернее окно в конструкторе:

Код:

  
  window.cbSize := sizeof (window);
  window.style := CS_HREDRAW or CS_VREDRAW;
  window.lpfnWndProc := @WindowProc;
  window.cbClsExtra := 0;
  window.cbWndExtra := 0;
  window.hInstance := HInstance;
  window.hIcon := LoadIcon (0,IDI_APPLICATION);
  window.hCursor := LoadCursor (0,IDC_ARROW);
  window.hbrBackground:=Color_BtnFace+12;
  window.lpszMenuName := nil;
  window.lpszClassName := pchar(s);
  RegisterClassEx(window);

  Mwindow:=CreateWindowEx(WS_EX_NOPARENTNOTIFY,pchar(s),pchar(Name), WS_CHILDWINDOW ,x,y,w,h,parentw,0,Hinstance,nil);

а в деструкторе класса сделал удаление окна:

Код:

DestroyWindow(Mwindow);

Но после первого же закрытия такого окна и работе с другими окнами опять вылетает в каком-либо месте ошибка.

Далее я решил попробовать отключить сам OpenGL (для него я сделал отдельный класс). Сделал константу и наставил условий, которыми отключил все функции OpenGL.
В итоге программа стала работать нормально. Т.е. выходит ошибка удаления самого OpenGL окна.

Ну и как вариант, остается не удалять OpenGL-окно и работать до самого конца, просто скрывая их или показывая, но в конце работы приложения всё равно вывалится ошибка...

Например при попытке показать другое окно, после закрытия этого произошел останов по Int3. Приложил CallStack.

Синим выделена моя процедура, там идет Show другой формы.

Что еще пробовал: отключить DestroyRenderingContext(hrc) - никакой разницы;
создавать окно не Child, а отдельное - такой же результат уничтожения.

Единственное, что срабатывает, так это замена уничтожения окна на скрытие:

Код:

  //DestroyWindow(window1);
  ShowWindow(window1,SW_HIDE);

Тогда всё работает, до закрытия программы, когда эти окна всё-таки будут уничтожены.


Может кто знает, может сталкивался с такой проблемой или хорошо разбирается в работе WINAPI с окнами, что это может быть?

P.S. Если кто-то хочет спросить "зачем WS_EX_NOPARENTNOTIFY?", пишу сразу что без него эффект не меняется...

[angvelem]

Предпочитаю работать с OpenGL используя API. Ну не люблю я эти необоснованные навороты, уроки можно глянуть здесь.

[virtustilus]

Необоснованные навороты - это модуль dglOpenGL?
Я думал, что это может быть из-за него, но функции в этом модуле, как правило, повторяют основные рекомендации и уроки по openGL:

Код:

function CreateRenderingContext(DC: HDC; Options: TRCOptions; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC;
const
  OBJ_MEMDC = 10;
  OBJ_ENHMETADC = 12;
  OBJ_METADC = 4;
  PFD_DOUBLEBUFFER = $00000001;
  PFD_STEREO = $00000002;
  PFD_DRAW_TO_WINDOW = $00000004;
  PFD_DRAW_TO_BITMAP = $00000008;
  PFD_SUPPORT_GDI = $00000010;
  PFD_SUPPORT_OPENGL = $00000020;
  PFD_TYPE_RGBA = 0;
  PFD_MAIN_PLANE = 0;
  PFD_OVERLAY_PLANE = 1;
  PFD_UNDERLAY_PLANE = LongWord(-1);
  MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC];
var
  PFDescriptor: TPixelFormatDescriptor;
  PixelFormat: Integer;
  AType: DWORD;
begin
  if GL_LibHandle = nil then
    InitOpenGL;

  FillChar(PFDescriptor, SizeOf(PFDescriptor), 0);

  with PFDescriptor do
  begin
    nSize := SizeOf(PFDescriptor);
    nVersion := 1;
    dwFlags := PFD_SUPPORT_OPENGL;

    AType := GetObjectType(DC);

    if AType = 0 then
      RaiseLastOSError;

    if AType in MemoryDCs then
      dwFlags := dwFlags or PFD_DRAW_TO_BITMAP
    else
      dwFlags := dwFlags or PFD_DRAW_TO_WINDOW;

    if opDoubleBuffered in Options then
      dwFlags := dwFlags or PFD_DOUBLEBUFFER;

    if opGDI in Options then
      dwFlags := dwFlags or PFD_SUPPORT_GDI;

    if opStereo in Options then
      dwFlags := dwFlags or PFD_STEREO;

    iPixelType := PFD_TYPE_RGBA;
    cColorBits := ColorBits;
    cDepthBits := zBits;
    cStencilBits := StencilBits;
    cAccumBits := AccumBits;
    cAuxBuffers := AuxBuffers;

    if Layer = 0 then
      iLayerType := PFD_MAIN_PLANE
    else
    if Layer > 0 then
      iLayerType := PFD_OVERLAY_PLANE
    else
      iLayerType := Byte(PFD_UNDERLAY_PLANE);
  end;

  PixelFormat := ChoosePixelFormat(DC, @PFDescriptor);

  if PixelFormat = 0 then
    RaiseLastOSError;

  if GetPixelFormat(DC) <> PixelFormat then
    if not SetPixelFormat(DC, PixelFormat, @PFDescriptor) then
      RaiseLastOSError;

  DescribePixelFormat(DC, PixelFormat, SizeOf(PFDescriptor), PFDescriptor);

  Result := wglCreateContext(DC);

  if Result = 0 then
    RaiseLastOSError
  else
    LastPixelFormat := 0;
end;

Код:

procedure ActivateRenderingContext(DC: HDC; RC: HGLRC; loadext: boolean = true);
begin
  Assert((DC <> 0), 'DC must not be 0');
  Assert((RC <> 0), 'RC must not be 0');

  wglMakeCurrent(DC, RC);

  {$ifdef DGL_TINY_HEADER}
  ReadCoreVersion;
  {$else}
  ReadImplementationProperties;

  if (loadext) then
    ReadExtensions;
  {$endif}
end;

Код:

procedure DeactivateRenderingContext;
begin
  wglMakeCurrent(0, 0);
end;

Код:

procedure DestroyRenderingContext(RC: HGLRC);
begin
  wglDeleteContext(RC);
end;

Кто на Delphi 7 делал, у вас нормально всё работает?

[angvelem]

По приведённым выше процедурам и на API у меня в 7-ке никогда проблем не было.

[Rat]

А видяха случаем не ATI ? С ней такие косяки случаются. Точнее с дровами. Поставте последние.

[virtustilus]

Видяхи разные пробовал и Intel встроенный в чипсет и ATI и NVidia... На них место возникновения ошибки немного отличается. Допустим сейчас столкнулся с проблемой, что на ATI и NVidia второе такое окно вообще создаваться не хочет. Ищу решение...

[angvelem]

А чего искать, не используй корявые компоненты, и как говорил ранее, учись писать сам.

[virtustilus]

Да убрал этот модуль, использую стандартный модуль OpenGL. Много раз все переписывал, пробовал по-разному с окнами работать (и создавать и удалять через WinAPI). Сейчас все работает, но ошибка остается. Я временно сделал вместо удаления окон скрытие. При закрытии программы происходит удаление окон и вылетает ошибка. Если только закоментировать вызовы самих функций openGL, то ошибка пропадает.

Код:

procedure TGLScene.SetDCPixelFormat(dc: HDC);
var
  pfd: TPixelFormatDescriptor;
  nPixelFormat: Integer;
begin
  FillChar (pfd, SizeOf(pfd), 0); //заполняем структуру pfd нулями 
  //также ты можешь добавить свои элементы как в обычную запись, 
  //например, pfd.dwFlags := PFD_DOUBLEBUFFER
  pfd.dwFlags := PFD_DOUBLEBUFFER;
  nPixelFormat := ChoosePixelFormat (dc, @pfd); //определяем оптимальный номер формата
  SetPixelFormat (dc, nPixelFormat, @pfd); //устанавливаем формат
end; 

Создание окна:

Код:

  dc:=GetDC(HandleW);
  SetDCPixelFormat(dc);
  hrc:=wglCreateContext(dc);
  wglMakeCurrent(DC, HRC);

      glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);

      base0:=glGenLists(96);
      font:=CreateFont(-12 //высота фонта
            ,0 //ширина фонта
            ,0 //угол отношения
            ,0 //угол наклона
            ,FW_NORMAL  //FW_DONTCARE - 0, FW_NORMAL - 400, FW_BOLD - 700, и FW_BLACK - 900.
            ,0        // Курсив
            ,0        // Подчеркивание
            ,0        // Перечеркивание
            ,ANSI_CHARSET,      // Идентификатор набора символов
            OUT_TT_PRECIS,      // Точность вывода
            CLIP_DEFAULT_PRECIS,    // Точность отсечения
            ANTIALIASED_QUALITY,    // Качество вывода
            FF_DONTCARE or DEFAULT_PITCH,  // Семейство и шаг
            'Arial');      // Имя шрифта
      SelectObject(DC, font);    // Выбрать шрифт, созданный нами ( НОВОЕ )
      wglUseFontBitmaps(DC, 32, 96, base0); // Построить 96 символов начиная с пробела ( НОВОЕ )

Код:

  glClearColor(c_r,c_g,c_b,0.0);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_CULL_FACE);

Каждый рендер начинается с

Код:

  
  wglMakeCurrent(DC, HRC);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  
     glViewport(x,y,w,h);
     glMatrixMode(GL_PROJECTION);
     glLoadIdentity;
     gluPerspective(perpective_angle,w/h,NearClipping,FarClipping);
     glMatrixMode(GL_MODELVIEW);
     glLoadIdentity;

  glDisable(GL_CULL_FACE);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable (GL_LINE_SMOOTH);
  glEnable(GL_POLYGON_SMOOTH);
    glEnable(GL_MULTISAMPLE_ARB);

    glShadeModel(GL_SMOOTH);

    glEnable(GL_DEPTH_TEST);
    glDepthFunc(GL_LEQUAL);
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);

    gluLookAt(cx,cy,cz,ccx,ccy,ccz,ax,ay,az);

      glEnable(GL_LIGHTING);
      glLightfv(GL_LIGHT1, GL_AMBIENT, @LightAmbient);
      glLightfv(GL_LIGHT1, GL_DIFFUSE, @LightDiffuse);
      glLightfv(GL_LIGHT1, GL_POSITION, @LightPosition);
      glEnable(GL_LIGHT1);

glPolygonMode (GL_FRONT_AND_BACK, GL_FILL);

Удаление окна:

Код:

  glDeleteLists(base3, 96);
  glDeleteLists(base2, 96);
  glDeleteLists(base1, 96);
  glDeleteLists(base0, 96);

  wglMakeCurrent(0, 0);

  wglDeleteContext(hrc);


  if ReleaseDC(handleW,dc)<>0 then begin
    ShowMessage('Ошибка ReleaseDC(handleW,dc)');
  end;

Уже и через модуль проверки утечек памяти прогонял свой код, вроде все ок. Помогает только выключить вызов всех функций openGL и тогда все работает отлично )) А так, ошибка при удалении окна в Windows.DestroyWindow:

Код:

procedure TWinControl.DestroyWindowHandle;
begin
  Include(FControlState, csDestroyingHandle);
  try
    if not Windows.DestroyWindow(FHandle) then
      RaiseLastOSError;
  finally
    Exclude(FControlState, csDestroyingHandle);
  end;
  FHandle := 0;
end;

[angvelem]

Скинь проект, посмотрю.