Changeset 521 for GraphicTest/Packages/bgrabitmap/bglvirtualscreen.pas

Timestamp:

Apr 17, 2019, 12:58:41 AM (5 years ago)

Author:

chronos

Message:

• Modified: Propagate project build mode options to used packages.
• Added: Check memory leaks using heaptrc.
• Modified: Update BGRABitmap package.

Location:

GraphicTest

Files:

• . (modified) (1 prop)
• Packages/bgrabitmap/bglvirtualscreen.pas (modified) (3 diffs)

GraphicTest

@@ -8 +8 @@
 GraphicTest.lps
 GraphicTest.dbg
+heaptrclog.trc

@@ -8 +8 @@
 GraphicTest.lps
 GraphicTest.dbg
+heaptrclog.trc

GraphicTest/Packages/bgrabitmap/bglvirtualscreen.pas

@@ -16 +16 @@
   TBGLElapseEvent = procedure (Sender: TObject; BGLContext: TBGLContext; ElapsedMs: integer) of object;
   TBGLFramesPerSecondEvent = procedure (Sender: TObject; BGLContext: TBGLContext; FramesPerSecond: integer) of object;
+  TBGLUseContextCallback = procedure (Sender: TObject; BGLContext: TBGLContext; Data: Pointer) of object;
 
   { TCustomBGLVirtualScreen }
@@ -60 +61 @@
     procedure QueryLoadTextures; virtual;
     procedure UnloadTextures; virtual;
+    procedure UseContext(ACallback: TBGLUseContextCallback; AData: Pointer = nil);
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
@@ -350 +352 @@
 end;
 
+procedure TCustomBGLVirtualScreen.UseContext(ACallback: TBGLUseContextCallback; AData: Pointer);
+var
+  ctx: TBGLContext;
+begin
+  if not MakeCurrent then
+    raise exception.Create('Unable to switch to the OpenGL context');
+  ctx := PrepareBGLContext;
+  try
+    ACallback(self, ctx, AData);
+  finally
+    ReleaseBGLContext(ctx);
+  end;
+end;
+
 procedure TCustomBGLVirtualScreen.RedrawContent(ctx: TBGLContext);
 var

@@ -8 +8 @@
 GraphicTest.lps
 GraphicTest.dbg
+heaptrclog.trc