procedure TFormOpenGL.RenderToBitmap(const ABitmap: TBitmap);
var FormatIndex: Integer;    PFD: TPixelFormatDescriptor;  lFDC: HDC;
begin
lFDC := ABitmap.Canvas.Handle;
FillChar(PFD, SizeOf(PFD), 0);
  With PFD do begin
  nSize := SizeOf(PFD);   nVersion := 1;
  dwFlags := pfd_Draw_to_Bitmap or pfd_Support_OpenGL;
  iPixelType := pfd_Type_RGBA;
  cColorBits := 24;    cDepthBits := 32;
  iLayerType := pfd_Main_Plane;
  end;
FormatIndex := ChoosePixelFormat(lFDC, @PFD);
SetPixelFormat(lFDC, FormatIndex, @PFD);
FGLContext := wglCreateContext(lFDC);
wglMakeCurrent(lFDC, FGLContext);
MyPaint(True);
.............
end;

lFDC := ABitmap.Canvas.Handle;

lFDC := ABitmap.Handle;

lFDC := ABitmap.Handle

unit FrameBufferUnit;

interface

uses
 Windows, SysUtils, Graphics, GL, GLu, GLext;

type
 TFrameBuffer = class
 private
   width   : Integer;
   height  : Integer;
   frameb  : GLuint;
   depthb  : GLuint;
   texture : GLuint;
   ftex    : boolean;
 public
   constructor Create(const nWidth,nHeight:Integer;ctexture:Integer = 0 );
   destructor Destroy;override;
   procedure BindFrameBuffer;
   procedure UnbindFrameBuffer;
   function GetBitmap:TBitmap;
   procedure AttachTexture;
   procedure DettachTexture;    
 end;

implementation

{ TFrameBuffer }

type
 TRGBLine = array [0..1023] of TRGBTriple;
 PRGBLine = ^TRGBLine;

procedure TFrameBuffer.AttachTexture;
begin
glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT,GL_COLOR_ATTACHMENT0_EXT,GL_TEXTURE _2D,texture,0);
end;

procedure TFrameBuffer.BindFrameBuffer;
begin
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT,frameb);
end;

constructor TFrameBuffer.Create(const nWidth, nHeight: Integer;ctexture:Integer);
var
 res   : Integer;
 ww,hh : Integer;
begin
Width:=nWidth;
Height:=nHeight;
{ ww:=1;
while ww<Width do
 ww:=ww*2;
hh:=1;
while hh<Height do
 hh:=hh*2;}
ww:=Width;
hh:=Height;
ftex:=ctexture<>0;
if ftex then
 texture:=ctexture
else
 glGenTextures(1,@texture);
glBindTexture(GL_TEXTURE_2D,texture);
glTexParameterf(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
glTexParameterf(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR_MIPMAP_LINEAR);
glTexParameterf(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_REPEAT);
glTexParameterf(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_REPEAT);
glTexParameterf(GL_TEXTURE_2D,GL_GENERATE_MIPMAP,0);
glTexImage2D(GL_TEXTURE_2D,0,GL_RGBA8,ww,hh,0,GL_RGBA,GL_UNSIGNED_BYTE,nil);
glBindTexture(GL_Texture_2D,0);
glGenFramebuffersEXT(1,@frameb);
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT,frameb);
glGenRenderbuffersEXT(1,@depthb);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT,depthb);
glRenderbufferStorageEXT(GL_RENDERBUFFER_EXT,GL_DEPTH_COMPONENT,width,height);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT,0);
glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT,GL_COLOR_ATTACHMENT0_EXT,GL_TEXTURE _2D,texture,0);
glFramebufferRenderbufferEXT(GL_FRAMEBUFFER_EXT,GL_DEPTH_ATTACHMENT_EXT,GL_RENDE RBUFFER_EXT,depthb);
res:=glCheckFramebufferStatusEXT(GL_FRAMEBUFFER_EXT);
if res<>GL_FRAMEBUFFER_COMPLETE_EXT then
 raise Exception.Create('frame buffer error');
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT,0);
end;

destructor TFrameBuffer.Destroy;
begin
DettachTexture;
glDeleteFramebuffersEXT(1,@frameb);
glDeleteRenderbuffersEXT(1,@depthb);
if not ftex then
 glDeleteTextures(1,@texture);
inherited;
end;

procedure TFrameBuffer.DettachTexture;
begin
glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT,GL_COLOR_ATTACHMENT0_EXT,GL_TEXTURE _2D,0,0);
end;

function TFrameBuffer.GetBitmap: TBitmap;
var
 buf : Pointer;
 l   : PRGBLine;
 b   : ^TRGBTriple;
 i,j : Integer;
 h,w : Integer;
function PtrAllign(APointer:Pointer; bytes: cardinal):Pointer;
begin
 Result := Ptr(cardinal(APointer) + (bytes-cardinal(APointer) mod bytes) mod bytes);
end;
begin
w:=width;
h:=height;
result:=TBitmap.Create;
result.PixelFormat:=pf24bit;
result.Width:=w;
result.Height:=h;
GetMem(buf,w*h*3);
glBindTexture(GL_TEXTURE_2D,texture);
ZeroMemory(buf,w*h*3);
glGetTexImage(GL_TEXTURE_2D,0,GL_RGB,GL_UNSIGNED_BYTE,buf);
glBindTexture(GL_TEXTURE_2D,0);
b:=buf;
for i:=h-1 downto 0 do
begin
  l:=result.ScanLine[i];
  for j:=0 to w-1 do
  begin
    l[j].rgbtBlue:=b.rgbtRed;
    l[j].rgbtGreen:=b.rgbtGreen;
    l[j].rgbtRed:=b.rgbtBlue;
    Inc(b);
  end;
  b:=PtrAllign(b,4);
end;
FreeMemory(buf);
end;

procedure TFrameBuffer.UnbindFrameBuffer;
begin
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT,0);
end;

end.

function TScene.DrawToBitmap(ww,hh:Integer): TBitmap;
var
 w,h : Integer;
 fb  : TFrameBuffer;
begin
w:=Width;
h:=Height;
Width:=ww;
Height:=hh;
UseContext;
fb:=TFrameBuffer.Create(ww,hh);
fb.BindFrameBuffer;
Draw(False);
Result:=fb.GetBitmap;
fb.UnbindFrameBuffer;
fb.Free;
Width:=w;
Height:=h;
end;

fb:=TFrameBuffer.Create(ww,hh);

...;ctexture: Integer);

ABitmap.Canvas.Lock;
lFDC := ABitmap.Canvas.Handle;
 ...
wglMakeCurrent(lFDC, FGLContext);
//не обращаться ни к каким методам и свойствам ABitmap(которые явно или неявно вызывают FreeContext)
 ...
wglMakeCurrent(0, 0);
ABitmap.Canvas.Unlock;

........................................
var DC: HDC;   Binf: TBitMapInfo;    Dib: HBitmap;   Bits: Pointer;
begin
  With Binf.bmiHeader do begin
  biSize := SizeOf(TBitmapInfoHeader);
  biWidth := ABitmap.Width;   biHeight := ABitmap.Height;
  biPlanes := 1;    biBitCount := 24;
  biCompression := bi_RGB;
  biSizeImage := biWidth * biHeight * 3;
  end;
DC := GetDC(ABitmap.Canvas.Handle);
Dib := CreateDIBSection(DC, Binf, DIB_RGB_Colors, Bits, 0, 0);
ReleaseDC(ABitmap.Canvas.Handle, DC);
lFDC := CreateCompatibleDC(0);
SelectObject(lFDC, Dib);
{lFDC := ABitmap.Canvas.Handle;}    { Так было раньше }
FillChar(PFD, SizeOf(PFD), 0);
  With PFD do begin
  nSize := SizeOf(PFD);    nVersion := 1;
  dwFlags := pfd_Draw_to_Bitmap or pfd_Generic_Accelerated or
   pfd_Support_OpenGL;
  iPixelType:= pfd_Type_RGBA;
  cColorBits:= 24;    cDepthBits:= 16;
  iLayerType:= pfd_Main_Plane;
  end;
FormatIndex := ChoosePixelFormat(lFDC, @PFD);
SetPixelFormat(lFDC, FormatIndex, @PFD);
FGLContext := wglCreateContext(lFDC);
wglMakeCurrent(lFDC, FGLContext);
TestPaint;
glFinish;
..................

procedure TFormMain.RenderDIB_BtnClick(Sender: TObject);
var hMemRC, hOldRC: HGLRC;       FormatIndex, W1, H1: Integer;
 pfd: TPixelFormatDescriptor;   poBits: Pointer;
 bmpAux, BBitmap: TBitmap;      bmiAux: BitmapInfo;
 hhDc, hDIB, hMemDC, hOldDc: HDC;
const BmpFileName = 'D:\FileOpenGL_DIB.bmp';
begin
{ 1. Determine the DIB size }
W1 := SpinEditR2BWidth.Value;    H1 := SpinEditR2BHeight.Value;
{ 2. Create the DIB section }
  With bmiAux.bmiHeader do begin
  biSize := SizeOf(BitmapInfoHeader);
  biWidth := W1;     biHeight := H1;
  biPlanes := 1;     biBitCount := 24;
  biCompression := bi_RGB;
  biSizeImage := 3 * W1 * H1;
  end;
hhDC := GetDC(Panel1.Handle);
hDIB := CreateDIBSection(hhDc, bmiAux, DIB_RGB_Colors, poBits, 0, 0);
ReleaseDC(Panel1.Handle, hhDc);
{ 3. Create memory DC and associate it with the DIB }
hMemDC := CreateCompatibleDC(0);
  If hMemDC = 0 then begin
  DeleteObject(hMemDC);   ShowMessage('DIB: Err1');
  Exit
  end;
SelectObject(hMemDC, hDIB);
{ 4. Setup memory DC's pixel }
FillChar(pfd, SizeOf(pfd), 0);
  With pfd do begin
  nSize := SizeOf(pfd);   nVersion := 1;
  dwFlags := pfd_Draw_To_Bitmap or pfd_Support_OpenGL
    or pfd_Generic_Accelerated;
  iPixelType := pfd_Type_RGBA;
  cColorBits := bmiAux.bmiHeader.biBitCount;
  cDepthBits := 32;
  iLayerType := pfd_Main_Plane;
  end;
FormatIndex := ChoosePixelFormat(hMemDC, @pfd);
  If not SetPixelFormat(hMemDC, FormatIndex, @pfd) then begin
  DeleteObject(hDIB);     DeleteDC(hMemDC);
  ShowMessage('DIB: Err2');
  Exit
  end;
{ 5. Create memory RC }
hMemRC := wglCreateContext(hMemDC);
  If hMemRC = 0 then begin
  DeleteObject(hDIB);    DeleteDC(hMemDC);
  ShowMessage('DIB: Err3');
  Exit
  end;
{ 6. Store old DC and RC }
hOldDc := wglGetCurrentDC;     hOldRC := wglGetCurrentContext;
{ 7. Make the memory RC current }
wglMakeCurrent(hMemDC, hMemRC);
{ 8. Draw the scene }
TestPaint;
glFinish;   { Дадим закончиться фун-ям OpenGL- иначе Access Violation }
{ 9. Release memory RC and restore the old DC and RC }
wglMakeCurrent(0, 0);
wglDeleteContext(hMemRC);
wglMakeCurrent(hOldDc, hOldRC);
{ 10. Copy and save the image }
bmpAux := TBitmap.Create;
bmpAux.Width := W1;   bmpAux.Height := H1;
StretchDIBits(bmpAux.Canvas.Handle, 0, 0, W1, H1,
0, 0, W1, H1, poBits, bmiAux, DIB_RGB_Colors, SRCCopy);
DeleteFile(BmpFileName);    { Удалим старый файл }
bmpAux.SaveToFile(BmpFileName);
{ 11. Release memory }
DeleteObject(hDIB);    DeleteDC(hMemDC);
{... Прочитаем картинку из записанного файла, и выведем на форму .....}
BBitmap := TBitmap.Create;
  With BBitmap do begin
  PixelFormat := pf24bit;
  Width := W1;    Height := H1;
  LoadFromFile(BmpFileName);
  end;
With ImageGL.Canvas do StretchDraw(ClipRect, BBitmap);
BBitmap.Free;
ShowMessage('OK 2 !');
end;

  //"скан-линия" выравнивается на размер DWORD
  cbPitch:= ((biWidth * biBitCount + 31) and not $1F{31}) div 8;
  biSizeImage := cbPitch * biHeight;
  //!!!biClrUsed и biClrImportant - и в полноцветном варианте имеют смысл(предпочтительная палитра)
  biClrUsed:= 0;
  biClrImportant:= 0;

function TFrameBuffer.GetBitmap: TBitmap;
var buf: Pointer;   l: PRGBLine;   b: ^TRGBTriple;   i,j, h,w: Integer;
  function PtrAllign(APointer: Pointer; bytes: cardinal): Pointer;
  begin
  Result := Ptr(cardinal(APointer) +
   (bytes - cardinal(APointer) mod bytes) mod bytes);
  end;
begin
w := width;   h := height;
result := TBitmap.Create;
result.PixelFormat := pf24bit;
result.Width := w;    result.Height := h;
GetMem(buf, w*h*3);
glBindTexture(GL_TEXTURE_2D, texture);
ZeroMemory(buf, w*h*3);
glGetTexImage(GL_TEXTURE_2D,0, GL_RGB,GL_UNSIGNED_BYTE, buf);
glBindTexture(GL_TEXTURE_2D,0);
b := buf;
  for i := h-1 downto 0 do begin
  l := result.ScanLine[i];
     for j:=0 to w-1 do begin
     l[j].rgbtBlue := b.rgbtRed;
     l[j].rgbtGreen := b.rgbtGreen;
     l[j].rgbtRed := b.rgbtBlue;
     Inc(b);
     end;
  b := PtrAllign(b,4);
  end;
FreeMemory(buf);
end;

function TFrameBuffer.GetBitmap: TBitmap;
var tbuf,buf,Pline: Pointer;   i,h,w: Integer;    waserror: boolean;
begin
waserror := TRUE;    buf := nil;
  Try
  w := width;   h := height;
  Result := TBitmap.Create;
  Result.PixelFormat := pf24bit;
  Result.Width := width;    Result.Height := height;
  GetMem(buf, w*h*3);
  glPixelStorei(GL_PACK_ALIGNMENT, 1);
  glBindTexture(GL_TEXTURE_2D, texture);
  glGetTexImage(GL_TEXTURE_2D, 0, GL_BGR, GL_UNSIGNED_BYTE, buf);
  tbuf := buf;
     For i := h-1 downto 0 do begin
     Pline := Result.ScanLine[i];
     Move(tbuf^, Pline^, w*3);
     Inc(NativeInt(tbuf), w*3);
     end;
  waserror := FALSE;
  finally
  If waserror then FreeAndNil(Result);
  FreeMemory(buf);
  end;
end;

function dglGetProcAddress(ProcName: PAnsiChar;
LibHandle: Pointer = nil): Pointer;
begin
If LibHandle = nil then LibHandle := GL_LibHandle;
Result := GetProcAddress(HMODULE(LibHandle), ProcName);
If result <> nil then exit;
If Addr(wglGetProcAddress) <> nil then
 Result := wglGetProcAddress(ProcName);
If Result = nil then ShowMessage('No Proc.ADDRES ' + ProcName);
end;

glGenRenderbuffersEXT(1, @depthb);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, depthb);

Res := glCheckFramebufferStatusEXT(GL_FRAMEBUFFER_EXT);

Res = GL_FRAMEBUFFER_COMPLETE_EXT

GL_RENDERBUFFER_EXT = $8D41;
......
type TglBindRenderbufferEXT = procedure(target: GLenum;
 renderbuffer: GLuint); stdcall;;
...................
var glBindRenderbufferEXT: TglBindRenderbufferEXT;

{= Получение контекста для вывода ф-ми OpenGL на экран ========}
function TFormMain.GetScreenContext(const CanHandle: THandle): HGLRC;
var nPixelFormat: Integer;   PFD: TPixelFormatDescriptor;
begin          { См. Краснов, Ex25 - MDI, Глава 1 }
{................. Устанавливаем формат пикселей .....................}
FillChar(PFD, SizeOf(PFD), 0);
  With PFD do begin
  nSize := SizeOf(PFD);   nVersion := 1;
  dwFlags := pfd_Draw_to_Window or pfd_Generic_Accelerated or
    pfd_Support_OpenGL or pfd_DoubleBuffer;
  iPixelType := pfd_Type_RGBA;
  cColorBits := 24;      cDepthBits := 32;
  iLayerType := pfd_Main_Plane;
  end;
nPixelFormat := ChoosePixelFormat(CanHandle, @PFD);
SetPixelFormat(CanHandle, nPixelFormat, @PFD);
Result := wglCreateContext(CanHandle);   { Rendering Context }
end;

{=============================================}
function TFormMain.DrawToText(ww,hh: Integer): TBitmap;
var FrameBuffer: TFrameBuffer;
var MyDC: HDC;      MainGLContext: HGLRC;
begin
Hide;       { Скрываем форму - чтобы рисовать на невидимом объекте }
MyDC := GetDC(Panel1.Handle);
MainGLContext := GetScreenContext(MyDC);
wglMakeCurrent(MyDC, MainGLContext);
FrameBuffer := TFrameBuffer.Create(ww, hh);
FrameBuffer.BindFrameBuffer;
TestPaint;   SwapBuffers(MyDC);
glFinish;
Result := FrameBuffer.GetBitmap;
FrameBuffer.UnbindFrameBuffer;
FrameBuffer.Free;
Sleep(300);  Show;   { Снова показываем форму }
end;

glGenRenderbuffersEXT(1, @depthb);
glBindRenderbufferEXT(GL_RENDERBUFFER_EXT, depthb);