View Issue Details

IDProjectCategoryView StatusLast Update
0032026PatchesPatchpublic2017-06-26 07:26
ReporterMichalis Kamburelis Assigned ToFelipe Monteiro de Carvalho  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Platformx86-64OSDebian GNU/Linux 
Product Version1.9 (SVN) 
Summary0032026: Patch to add TCustomOpenGLControl.RenderAtDesignTime property
DescriptionThe attached patch (done vs trunk components/opengl/openglcontext.pas) adds a property RenderAtDesignTime to TCustomOpenGLControl. When it's true, the TCustomOpenGLControl performs normal OpenGL initialization and rendering at design-time.

Reasoning:

Currently, the TOpenGLControl does not initialize OpenGL context during design-time, and draws a simple "X" over it's entire area at design-time. This is safe (it avoids dealing at Lazarus design-time with any instabilities you may have with your OpenGL), but it also disables making a design-time preview/editor of the stuff you would render using OpenGL.

With RenderAtDesignTime = true you can make a design-time editor of 3D stuff, like GLScene or FireMonkey3D, using TOpenGLContext. I want to use it for Castle Game Engine TCastleControl (that descends from Lazarus TOpenGLContext), initial code shows that it works quite cool :)
TagsNo tags attached.
Fixed in Revision55392
LazTarget-
WidgetsetGTK, GTK 2, GTK 3, Win32/Win64, WinCE, Carbon, Cocoa, QT, QT5, fpGUI, CustomDrawn
Attached Files

Activities

Michalis Kamburelis

2017-06-16 01:26

reporter  

openglcontrol_renderatdesigntime.patch (5,111 bytes)   
Index: openglcontext.pas
===================================================================
--- openglcontext.pas	(wersja 55353)
+++ openglcontext.pas	(kopia robocza)
@@ -136,6 +136,7 @@
     FMultiSampling, FAlphaBits, FDepthBits, FStencilBits, FAUXBuffers: Cardinal;
     FSharedOpenGLControl: TCustomOpenGLControl;
     FSharingOpenGlControls: TList;
+    FRenderAtDesignTime: boolean;
     function GetSharingControls(Index: integer): TCustomOpenGLControl;
     procedure SetAutoResizeViewport(const AValue: boolean);
     procedure SetDebugContext(AValue: boolean);
@@ -154,6 +155,10 @@
     procedure SetStencilBits(const AValue: Cardinal);
     procedure SetAUXBuffers(const AValue: Cardinal);
     procedure SetSharedControl(const AValue: TCustomOpenGLControl);
+    procedure SetRenderAtDesignTime(const AValue: boolean);
+    { OpenGL rendering allowed, because not in design-mode or because
+      we should render even in design-mode. }
+    function OpenGLRender: boolean;
   protected
     procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
     procedure WMSize(var Message: TLMSize); message LM_SIZE;
@@ -209,6 +214,8 @@
     property DepthBits: Cardinal read FDepthBits write SetDepthBits default DefaultDepthBits;
     property StencilBits: Cardinal read FStencilBits write SetStencilBits default 0;
     property AUXBuffers: Cardinal read FAUXBuffers write SetAUXBuffers default 0;
+
+    property RenderAtDesignTime: boolean read FRenderAtDesignTime write SetRenderAtDesignTime default false;
   end;
 
   { TOpenGLControl }
@@ -419,16 +426,36 @@
     end;
   end;
   // recreate handle if needed
-  if HandleAllocated and (not (csDesigning in ComponentState)) then
+  if HandleAllocated and OpenGLRender then
     ReCreateWnd(Self);
 end;
 
+function TCustomOpenGLControl.OpenGLRender: boolean;
+begin
+  Result := (not (csDesigning in ComponentState)) or RenderAtDesignTime;
+end;
+
+procedure TCustomOpenGLControl.SetRenderAtDesignTime(const AValue: boolean);
+begin
+  if FRenderAtDesignTime <> AValue then
+  begin
+    FRenderAtDesignTime := AValue;
+    if csDesigning in ComponentState then
+    begin
+      { OpenGLRender just changed, recreate handle (this will destroy
+        the old OpenGL context, if any, and create new one, if needed now) }
+      if HandleAllocated then
+        RecreateWnd(Self);
+    end;
+  end;
+end;
+
 procedure TCustomOpenGLControl.WMPaint(var Message: TLMPaint);
 begin
   Include(FControlState, csCustomPaint);
   inherited WMPaint(Message);
   //debugln('TCustomGTKGLAreaControl.WMPaint A ',dbgsName(Self),' ',dbgsName(FCanvas));
-  if (csDesigning in ComponentState) and (FCanvas<>nil) then begin
+  if (not OpenGLRender) and (FCanvas<>nil) then begin
     with FCanvas do begin
       if Message.DC <> 0 then
         Handle := Message.DC;
@@ -468,8 +495,8 @@
 
 procedure TCustomOpenGLControl.OpenGLAttributesChanged;
 begin
-  if HandleAllocated
-  and ([csLoading,csDesigning,csDestroying]*ComponentState=[]) then
+  if HandleAllocated and
+    ( ([csLoading,csDestroying]*ComponentState=[]) and OpenGLRender ) then
     RecreateWnd(Self);
 end;
 
@@ -494,7 +521,7 @@
   FMultiSampling:=1;
   FDepthBits:=DefaultDepthBits;
   ControlStyle:=ControlStyle-[csSetCaption];
-  if (csDesigning in ComponentState) then begin
+  if not OpenGLRender then begin
     FCanvas := TControlCanvas.Create;
     TControlCanvas(FCanvas).Control := Self;
   end else
@@ -520,11 +547,11 @@
   inherited Destroy;
 end;
 
-Procedure TCustomOpenGLControl.Paint;
+procedure TCustomOpenGLControl.Paint;
 begin
   if IsVisible and HandleAllocated then begin
     UpdateFrameTimeDiff;
-    if ([csDesigning,csDestroying]*ComponentState=[]) then begin
+    if OpenGLRender and ([csDestroying]*ComponentState=[]) then begin
       if not MakeCurrent then exit;
       if AutoResizeViewport then
         LOpenGLViewport(0,0,Width,Height);
@@ -537,7 +564,8 @@
 procedure TCustomOpenGLControl.RealizeBounds;
 begin
   if IsVisible and HandleAllocated
-  and ([csDesigning,csDestroying]*ComponentState=[])
+  and OpenGLRender
+  and ([csDestroying]*ComponentState=[])
   and AutoResizeViewport then begin
     if MakeCurrent then
       LOpenGLViewport(0,0,Width,Height);
@@ -559,7 +587,7 @@
 var
   Allowed: Boolean;
 begin
-  if csDesigning in ComponentState then exit(false);
+  if not OpenGLRender then exit(false);
   if Assigned(FOnMakeCurrent) then begin
     Allowed:=true;
     OnMakeCurrent(Self,Allowed);
@@ -628,7 +656,8 @@
   OpenGlControl: TCustomOpenGLControl;
   AttrControl: TCustomOpenGLControl;
 begin
-  if csDesigning in AWinControl.ComponentState then
+  OpenGlControl:=AWinControl as TCustomOpenGLControl;
+  if not OpenGlControl.OpenGLRender then
   begin
     // do not use "inherited CreateHandle", because the LCL changes the hierarchy at run time
     Result:=TWSWinControlClass(ClassParent).CreateHandle(AWinControl,AParams);
@@ -635,7 +664,6 @@
   end
   else
   begin
-    OpenGlControl:=AWinControl as TCustomOpenGLControl;
     if OpenGlControl.SharedControl<>nil then
       AttrControl:=OpenGlControl.SharedControl
     else

Felipe Monteiro de Carvalho

2017-06-23 06:16

developer   ~0101297

I recently added an Options property to openglcontrol, exactly so that we can add this kind of miscelaneous booleans without adding dozens of properties. Please write a patch extending the Options property instead.

Michalis Kamburelis

2017-06-25 16:57

reporter  

renderatdesigntime-new.patch (6,089 bytes)   
Index: openglcontext.pas
===================================================================
--- openglcontext.pas	(wersja 55390)
+++ openglcontext.pas	(kopia robocza)
@@ -103,7 +103,7 @@
   TOpenGlCtrlMakeCurrentEvent = procedure(Sender: TObject;
                                           var Allow: boolean) of object;
 
-  TOpenGLControlOption = (ocoMacRetinaMode);
+  TOpenGLControlOption = (ocoMacRetinaMode, ocoRenderAtDesignTime);
   TOpenGLControlOptions = set of TOpenGLControlOption;
 
   { TCustomOpenGLControl }
@@ -111,7 +111,7 @@
     You can share opengl contexts. For example:
     Assume OpenGLControl2 and OpenGLControl3 should share the same as
     OpenGLControl1. Then set
-    
+
         OpenGLControl2.SharedControl:=OpenGLControl1;
         OpenGLControl3.SharedControl:=OpenGLControl1;
 
@@ -160,6 +160,9 @@
     procedure SetStencilBits(const AValue: Cardinal);
     procedure SetAUXBuffers(const AValue: Cardinal);
     procedure SetSharedControl(const AValue: TCustomOpenGLControl);
+    { OpenGL rendering allowed, because not in design-mode or because
+      we should render even in design-mode. }
+    function OpenGLRender: boolean;
   protected
     procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
     procedure WMSize(var Message: TLMSize); message LM_SIZE;
@@ -203,11 +206,11 @@
       Value <= 1 means that we use 1 sample per pixel, which means no anti-aliasing.
       Higher values mean anti-aliasing. Exactly which values are supported
       depends on GPU, common modern GPUs support values like 2 and 4.
-      
+
       If this is > 1, and we will not be able to create OpenGL
       with multi-sampling, we will fallback to normal non-multi-sampled context.
-      You can query OpenGL values GL_SAMPLE_BUFFERS_ARB and GL_SAMPLES_ARB 
-      (see ARB_multisample extension) to see how many samples have been 
+      You can query OpenGL values GL_SAMPLE_BUFFERS_ARB and GL_SAMPLES_ARB
+      (see ARB_multisample extension) to see how many samples have been
       actually allocated for your context. }
     property MultiSampling: Cardinal read FMultiSampling write SetMultiSampling default 1;
 
@@ -339,9 +342,27 @@
 end;
 
 procedure TCustomOpenGLControl.SetOptions(AValue: TOpenGLControlOptions);
+var
+  RemovedRenderAtDesignTime: boolean;
 begin
   if FOptions=AValue then Exit;
+
+  RemovedRenderAtDesignTime:=
+         (ocoRenderAtDesignTime in FOptions) and
+    (not (ocoRenderAtDesignTime in AValue));
+
   FOptions:=AValue;
+
+  { if you remove the flag ocoRenderAtDesignTime at design-time,
+    we need to destroy the handle. The call to OpenGLAttributesChanged
+    would not do this, so do it explicitly by calling ReCreateWnd
+    (ReCreateWnd will destroy handle, and not create new one,
+    since OpenGLRender = false). }
+  if (csDesigning in ComponentState) and
+     RemovedRenderAtDesignTime and
+     HandleAllocated then
+    ReCreateWnd(Self);
+
   OpenGLAttributesChanged();
 end;
 
@@ -433,16 +454,22 @@
     end;
   end;
   // recreate handle if needed
-  if HandleAllocated and (not (csDesigning in ComponentState)) then
+  if HandleAllocated and OpenGLRender then
     ReCreateWnd(Self);
 end;
 
+function TCustomOpenGLControl.OpenGLRender: boolean;
+begin
+  Result := (not (csDesigning in ComponentState)) or
+    (ocoRenderAtDesignTime in Options);
+end;
+
 procedure TCustomOpenGLControl.WMPaint(var Message: TLMPaint);
 begin
   Include(FControlState, csCustomPaint);
   inherited WMPaint(Message);
   //debugln('TCustomGTKGLAreaControl.WMPaint A ',dbgsName(Self),' ',dbgsName(FCanvas));
-  if (csDesigning in ComponentState) and (FCanvas<>nil) then begin
+  if (not OpenGLRender) and (FCanvas<>nil) then begin
     with FCanvas do begin
       if Message.DC <> 0 then
         Handle := Message.DC;
@@ -482,8 +509,8 @@
 
 procedure TCustomOpenGLControl.OpenGLAttributesChanged;
 begin
-  if HandleAllocated
-  and ([csLoading,csDesigning,csDestroying]*ComponentState=[]) then
+  if HandleAllocated and
+    ( ([csLoading,csDestroying]*ComponentState=[]) and OpenGLRender ) then
     RecreateWnd(Self);
 end;
 
@@ -508,7 +535,7 @@
   FMultiSampling:=1;
   FDepthBits:=DefaultDepthBits;
   ControlStyle:=ControlStyle-[csSetCaption];
-  if (csDesigning in ComponentState) then begin
+  if not OpenGLRender then begin
     FCanvas := TControlCanvas.Create;
     TControlCanvas(FCanvas).Control := Self;
   end else
@@ -538,7 +565,7 @@
 begin
   if IsVisible and HandleAllocated then begin
     UpdateFrameTimeDiff;
-    if ([csDesigning,csDestroying]*ComponentState=[]) then begin
+    if OpenGLRender and ([csDestroying]*ComponentState=[]) then begin
       if not MakeCurrent then exit;
       if AutoResizeViewport then
         LOpenGLViewport(Handle,0,0,Width,Height);
@@ -551,7 +578,8 @@
 procedure TCustomOpenGLControl.RealizeBounds;
 begin
   if IsVisible and HandleAllocated
-  and ([csDesigning,csDestroying]*ComponentState=[])
+  and OpenGLRender
+  and ([csDestroying]*ComponentState=[])
   and AutoResizeViewport then begin
     if MakeCurrent then
       LOpenGLViewport(Handle,0,0,Width,Height);
@@ -573,7 +601,7 @@
 var
   Allowed: Boolean;
 begin
-  if csDesigning in ComponentState then exit(false);
+  if not OpenGLRender then exit(false);
   if Assigned(FOnMakeCurrent) then begin
     Allowed:=true;
     OnMakeCurrent(Self,Allowed);
@@ -642,7 +670,8 @@
   OpenGlControl: TCustomOpenGLControl;
   AttrControl: TCustomOpenGLControl;
 begin
-  if csDesigning in AWinControl.ComponentState then
+  OpenGlControl:=AWinControl as TCustomOpenGLControl;
+  if not OpenGlControl.OpenGLRender then
   begin
     // do not use "inherited CreateHandle", because the LCL changes the hierarchy at run time
     Result:=TWSWinControlClass(ClassParent).CreateHandle(AWinControl,AParams);
@@ -649,7 +678,6 @@
   end
   else
   begin
-    OpenGlControl:=AWinControl as TCustomOpenGLControl;
     if OpenGlControl.SharedControl<>nil then
       AttrControl:=OpenGlControl.SharedControl
     else
@@ -695,4 +723,3 @@
   RegisterWSComponent(TCustomOpenGLControl,TWSOpenGLControl);
 
 end.
-
renderatdesigntime-new.patch (6,089 bytes)   

Michalis Kamburelis

2017-06-25 16:59

reporter   ~0101332

Sure, done! It's now "ocoRenderAtDesignTime in Options" instead of RenderAtDesignTime boolean.

Note that in this approach, the SetOptions setter needs to be somewhat complicated.

1. Calling OpenGLAttributesChanged is sometimes not enough (when you remove ocoRenderAtDesignTime at design-time). I accounted for this in SetOptions.

2. Sometimes calling OpenGLAttributesChanged is actually not needed. If you only change ocoRenderAtDesignTime in Options during normal program execution (not at design-time), then the call to OpenGLAttributesChanged by SetOptions is not needed (and it costs time, recreating the OpenGL context) . But I suspect that this is not an often case, so I did not optimize it (it would complicate the SetOptions more, just to handle this particular case).

This is not a criticism of the "Options" approach, I like it :) I'm only explaining why I had to complicate the SetOptions in my patch.

Felipe Monteiro de Carvalho

2017-06-26 07:25

developer   ~0101346

Applied with small changes in revision: 55392

Issue History

Date Modified Username Field Change
2017-06-16 01:26 Michalis Kamburelis New Issue
2017-06-16 01:26 Michalis Kamburelis File Added: openglcontrol_renderatdesigntime.patch
2017-06-23 06:16 Felipe Monteiro de Carvalho Note Added: 0101297
2017-06-25 16:57 Michalis Kamburelis File Added: renderatdesigntime-new.patch
2017-06-25 16:59 Michalis Kamburelis Note Added: 0101332
2017-06-26 06:54 Felipe Monteiro de Carvalho Assigned To => Felipe Monteiro de Carvalho
2017-06-26 06:54 Felipe Monteiro de Carvalho Status new => assigned
2017-06-26 07:25 Felipe Monteiro de Carvalho Note Added: 0101346
2017-06-26 07:26 Felipe Monteiro de Carvalho Fixed in Revision => 55392
2017-06-26 07:26 Felipe Monteiro de Carvalho LazTarget => -
2017-06-26 07:26 Felipe Monteiro de Carvalho Status assigned => resolved
2017-06-26 07:26 Felipe Monteiro de Carvalho Resolution open => fixed