View Issue Details

IDProjectCategoryView StatusLast Update
0015589LazarusOtherpublic2018-11-06 16:13
ReporterAndreas SchneiderAssigned ToMattias Gaertner 
PrioritynormalSeverityfeatureReproducibilityalways
Status resolvedResolutionfixed 
Product Version0.9.29 (SVN)Product Build 
Target VersionFixed in Version 
Summary0015589: TOpenGLControl doesn't support QT
DescriptionTOpenGLControl currently doesn't support the QT widgetset.
As far as I can see QT should already provide a QGLContext (which apparently isn't integrated into qt4pas yet).
TagsNo tags attached.
Fixed in Revision
LazTarget-
WidgetsetQT
Attached Files
  • glqtcontext (1,643 bytes)
    Index: components/opengl/glqtcontext.pas
    ===================================================================
    --- components/opengl/glqtcontext.pas	(revision 41572)
    +++ components/opengl/glqtcontext.pas	(working copy)
    @@ -65,7 +65,7 @@
     function LOpenGLCreateContext(AWinControl: TWinControl;
                  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
                  DoubleBuffered, RGBA: boolean;
    -             const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
    +             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
                  const AParams: TCreateParams): HWND;
     procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
     function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
    @@ -142,7 +142,8 @@
     
     function TQtGLWidget.GetGLXDrawable: GLXDrawable;
     begin
    -  Result:=0; {$ERROR ToDo: get GLXDrawable}
    +  //Result:=0; {ERROR ToDo: get GLXDrawable}
    +  Result:= QWidget_winId(self.Widget);
     end;
     
     procedure LOpenGLViewport(Left, Top, Width, Height: integer);
    @@ -178,10 +179,10 @@
     end;
     
     function LOpenGLCreateContext(AWinControl: TWinControl;
    -  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
    -  DoubleBuffered, RGBA: boolean;
    -  const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
    -  const AParams: TCreateParams): HWND;
    +             WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
    +             DoubleBuffered, RGBA: boolean;
    +             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
    +             const AParams: TCreateParams): HWND;
     var
       AttrList: PInteger;
       NewQtWidget: TQtGLWidget;
    
    glqtcontext (1,643 bytes)
  • flickering1.png (301,392 bytes)
  • glqtcontext_v2 (2,081 bytes)
    Index: components/opengl/glqtcontext.pas
    ===================================================================
    --- components/opengl/glqtcontext.pas	(revision 41784)
    +++ components/opengl/glqtcontext.pas	(working copy)
    @@ -65,7 +65,7 @@
     function LOpenGLCreateContext(AWinControl: TWinControl;
                  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
                  DoubleBuffered, RGBA: boolean;
    -             const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
    +             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
                  const AParams: TCreateParams): HWND;
     procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
     function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
    @@ -142,7 +142,7 @@
     
     function TQtGLWidget.GetGLXDrawable: GLXDrawable;
     begin
    -  Result:=0; {$ERROR ToDo: get GLXDrawable}
    +  Result:= QWidget_winId(self.Widget);
     end;
     
     procedure LOpenGLViewport(Left, Top, Width, Height: integer);
    @@ -178,10 +178,10 @@
     end;
     
     function LOpenGLCreateContext(AWinControl: TWinControl;
    -  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
    -  DoubleBuffered, RGBA: boolean;
    -  const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
    -  const AParams: TCreateParams): HWND;
    +             WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
    +             DoubleBuffered, RGBA: boolean;
    +             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
    +             const AParams: TCreateParams): HWND;
     var
       AttrList: PInteger;
       NewQtWidget: TQtGLWidget;
    @@ -191,6 +191,11 @@
       AttrList:=CreateOpenGLContextAttrList(DoubleBuffered,RGBA);
       try
         NewQtWidget:=TQtGLWidget.Create(AWinControl,AParams);
    +
    +    NewQtWidget.setAttribute(QtWA_PaintOnScreen);
    +    NewQtWidget.setAttribute(QtWA_OpaquePaintEvent);
    +    NewQtWidget.setAttribute(QtWA_NoSystemBackground);
    +
         NewQtWidget.xdisplay := QX11Info_display;
         NewQtWidget.visual:=glXChooseVisual(NewQtWidget.xdisplay,
           DefaultScreen(NewQtWidget.xdisplay), @attrList[0]);
    
    glqtcontext_v2 (2,081 bytes)
  • glqtcontext.pas (7,811 bytes)
    {
     *****************************************************************************
     *                                                                           *
     *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
     *  for details about the copyright.                                         *
     *                                                                           *
     *  This program is distributed in the hope that it will be useful,          *
     *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
     *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
     *                                                                           *
     *****************************************************************************
    
      Author: Mattias Gaertner
    
    }
    unit GLQTContext;
    
    {$mode objfpc}{$H+}
    {$LinkLib GL}
    {$PACKRECORDS C}
    
    interface
    
    uses
      Classes, SysUtils, Controls, LCLProc, LCLType, X, XUtil, XLib, gl,
      InterfaceBase,
      WSLCLClasses,
      // Bindings
      qt4,
      qtwidgets, qtobjects, qtproc, qtint,
      QtWSControls;
    
    // gdkgl
    
    const
    // enum _QT_GL_CONFIGS
      QT_GL_NONE                           = 0;
      QT_GL_USE_GL                         = 1;
      QT_GL_BUFFER_SIZE                    = 2;
      QT_GL_LEVEL                          = 3;
      QT_GL_RGBA                           = 4;
      QT_GL_DOUBLEBUFFER                   = 5;
      QT_GL_STEREO                         = 6;
      QT_GL_AUX_BUFFERS                    = 7;
      QT_GL_RED_SIZE                       = 8;
      QT_GL_GREEN_SIZE                     = 9;
      QT_GL_BLUE_SIZE                      = 10;
      QT_GL_ALPHA_SIZE                     = 11;
      QT_GL_DEPTH_SIZE                     = 12;
      QT_GL_STENCIL_SIZE                   = 13;
      QT_GL_ACCUM_RED_SIZE                 = 14;
      QT_GL_ACCUM_GREEN_SIZE               = 15;
      QT_GL_ACCUM_BLUE_SIZE                = 16;
      QT_GL_ACCUM_ALPHA_SIZE               = 17;
    
      // GLX_EXT_visual_info extension
      QT_GL_X_VISUAL_TYPE_EXT              = $22;
      QT_GL_TRANSPARENT_TYPE_EXT           = $23;
      QT_GL_TRANSPARENT_INDEX_VALUE_EXT    = $24;
      QT_GL_TRANSPARENT_RED_VALUE_EXT      = $25;
      QT_GL_TRANSPARENT_GREEN_VALUE_EXT    = $26;
      QT_GL_TRANSPARENT_BLUE_VALUE_EXT     = $27;
      QT_GL_TRANSPARENT_ALPHA_VALUE_EXT    = $28;
    
    type
      TGLXContext = pointer;
    
    procedure LOpenGLViewport(Left, Top, Width, Height: integer);
    procedure LOpenGLSwapBuffers(Handle: HWND);
    function LOpenGLMakeCurrent(Handle: HWND): boolean;
    function LOpenGLCreateContext(AWinControl: TWinControl;
                 WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
                 DoubleBuffered, RGBA: boolean;
                 const AParams: TCreateParams): HWND;
    procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
    function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
                                         RGBA: boolean): PInteger;
    
    implementation
    
    type
      //PGLXPixmap = ^GLXPixmap;
      TGLXPixmap = TXID;
    
      //PGLXDrawable = ^GLXDrawable;
      TGLXDrawable = TXID;
    
    { GLX 1.0 functions. }
    
    function glXChooseVisual(dpy:PDisplay; screen:longint; attrib_list:Plongint):PXVisualInfo;cdecl;external;
    procedure glXCopyContext(dpy:PDisplay; src:TGLXContext; dst:TGLXContext; mask: cardinal);cdecl;external;
    function glXCreateContext(dpy:PDisplay; vis:PXVisualInfo; share_list:TGLXContext; direct:TBool):TGLXContext;cdecl;external;
    function glXCreateGLXPixmap(dpy:PDisplay; vis:PXVisualInfo; pixmap:TPixmap):TGLXPixmap;cdecl;external;
    procedure glXDestroyContext(dpy:PDisplay; ctx:TGLXContext);cdecl;external;
    procedure glXDestroyGLXPixmap(dpy:PDisplay; pix:TGLXPixmap);cdecl;external;
    function glXGetConfig(dpy:PDisplay; vis:PXVisualInfo; attrib:longint; value:Plongint):longint;cdecl;external;
    function glXGetCurrentContext:TGLXContext;cdecl;external;
    function glXGetCurrentDrawable:TGLXDrawable;cdecl;external;
    function glXIsDirect(dpy:PDisplay; ctx:TGLXContext):TBool;cdecl;external;
    function glXMakeCurrent(dpy:PDisplay; drawable:TGLXDrawable; ctx:TGLXContext):TBool;cdecl;external;
    function glXQueryExtension(dpy:PDisplay; error_base:Plongint; event_base:Plongint):TBool;cdecl;external;
    function glXQueryVersion(dpy:PDisplay; major:Plongint; minor:Plongint):TBool;cdecl;external;
    procedure glXSwapBuffers(dpy:PDisplay; drawable:TGLXDrawable);cdecl;external;
    procedure glXUseXFont(font:TFont; first:longint; count:longint; list_base:longint);cdecl;external;
    procedure glXWaitGL;cdecl;external;
    procedure glXWaitX;cdecl;external;
    
    function XVisualAsString(AVisual: PVisual): string;
    begin
      if AVisual=nil then begin
        Result:='nil';
      end else begin
        Result:=''
            +' bits_per_rgb='+dbgs(AVisual^.bits_per_rgb)
            +' red_mask='+hexstr(AVisual^.red_mask,8)
            +' green_mask='+hexstr(AVisual^.green_mask,8)
            +' blue_mask='+hexstr(AVisual^.blue_mask,8)
            +' map_entries='+dbgs(AVisual^.map_entries)
            +'';
      end;
    end;
    
    function XDisplayAsString(ADisplay: PDisplay): string;
    begin
      if ADisplay=nil then begin
        Result:='nil';
      end else begin
        Result:=''
            +'';
      end;
    end;
    
    type
    
      { TQtGLWidget }
    
      TQtGLWidget = class(TQtWidget)
      public
        xdisplay: PDisplay;
        visual: PXVisualInfo;
        glxcontext: TGLXContext;
        glxdrawable: TGLXDrawable;
        ref_count: integer;
      end;
    
    { TQtGLWidget }
    
    procedure LOpenGLViewport(Left, Top, Width, Height: integer);
    begin
      glViewport(Left,Top,Width,Height);
    end;
    
    procedure LOpenGLSwapBuffers(Handle: HWND);
    var
      Widget: TQtGLWidget;
    begin
      if Handle=0 then
        RaiseGDBException('LOpenGLSwapBuffers Handle=0');
    
      Widget:=TQtGLWidget(Handle);
      glXSwapBuffers(Widget.xdisplay,
                     Widget.glxdrawable);
    end;
    
    function LOpenGLMakeCurrent(Handle: HWND): boolean;
    var
      Widget: TQtGLWidget;
    begin
      if Handle=0 then
        RaiseGDBException('LOpenGLSwapBuffers Handle=0');
      Result:=false;
    
      Widget:=TQtGLWidget(Handle);
      Result:=boolean(glXMakeCurrent(Widget.xdisplay,
                                     Widget.glxdrawable,
                                     Widget.glxcontext));
    end;
    
    function LOpenGLCreateContext(AWinControl: TWinControl;
      WSPrivate: TWSPrivateClass; SharedControl: TWinControl; DoubleBuffered,
      RGBA: boolean; const AParams: TCreateParams): HWND;
    var
      AttrList: PInteger;
      NewQtWidget: TQtGLWidget;
      direct: TBool;
    begin
      if WSPrivate=nil then ;
      AttrList:=CreateOpenGLContextAttrList(DoubleBuffered,RGBA);
      try
        NewQtWidget:=TQtGLWidget.Create(AWinControl,AParams);
        NewQtWidget.xdisplay := QX11Info_display;
        NewQtWidget.visual := glXChooseVisual(NewQtWidget.xdisplay,
          DefaultScreen(NewQtWidget.xdisplay), @attrList[0]);
        direct := 0;
        NewQtWidget.glxcontext := glXCreateContext(NewQtWidget.xdisplay,
                                                   NewQtWidget.visual, nil, direct);
    
        NewQtWidget.glxdrawable := QWidget_winId(NewQtWidget.Widget);
        NewQtWidget.ref_count := 1;
    
        NewQtWidget.AttachEvents;
    
        Result:=HWND(PtrUInt(Pointer(NewQtWidget)));
      finally
        FreeMem(AttrList);
      end;
    end;
    
    procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
    begin
      if not AWinControl.HandleAllocated then exit;
      // nothing to do
    end;
    
    function CreateOpenGLContextAttrList(DoubleBuffered: boolean; RGBA: boolean
      ): PInteger;
    var
      p: integer;
    
      procedure Add(i: integer);
      begin
        if Result<>nil then
          Result[p]:=i;
        inc(p);
      end;
    
      procedure CreateList;
      begin
        if DoubleBuffered then
          Add(QT_GL_DOUBLEBUFFER);
        if RGBA then
          Add(QT_GL_RGBA);
        Add(QT_GL_RED_SIZE);  Add(1);
        Add(QT_GL_GREEN_SIZE);  Add(1);
        Add(QT_GL_BLUE_SIZE);  Add(1);
        Add(QT_GL_DEPTH_SIZE);  Add(1);
        Add(QT_GL_STENCIL_SIZE); Add(1);
        Add(QT_GL_None);
      end;
    
    begin
      Result:=nil;
      p:=0;
      CreateList;
      GetMem(Result,SizeOf(integer)*p);
      p:=0;
      CreateList;
    end;
    
    end.
    
    
    glqtcontext.pas (7,811 bytes)

Relationships

has duplicate 0018850 closedJuha Manninen Lazarus TOpenGLControl in package LazOpenGLContext has no QT backend 
has duplicate 0023263 resolvedMaxim Ganetsky Packages Error while installing LazOpenGlContext 0.0.1 package 
related to 0027066 closedMattias Gaertner Patches compiling lazopenGlContext package with QT 

Activities

Zeljan Rikalo

2010-01-25 18:51

developer   ~0033896

Setted up as post 1.2 since it depends on qt bindings.

Andrey Zubarev

2011-12-28 19:24

reporter   ~0055329

When do you plan to implement OpenGL support in qt4pas?

Zeljan Rikalo

2011-12-28 22:49

developer   ~0055331

When I have C bindings. Ask Den on Qt mailing list.

Zeljan Rikalo

2012-01-03 21:38

developer   ~0055459

I'll try to implement it, but not inside qt45.pas, it will be different unit which will dynamically load opengl part (from new libQtOpenGL4Pas.so).

Andrey Zubarev

2012-01-13 22:07

reporter   ~0055733

Because of the response of Den
>>I have no such plans currently.
You made ​​a good decision

Дмитрий

2013-05-20 21:49

reporter   ~0067790

OpenGL support in qt has not appeared((
In this regard work is underway?

Дмитрий

2013-06-06 12:50

reporter   ~0068092

I beg you, who can please help with this problem! It really becomes a real problem. GTK2 losing relevance, qt becomes a priority, and support OpenGL context under qt not.

Zeljan Rikalo

2013-06-06 19:02

developer   ~0068099

Someone who will have enough spare time to fix that.

Andrey Zubarev

2013-06-07 11:47

reporter   ~0068112

With this patch TOpenGLControl starts work to qt. But the OpenGL image is overwritten form background, and can be seen only in the moment of resizing the form. Zeljan, please tell how can fix it?

Andrey Zubarev

2013-06-07 11:47

reporter  

glqtcontext (1,643 bytes)
Index: components/opengl/glqtcontext.pas
===================================================================
--- components/opengl/glqtcontext.pas	(revision 41572)
+++ components/opengl/glqtcontext.pas	(working copy)
@@ -65,7 +65,7 @@
 function LOpenGLCreateContext(AWinControl: TWinControl;
              WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
              DoubleBuffered, RGBA: boolean;
-             const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
+             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
              const AParams: TCreateParams): HWND;
 procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
 function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
@@ -142,7 +142,8 @@
 
 function TQtGLWidget.GetGLXDrawable: GLXDrawable;
 begin
-  Result:=0; {$ERROR ToDo: get GLXDrawable}
+  //Result:=0; {ERROR ToDo: get GLXDrawable}
+  Result:= QWidget_winId(self.Widget);
 end;
 
 procedure LOpenGLViewport(Left, Top, Width, Height: integer);
@@ -178,10 +179,10 @@
 end;
 
 function LOpenGLCreateContext(AWinControl: TWinControl;
-  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
-  DoubleBuffered, RGBA: boolean;
-  const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
-  const AParams: TCreateParams): HWND;
+             WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
+             DoubleBuffered, RGBA: boolean;
+             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
+             const AParams: TCreateParams): HWND;
 var
   AttrList: PInteger;
   NewQtWidget: TQtGLWidget;
glqtcontext (1,643 bytes)

Zeljan Rikalo

2013-06-08 13:21

developer   ~0068127

@Andrey, what do you mean by "starts work to qt" ? You're missing QtOpenGL bindings to get it work.

Andrey Zubarev

2013-06-08 17:26

reporter   ~0068131

Application is compiled and works, the picture is displayed, but background is overwritten. Of course it's not real qt, it x11 over qt, but can possible though so get to work, without going into the qt?

Zeljan Rikalo

2013-06-08 19:54

developer   ~0068134

Well it is if you dont use anything except native handle, and if you block qt paintings over that widget.

Andrey Zubarev

2013-06-08 20:24

reporter   ~0068135

There is a simple way to prevent qt paintings on OpenGl widget?

Zeljan Rikalo

2013-06-08 22:17

developer   ~0068138

Yes, catch QEventPaint and set Result to true, so qt won't paint anything (override TQtWidget.EventFilter).

Andrey Zubarev

2013-06-09 11:31

reporter   ~0068145

>>catch QEventPaint and set Result to true
No, it does not work. qt rendering still works

Zeljan Rikalo

2013-06-10 14:07

developer   ~0068188

Not here. if you override EventFilter and set Result := True in QEventPaint then qt won't draw that widget.

Andrey Zubarev

2013-06-12 22:39

reporter   ~0068260

but where? I did so:

function TQtGLWidget.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
begin
  case QEvent_type(Event) of
  QEventPaint:
              begin
                   result:=true;
              end
          else
              Result := inherited EventFilter(Sender, Event);
  end;
end;

Zeljan Rikalo

2013-06-13 07:54

developer   ~0068268

That's correct, but where's implementation of TQtGLWidget ?
You overrided eventFilter() ?

Andrey Zubarev

2013-06-13 08:27

reporter   ~0068270

Last edited: 2013-06-13 08:34

View 2 revisions

>>That's correct, but where's implementation of TQtGLWidget ?
in GLQTContext.pas:

  TQtGLWidget = class(TQtWidget)
  public
    xdisplay: PDisplay;
    visual: PXVisualInfo;
    glxcontext: TGLXContext;
    ref_count: integer;
    function GetGLXDrawable: GLXDrawable;
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
  end;
function TQtGLWidget.GetGLXDrawable: GLXDrawable;
begin
  //Result:=0; {ERROR ToDo: get GLXDrawable}
  Result:= QWidget_winId(self.Widget);
end;
function TQtGLWidget.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
 begin
   case QEvent_type(Event) of
   QEventPaint:
               begin
                    result:=true;
               end
           else
               Result := inherited EventFilter(Sender, Event);
   end;
 end;
there is still a great flickering, look flickering.png - half filled with OpenGL, the other half of the background
Update:
Also has a strange artifact visible under tab on TPageControl

Andrey Zubarev

2013-06-13 08:28

reporter  

flickering1.png (301,392 bytes)

Andrey Zubarev

2013-06-21 23:04

reporter  

glqtcontext_v2 (2,081 bytes)
Index: components/opengl/glqtcontext.pas
===================================================================
--- components/opengl/glqtcontext.pas	(revision 41784)
+++ components/opengl/glqtcontext.pas	(working copy)
@@ -65,7 +65,7 @@
 function LOpenGLCreateContext(AWinControl: TWinControl;
              WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
              DoubleBuffered, RGBA: boolean;
-             const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
+             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
              const AParams: TCreateParams): HWND;
 procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
 function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
@@ -142,7 +142,7 @@
 
 function TQtGLWidget.GetGLXDrawable: GLXDrawable;
 begin
-  Result:=0; {$ERROR ToDo: get GLXDrawable}
+  Result:= QWidget_winId(self.Widget);
 end;
 
 procedure LOpenGLViewport(Left, Top, Width, Height: integer);
@@ -178,10 +178,10 @@
 end;
 
 function LOpenGLCreateContext(AWinControl: TWinControl;
-  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
-  DoubleBuffered, RGBA: boolean;
-  const MultiSampling, AlphaBits, DepthBits, StencilBits: Cardinal;
-  const AParams: TCreateParams): HWND;
+             WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
+             DoubleBuffered, RGBA: boolean;
+             const MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
+             const AParams: TCreateParams): HWND;
 var
   AttrList: PInteger;
   NewQtWidget: TQtGLWidget;
@@ -191,6 +191,11 @@
   AttrList:=CreateOpenGLContextAttrList(DoubleBuffered,RGBA);
   try
     NewQtWidget:=TQtGLWidget.Create(AWinControl,AParams);
+
+    NewQtWidget.setAttribute(QtWA_PaintOnScreen);
+    NewQtWidget.setAttribute(QtWA_OpaquePaintEvent);
+    NewQtWidget.setAttribute(QtWA_NoSystemBackground);
+
     NewQtWidget.xdisplay := QX11Info_display;
     NewQtWidget.visual:=glXChooseVisual(NewQtWidget.xdisplay,
       DefaultScreen(NewQtWidget.xdisplay), @attrList[0]);
glqtcontext_v2 (2,081 bytes)

Andrey Zubarev

2013-06-21 23:06

reporter   ~0068425

Last edited: 2013-06-21 23:08

View 2 revisions

Flickering fixed, look glqtcontext_v2 patch. Remained only artifacts on the border controls (under tab on TPageControl on screenshot), but apparently this is not correctable, because painting is not by means of qt.

Zeljan Rikalo

2013-06-22 15:57

developer   ~0068434

Maybe you should try to play with QWidget::setAutoFillBackground(False/True) also.
That overrided eventfilter looks ok but try to add QEvent_accept(Event) also after/before Result := True.

Andrey Zubarev

2013-06-22 23:19

reporter   ~0068444

I tried it, it has no effect.

Affects only:
NewQtWidget.setAttribute (QtWA_PaintOnScreen);
NewQtWidget.setAttribute (QtWA_NoSystemBackground);

If you do painting on a timer, it's a bad decision. But I need a repaint only when the user interacts, then it works well

yogo1212

2014-01-13 21:07

reporter  

glqtcontext.pas (7,811 bytes)
{
 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

  Author: Mattias Gaertner

}
unit GLQTContext;

{$mode objfpc}{$H+}
{$LinkLib GL}
{$PACKRECORDS C}

interface

uses
  Classes, SysUtils, Controls, LCLProc, LCLType, X, XUtil, XLib, gl,
  InterfaceBase,
  WSLCLClasses,
  // Bindings
  qt4,
  qtwidgets, qtobjects, qtproc, qtint,
  QtWSControls;

// gdkgl

const
// enum _QT_GL_CONFIGS
  QT_GL_NONE                           = 0;
  QT_GL_USE_GL                         = 1;
  QT_GL_BUFFER_SIZE                    = 2;
  QT_GL_LEVEL                          = 3;
  QT_GL_RGBA                           = 4;
  QT_GL_DOUBLEBUFFER                   = 5;
  QT_GL_STEREO                         = 6;
  QT_GL_AUX_BUFFERS                    = 7;
  QT_GL_RED_SIZE                       = 8;
  QT_GL_GREEN_SIZE                     = 9;
  QT_GL_BLUE_SIZE                      = 10;
  QT_GL_ALPHA_SIZE                     = 11;
  QT_GL_DEPTH_SIZE                     = 12;
  QT_GL_STENCIL_SIZE                   = 13;
  QT_GL_ACCUM_RED_SIZE                 = 14;
  QT_GL_ACCUM_GREEN_SIZE               = 15;
  QT_GL_ACCUM_BLUE_SIZE                = 16;
  QT_GL_ACCUM_ALPHA_SIZE               = 17;

  // GLX_EXT_visual_info extension
  QT_GL_X_VISUAL_TYPE_EXT              = $22;
  QT_GL_TRANSPARENT_TYPE_EXT           = $23;
  QT_GL_TRANSPARENT_INDEX_VALUE_EXT    = $24;
  QT_GL_TRANSPARENT_RED_VALUE_EXT      = $25;
  QT_GL_TRANSPARENT_GREEN_VALUE_EXT    = $26;
  QT_GL_TRANSPARENT_BLUE_VALUE_EXT     = $27;
  QT_GL_TRANSPARENT_ALPHA_VALUE_EXT    = $28;

type
  TGLXContext = pointer;

procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLCreateContext(AWinControl: TWinControl;
             WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
             DoubleBuffered, RGBA: boolean;
             const AParams: TCreateParams): HWND;
procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
                                     RGBA: boolean): PInteger;

implementation

type
  //PGLXPixmap = ^GLXPixmap;
  TGLXPixmap = TXID;

  //PGLXDrawable = ^GLXDrawable;
  TGLXDrawable = TXID;

{ GLX 1.0 functions. }

function glXChooseVisual(dpy:PDisplay; screen:longint; attrib_list:Plongint):PXVisualInfo;cdecl;external;
procedure glXCopyContext(dpy:PDisplay; src:TGLXContext; dst:TGLXContext; mask: cardinal);cdecl;external;
function glXCreateContext(dpy:PDisplay; vis:PXVisualInfo; share_list:TGLXContext; direct:TBool):TGLXContext;cdecl;external;
function glXCreateGLXPixmap(dpy:PDisplay; vis:PXVisualInfo; pixmap:TPixmap):TGLXPixmap;cdecl;external;
procedure glXDestroyContext(dpy:PDisplay; ctx:TGLXContext);cdecl;external;
procedure glXDestroyGLXPixmap(dpy:PDisplay; pix:TGLXPixmap);cdecl;external;
function glXGetConfig(dpy:PDisplay; vis:PXVisualInfo; attrib:longint; value:Plongint):longint;cdecl;external;
function glXGetCurrentContext:TGLXContext;cdecl;external;
function glXGetCurrentDrawable:TGLXDrawable;cdecl;external;
function glXIsDirect(dpy:PDisplay; ctx:TGLXContext):TBool;cdecl;external;
function glXMakeCurrent(dpy:PDisplay; drawable:TGLXDrawable; ctx:TGLXContext):TBool;cdecl;external;
function glXQueryExtension(dpy:PDisplay; error_base:Plongint; event_base:Plongint):TBool;cdecl;external;
function glXQueryVersion(dpy:PDisplay; major:Plongint; minor:Plongint):TBool;cdecl;external;
procedure glXSwapBuffers(dpy:PDisplay; drawable:TGLXDrawable);cdecl;external;
procedure glXUseXFont(font:TFont; first:longint; count:longint; list_base:longint);cdecl;external;
procedure glXWaitGL;cdecl;external;
procedure glXWaitX;cdecl;external;

function XVisualAsString(AVisual: PVisual): string;
begin
  if AVisual=nil then begin
    Result:='nil';
  end else begin
    Result:=''
        +' bits_per_rgb='+dbgs(AVisual^.bits_per_rgb)
        +' red_mask='+hexstr(AVisual^.red_mask,8)
        +' green_mask='+hexstr(AVisual^.green_mask,8)
        +' blue_mask='+hexstr(AVisual^.blue_mask,8)
        +' map_entries='+dbgs(AVisual^.map_entries)
        +'';
  end;
end;

function XDisplayAsString(ADisplay: PDisplay): string;
begin
  if ADisplay=nil then begin
    Result:='nil';
  end else begin
    Result:=''
        +'';
  end;
end;

type

  { TQtGLWidget }

  TQtGLWidget = class(TQtWidget)
  public
    xdisplay: PDisplay;
    visual: PXVisualInfo;
    glxcontext: TGLXContext;
    glxdrawable: TGLXDrawable;
    ref_count: integer;
  end;

{ TQtGLWidget }

procedure LOpenGLViewport(Left, Top, Width, Height: integer);
begin
  glViewport(Left,Top,Width,Height);
end;

procedure LOpenGLSwapBuffers(Handle: HWND);
var
  Widget: TQtGLWidget;
begin
  if Handle=0 then
    RaiseGDBException('LOpenGLSwapBuffers Handle=0');

  Widget:=TQtGLWidget(Handle);
  glXSwapBuffers(Widget.xdisplay,
                 Widget.glxdrawable);
end;

function LOpenGLMakeCurrent(Handle: HWND): boolean;
var
  Widget: TQtGLWidget;
begin
  if Handle=0 then
    RaiseGDBException('LOpenGLSwapBuffers Handle=0');
  Result:=false;

  Widget:=TQtGLWidget(Handle);
  Result:=boolean(glXMakeCurrent(Widget.xdisplay,
                                 Widget.glxdrawable,
                                 Widget.glxcontext));
end;

function LOpenGLCreateContext(AWinControl: TWinControl;
  WSPrivate: TWSPrivateClass; SharedControl: TWinControl; DoubleBuffered,
  RGBA: boolean; const AParams: TCreateParams): HWND;
var
  AttrList: PInteger;
  NewQtWidget: TQtGLWidget;
  direct: TBool;
begin
  if WSPrivate=nil then ;
  AttrList:=CreateOpenGLContextAttrList(DoubleBuffered,RGBA);
  try
    NewQtWidget:=TQtGLWidget.Create(AWinControl,AParams);
    NewQtWidget.xdisplay := QX11Info_display;
    NewQtWidget.visual := glXChooseVisual(NewQtWidget.xdisplay,
      DefaultScreen(NewQtWidget.xdisplay), @attrList[0]);
    direct := 0;
    NewQtWidget.glxcontext := glXCreateContext(NewQtWidget.xdisplay,
                                               NewQtWidget.visual, nil, direct);

    NewQtWidget.glxdrawable := QWidget_winId(NewQtWidget.Widget);
    NewQtWidget.ref_count := 1;

    NewQtWidget.AttachEvents;

    Result:=HWND(PtrUInt(Pointer(NewQtWidget)));
  finally
    FreeMem(AttrList);
  end;
end;

procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
begin
  if not AWinControl.HandleAllocated then exit;
  // nothing to do
end;

function CreateOpenGLContextAttrList(DoubleBuffered: boolean; RGBA: boolean
  ): PInteger;
var
  p: integer;

  procedure Add(i: integer);
  begin
    if Result<>nil then
      Result[p]:=i;
    inc(p);
  end;

  procedure CreateList;
  begin
    if DoubleBuffered then
      Add(QT_GL_DOUBLEBUFFER);
    if RGBA then
      Add(QT_GL_RGBA);
    Add(QT_GL_RED_SIZE);  Add(1);
    Add(QT_GL_GREEN_SIZE);  Add(1);
    Add(QT_GL_BLUE_SIZE);  Add(1);
    Add(QT_GL_DEPTH_SIZE);  Add(1);
    Add(QT_GL_STENCIL_SIZE); Add(1);
    Add(QT_GL_None);
  end;

begin
  Result:=nil;
  p:=0;
  CreateList;
  GetMem(Result,SizeOf(integer)*p);
  p:=0;
  CreateList;
end;

end.

glqtcontext.pas (7,811 bytes)

yogo1212

2014-01-13 21:21

reporter   ~0072412

Who is supervising this? With the information given it's possible to fix..

How does one get involved?

Juha Manninen

2014-01-14 09:54

developer   ~0072420

> Who is supervising this?

Zeljan is the LCL-QT maintainer. OpenGL is known at least by Mattias, maybe others.

> How does one get involved?

By providing a patch that solves the problem. If you hit an obstacle, you can ask questions in the Lazarus mailing list.
A long discussion and questions are not preferred under the bug report.

Zeljan Rikalo

2014-01-14 10:32

developer   ~0072422

I don't use OpenGL at all atm, maybe Mattias should review that patch and commit.
Anyway with Qt5 bindings I expect full QtOpenGL implementation (which is missing in current bindings).

Andrey Zubarev

2014-11-22 09:00

reporter   ~0079265

After http://bugs.freepascal.org/view.php?id=27066, this can be resolved and closed

Issue History

Date Modified Username Field Change
2010-01-25 18:42 Andreas Schneider New Issue
2010-01-25 18:42 Andreas Schneider Widgetset => QT
2010-01-25 18:50 Zeljan Rikalo Status new => assigned
2010-01-25 18:50 Zeljan Rikalo Assigned To => Zeljan Rikalo
2010-01-25 18:51 Zeljan Rikalo LazTarget => post 1.2
2010-01-25 18:51 Zeljan Rikalo Note Added: 0033896
2011-03-01 15:39 Zeljan Rikalo Relationship added has duplicate 0018850
2011-12-28 19:24 Andrey Zubarev Note Added: 0055329
2011-12-28 22:49 Zeljan Rikalo Note Added: 0055331
2012-01-03 21:38 Zeljan Rikalo Note Added: 0055459
2012-01-13 22:07 Andrey Zubarev Note Added: 0055733
2012-12-04 21:47 Maxim Ganetsky Relationship added has duplicate 0023263
2013-05-20 21:49 Дмитрий Note Added: 0067790
2013-06-06 12:50 Дмитрий Note Added: 0068092
2013-06-06 19:02 Zeljan Rikalo Note Added: 0068099
2013-06-07 11:47 Andrey Zubarev Note Added: 0068112
2013-06-07 11:47 Andrey Zubarev File Added: glqtcontext
2013-06-08 13:21 Zeljan Rikalo Note Added: 0068127
2013-06-08 17:26 Andrey Zubarev Note Added: 0068131
2013-06-08 19:54 Zeljan Rikalo Note Added: 0068134
2013-06-08 20:24 Andrey Zubarev Note Added: 0068135
2013-06-08 22:17 Zeljan Rikalo Note Added: 0068138
2013-06-09 11:31 Andrey Zubarev Note Added: 0068145
2013-06-10 14:07 Zeljan Rikalo Note Added: 0068188
2013-06-12 22:39 Andrey Zubarev Note Added: 0068260
2013-06-13 07:54 Zeljan Rikalo Note Added: 0068268
2013-06-13 08:27 Andrey Zubarev Note Added: 0068270
2013-06-13 08:28 Andrey Zubarev File Added: flickering1.png
2013-06-13 08:34 Andrey Zubarev Note Edited: 0068270 View Revisions
2013-06-21 23:04 Andrey Zubarev File Added: glqtcontext_v2
2013-06-21 23:06 Andrey Zubarev Note Added: 0068425
2013-06-21 23:08 Andrey Zubarev Note Edited: 0068425 View Revisions
2013-06-22 15:57 Zeljan Rikalo Note Added: 0068434
2013-06-22 23:19 Andrey Zubarev Note Added: 0068444
2013-09-03 12:07 Martin Friebe LazTarget post 1.2 => 1.4
2014-01-13 21:07 yogo1212 File Added: glqtcontext.pas
2014-01-13 21:21 yogo1212 Note Added: 0072412
2014-01-14 09:54 Juha Manninen Note Added: 0072420
2014-01-14 10:32 Zeljan Rikalo Note Added: 0072422
2014-01-14 10:32 Zeljan Rikalo Status assigned => feedback
2014-09-10 13:50 Juha Manninen LazTarget 1.4 => -
2014-11-22 09:00 Andrey Zubarev Note Added: 0079265
2014-11-22 10:16 Juha Manninen Relationship added related to 0027066
2014-11-22 10:53 Mattias Gaertner Status feedback => resolved
2014-11-22 10:53 Mattias Gaertner Resolution open => fixed
2014-11-22 10:53 Mattias Gaertner Assigned To Zeljan Rikalo => Mattias Gaertner