Direkt auf Bitmap zeichnen (OpenGL)

[Fritzew]

So sollte es gehen:

Delphi-Quellcode:

unit glHelper;

interface

uses
   Windows,
   graphics,
   dglOpenGl;

type
   TGlHelper = class
   private
      function GetGlBitmap(aWidth, aHeight: integer): TBitmap;
   protected
      procedure RenderSceneGL; virtual;
   end;

implementation

function TGlHelper.GetGlBitmap(aWidth, aHeight: integer): TBitmap;

type
   ByteArray = array [0 .. 0] of byte;
   pByteArray = ^ByteArray;

var
   lDataSize: Cardinal;
   lFrameBufferid: GLuint;
   lRenderbufferId: GLuint;
   lActViewtexure: GLuint;
   lData: Pointer;

   Y, X, x4: integer;
   pSrc, pDest: pByteArray;

begin
   result := nil;
   lDataSize := aWidth * aHeight * 4;
   if lDataSize > 0 then
      begin
  // Prepare fbo
         glDrawBuffer(GL_BACK);
         glGenFramebuffers(1, @lFrameBufferid);
         glBindFramebuffer(GL_FRAMEBUFFER, lFrameBufferid);

         glGenRenderbuffers(1, @lRenderbufferId);
         glBindRenderbuffer(GL_RENDERBUFFER, lRenderbufferId);

         glRenderbufferStorage(GL_RENDERBUFFER, GL_DEPTH_COMPONENT, aWidth, aHeight);
         glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_ATTACHMENT, GL_RENDERBUFFER, lRenderbufferId);

         GLGenTextures(1, @lActViewtexure);
         GLBindTexture(GL_TEXTURE_2D, lActViewtexure);
         GLTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
         GLTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
         GLTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA8, aWidth, aHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);

         GLFramebufferTexture2D(GL_FRAMEBUFFER_EXT, GL_COLOR_ATTACHMENT0_EXT, GL_TEXTURE_2D, lActViewtexure, 0);

         glBindFramebuffer(GL_FRAMEBUFFER, lFrameBufferid);
         GLViewPort(0, 0, aWidth, aHeight);


  // render the scene part

         RenderSceneGL;
         GLFinish;

         glDrawBuffer(gl_Front);

         glBindRenderbuffer(GL_FRAMEBUFFER, 0);
         GLDeleteRenderbuffers(1, @lRenderbufferId);
         glBindFramebuffer(GL_FRAMEBUFFER, 0);
         GLDeleteFramebuffers(1, @lFrameBufferid);

         lData := AllocMem(lDataSize);
         try
            GLGetTexImage(GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, lData);
            GLBindTexture(GL_TEXTURE_2D, 0);
            GLDeleteTextures(1, @lActViewtexure);
      // Prepare the Bitmap

            result := TBitmap.Create;
            result.PixelFormat := pf32bit;
            result.Width := aWidth;
            result.Height := aHeight;

            pSrc := @pByteArray(lData)[aWidth * 4 * (aHeight - 1)];
            for Y := 0 to aHeight - 1 do
               begin
                  pDest := result.ScanLine[Y];
                  for X := 0 to aWidth - 1 do
                     begin
                        x4 := X * 4;
                        pDest[x4 + 0] := pSrc[x4 + 2];
                        pDest[x4 + 1] := pSrc[x4 + 1];
                        pDest[x4 + 2] := pSrc[x4 + 0];
                        pDest[x4 + 3] := pSrc[x4 + 3];
                     end;
                  Dec(pSrc, aWidth * 4);
               end;
         finally
            FreeMem(lData);
         end;
      end;
end;

procedure TGlHelper.RenderSceneGL;
begin

end;

end.