OpenGLControl

[gilsonalencar]

Anybody knows how to save a 3D graph from a OpenGLControl as a 2D image file (.jpg, .png) and copy it to a clipboard?

[Imants]

You can not do that from control.

Only option which I know is to render your graph to texture and then save it to file using some library.

I think there is way that you could use glReadPixels and read all pixels from screan and save them to TBitmap object your self

[gilsonalencar]

I'm trying to use glCopyTexImage2D, but i don't have any idea  how to pass image information for a TBitmap component in Lazarus. If there is a  :(way, the problem is solved. I wrote a command as
glCopyTexImage2D (GL_TEXTURE_2D, 0, GL_RGBA, 0, 0, OpenGLControl.width, OpenGLControl.height, 0). Where the imagem information is loaded when glCopyTexImage2D is used? I'm a beginner in opengl programming.

[KpjComp]

Here's a little function I've knocked up that might help

Code: [Select]

function SaveOpenGLControlToBitmap(c:TOpenGLControl):TBitmap;
type
  PRGBA = ^TRGBA;
  TRGBA = record
    r,g,b,a:byte;
  end;
var
  data,rdata:pbyte;
  l,w,h,x,y,s:integer;
  b:TBitmap;
  tmpb:byte;
  fixRGBA:PRGBA;
begin
  w := c.Width;
  h := c.Height;
  s := w*h*4;
  result := TBitmap.Create;
  try
    b := result;
    b.Width := w;
    b.Height := h;
    b.PixelFormat:=pf32bit;
    data := getMem(s);
    try
      glPixelStorei(GL_PACK_ALIGNMENT, 4);
      glReadPixels(0,0,w,h, GL_RGBA, GL_UNSIGNED_BYTE, data);
      b.BeginUpdate();
      try
        rdata := b.RawImage.Data;
        Move(data^,rdata^,b.RawImage.DataSize);
        fixRGBA := pointer(rdata);
        for l := 0 to w*h-1 do
        begin
          tmpb := FixRGBA^.r;
          FixRGBA^.r := FixRGBA^.b;
          FixRGBA^.b := tmpb;
          inc(FixRGBA);
        end;
      finally
        b.EndUpdate();
      end;
    finally
      freemem(data);
    end;
  except
    b.free;
  end;
end;     


[gilsonalencar]

KpjComp,

The code sent by you was implemented, but a "Access Violation" message appears when I run the program.

[KpjComp]

How you implement?

You will need to call this when the OpenGL context is still valid, I did it right after flipping the Buffer in the OnPaint event, I just set a boolean to indicate that this render wanted capturing.

eg.

Code: [Select]

   OpenGLControl1.SwapBuffers;
   if WantCapture then
   begin
     WantCapture := false;
     bmp := SaveOpenGLControlToBitmap(OpenGLControl1);
     try
       bmp.SaveToFile('test.bmp');
     finally
       bmp.free;
    end;
  end;


[gilsonalencar]

KpjComp,

The error is on the line "inc(FixRGBA)". When this line is executed, a "Access Violation" Message appears. Where's the return on the program to the results?

[KpjComp]

The error is on the line "inc(FixRGBA)"

mmm, not sure then.  Works here on windows in 32bit / 64bit Ok.

Maybe it could be byte alignment of the TBGRA, could you try changing to

Code: [Select]

  TRGBA = packed record
    r,g,b,a:byte;
  end;

You could also try taking out the FixBGRA stuff, it's just there to swap the Red & Blue components around.  It should still work but the colours would look odd, but then at least we could be certain it's that's what causing the gpf.

Where's the return on the program to the results?

The bit that says  result := TBitmap.Create

[gilsonalencar]

KpjComp,

I think there is a problem with the fixRGBA size. When the loop for l:=0 to w*h-1 run, an "access violation" message appears. I suppose that loop is out of range of fixRGBA.

[local-vision]

I expect you mean (w*h)-1 and NOT w*h-1.

It will then work correct on win7 64 and linux deb 64 (linux mint)

You may need to change  GL_RBGA to GL_BGRA.

But now I'd like to learn how I can get it to work on OSX...

OSX results in a slanted, color distorted image.

It would seem that there is some alignment problem between types (bytes).

[User137]

I expect you mean (w*h)-1 and NOT w*h-1.

Pascal syntax lets you assume that multiplication is done before reduction math. If that wouldn't be the case, you might have encountered a bug in Freepascal compiler itself. But do make some simple test project to verify this claim.

You may need to change  GL_RBGA to GL_BGRA.

Not GL_RBGA or GL_BGRA but GL_RGBA. The code specifically tells OpenGL to return data in this sequence here:

Code: [Select]

glReadPixels(0,0,w,h, GL_RGBA, GL_UNSIGNED_BYTE, data);(That said, i'm not 100% sure now if TBitmap assumes BGRA. I know it's BMP related thing at least. Change it to BGRA if colors look wrong, but image itself is intact.)

Important bit was also the "packed record" hint. 64-bit compiler might align it wrong if you don't pack, i think.

[local-vision]

Pascal syntax lets you assume that multiplication is done before reduction math.

You are correct (verified this).

GL_RBGA is a typo. This should be GL_RGBA

Getting back to the main topic:

Code listed below is not exactly an elegant approach. But it now works on OSX, so it is a starting point.
More info regarding the problem can be found here:

http://www.opengl.org/wiki/Common_Mistakes#Texture_upload_and_pixel_reads

OSX seems to fall back on a 24bit pixel format instead of the insisted 32bit request.
This results in a misaligned image which is color and shape distorted. This means that
you need to adapt the image width to a multiple of 4 in order for it to work.

Hopefully those more inclined than myself can help make this code work better.   

Tested on Win7 64 and Linux Deb 64 (linux mint) using the non-native video drivers.

Code: [Select]

function OpenGLContextToBitmap(const Left,Top,BMW,BMH:Integer):TBitmap;
type
  PRGBA = ^TRGBA;
  TRGBA = packed record
    R,G,B,A:byte;
  end;
var
  Data,
  rData                      :PByte;
  Width,
  Height,
  ByteWidth,
  Size                       :Integer;
  BMP1                       :TBitmap;
begin
  {$IFDEF DARWIN}
  Width:=4*(BMW DIV 4); //width needs to be set to a value that is divisible by 4
  if Width>BMW then //if the result is greater than BMW then reduce by 4
  begin
    Width:=Width-4;
  end;
  {$ELSE}
  Width:=BMW;
  {$ENDIF}

  Height := BMH;
  ByteWidth := Width * 4; // 32 bit pixel format so 4 bytes per pixel
  //ByteWidth := (ByteWidth + 3) and (not 3); // Align to 4 bytes

  Size := ByteWidth*Height;
  Result := TBitmap.Create;
  try
    BMP1 := Result;
    BMP1.Width := Width;
    BMP1.Height := Height;
    BMP1.PixelFormat:=pf32bit;//it would seem that OSX is ignoring this and falling back on 24bit
    Data := getMem(Size);
    try
      glPixelStorei(GL_PACK_ALIGNMENT, 4); //does not seem to matter if 1,2 or 4
      {$IFDEF DARWIN}
      glReadPixels(Left,Top,Width,Height,GL_BGRA, GL_UNSIGNED_INT_8_8_8_8, Data); //fails to produce correct result with GL_UNSIGNED_BYTE
      {$ENDIF}
      {$IFDEF LINUX}
      glReadPixels(Left,Top,Width,Height, GL_RGBA, GL_UNSIGNED_BYTE, Data);
      {$ENDIF}
      {$IFDEF WINDOWS}
      glReadPixels(Left,Top,Width,Height, GL_BGRA, GL_UNSIGNED_BYTE, Data)
      {$ENDIF}
      BMP1.BeginUpdate();
      try
        rData :=BMP1.RawImage.Data;
        Move(Data^,rData^,BMP1.RawImage.DataSize);
        //the returned image needs to be flipped vert and horz
        {
        Form1.Memo1.Lines.Add('BM Width '+IntToStr(BMP1.RawImage.Description.Width));
        Form1.Memo1.Lines.Add('BM Height '+IntToStr(BMP1.RawImage.Description.Height));
        Form1.Memo1.Lines.Add('Depth '+IntToStr(BMP1.RawImage.Description.Depth));
        Form1.Memo1.Lines.Add('BitsPerPixel '+IntToStr(BMP1.RawImage.Description.BitsPerPixel));
        Form1.Memo1.Lines.Add('AlphaPrec '+IntToStr(BMP1.RawImage.Description.AlphaPrec));
        Form1.Memo1.Lines.Add('AlphaShift '+IntToStr(BMP1.RawImage.Description.AlphaShift));
        Form1.Memo1.Lines.Add('BluePrec '+IntToStr(BMP1.RawImage.Description.BluePrec));
        Form1.Memo1.Lines.Add('BlueShift '+IntToStr(BMP1.RawImage.Description.BlueShift));
        Form1.Memo1.Lines.Add('GreenPrec '+IntToStr(BMP1.RawImage.Description.GreenPrec));
        Form1.Memo1.Lines.Add('GreenShift '+IntToStr(BMP1.RawImage.Description.GreenShift));
        Form1.Memo1.Lines.Add('RedPrec '+IntToStr(BMP1.RawImage.Description.RedPrec));
        Form1.Memo1.Lines.Add('RedShift '+IntToStr(BMP1.RawImage.Description.RedShift));
        Form1.Memo1.Lines.Add('MaskBitsPerPixel '+IntToStr(BMP1.RawImage.Description.MaskBitsPerPixel));
        Form1.Memo1.Lines.Add('MaskShift '+IntToStr(BMP1.RawImage.Description.MaskShift));
        Form1.Memo1.Lines.Add('PaletteBitsPerIndex '+IntToStr(BMP1.RawImage.Description.PaletteBitsPerIndex));
        }
      finally
        BMP1.EndUpdate();
      end;
    finally
      Freemem(Data);
    end;
  except
    BMP1.free;
  end;
end;             


[User137]

24-bit format is one without alpha, so you should be able to use GL_RGB in the glReadPixels() and put it in pf24bit. In a screenshot, the alpha transparency channel is most often not used at all anyway.

Also define

Code: [Select]

  PRGB = ^TRGB;
  TRGB = packed record
    R,G,B:byte;
  end;

[local-vision]

Correct. My thoughts exactly.

However, tried that approach very early on already. Unfortunately the result was just as bad. This included:

- The Alpha was omitted from the record
- The pixelformat was set to 24bit
- The pixel width was set back from width * 4 to width * 3
- GL_BGR and GL_RGB were tried
- GL_INT and GL_BYTE were tried

Attempted various intuitive and non-intuitive combinations. Yet, pretty much the same bad result.

Again, to be clear this problem/peculiarity is found only with OSX (which uses AGL and carbon).

Win and Linux approaches and results are both as one would expect.

The listed code from my previous posting is the only approach that I was able to make work. But it is by no means ideal.     

[local-vision]

After further investigation and testing I seem to have isolated the source of the formatting/alignment problem.

It seems to reside with TBitmap.

The function was originally constructed to return a TBitmap.

I removed this and after the glReadPixels loaded the RGBA  data from the TBitmap onto a dynamic array.

All seems to work now!

Have listed the revised code below. Thus far tested on intel mac and linux deb 64

Code: [Select]


type

TMapSizeR=record
       Width,
       Height :Integer;
end; 

TPixelIndicesR=record
       R,G,B,A :Byte;
end;

TByteMapR=record
      Size:TMapSizeR
      ByteMap :array of TPixelIndicesR;
end; 

var

ImageMap :TByteMapR;



Code: [Select]


function OpenGLContextToImageMap(const Left,Top,BMW,BMH:Integer):Boolean;
type
  PRGBA = ^TRGBA;
  TRGBA = packed record
    R,G,B,A:byte;
  end;
var
  Data,
  rData                      :PByte;
  n,
  Width,
  Height,
  ByteWidth,
  Size                       :Integer;
  BMP1                    :TBitmap;
  RGBA                    :PRGBA;
begin
  Result:=False;

  Width:=BMW;
  Height := BMH;
  ByteWidth := Width * 4; // 32 bit pixel format so 4 bytes per pixel

  Size := ByteWidth*Height;
  try
    BMP1 := TBitmap.Create;
    BMP1.Width := Width;
    BMP1.Height := Height;
    BMP1.PixelFormat:=pf32bit;
    try
    Data := getMem(Size);

    glPixelStorei(GL_PACK_ALIGNMENT, 4);
    glReadPixels(Left,Top,Width,Height, GL_RGBA, GL_UNSIGNED_BYTE, Data);

    BMP1.BeginUpdate();

        rData :=BMP1.RawImage.Data;
        Move(Data^,rData^,BMP1.RawImage.DataSize);

        //load RGBA values to dynamic array
        if (Length(ImageMap.ByteMap)>0) then begin Finalize(ImageMap.ByteMap); end;
        SetLength(ImageMap.ByteMap,BMP1.Width*BMP1.Height);
        ImageMap.Size.Width:=BMP1.Width; ImageMap.Size.Height:=BMP1.Height;

        RGBA := pointer(rdata);
        for n := 0 to (Width*Height)-1 do
        begin
          ImageMap.ByteMap[n].R:=RGBA^.R;
          ImageMap.ByteMap[n].G:=RGBA^.G;
          ImageMap.ByteMap[n].B:=RGBA^.B;
          ImageMap.ByteMap[n].A:=RGBA^.A;
          inc(RGBA);
        end;

        //add code to flip image vert and horz

    BMP1.EndUpdate();

    finally
      Freemem(Data);
    end;

  finally
    BMP1.free;
    Result:=True;
  end;
end;