OpenGL на Delphi XE2 ver. 3.0 final

Думаю это финальная версия

type
  TMethodOGL = class(TCustomAttribute)
  public
    Name: string;
    constructor Create(_Name: string);
  end;

  TOpenGLWFunc = class(TObject)
    [TMethodOGL('wglGetProcAddress')] GetProc: function(ProcName: PAnsiChar): Pointer; stdcall;
    wglSetPixelFormat: function(DC: HDC; PixelFormat: Integer;
      FormatDef: PPixelFormatDescriptor): Boolean; stdcall;
    wglSwapBuffers: function(DC: HDC): BOOL; stdcall;
    wglDescribePixelFormat: function(DC: HDC; p2: Integer; p3: UINT;
      var p4: TPixelFormatDescriptor): Boolean; stdcall;
    //methods
  end;

  TOpenGLFunc = class(TObject)
    glGetString: function(name: GLenum): PAnsiChar; stdcall;
    glBegin: procedure(const mode: GLenum); stdcall;
    glEnd: procedure; stdcall;
    glClearColor: procedure(const red, green, blue, alpha: GLfloat); stdcall;
    //methods
  end;

  TOpenGLWExtFunc = class(TObject)
    wglCreateContextAttribsARB: function(hDC: LongWord; hShareContext: LongWord;
        const attribList: PGLint): LongWord; stdcall;
    wglChoosePixelFormatARB: function(hdc: LongWord; const piAttribIList: PGLint;
      const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint;
      nNumFormats: PGLuint): LongBool; stdcall;
    //methods
  end;

  TOpenGLExt = class(TObject)
  strict private
    HGLRCARB: Cardinal;
    FLib: NativeUInt;
    function GetProc(const Name: PAnsiChar): Pointer;
    function Load(const Obj: TObject): Boolean;
  public
    func: TOpenGLFunc;
    wfunc: TOpenGLWFunc;
    wextfunc: TOpenGLWExtFunc;
    constructor Create(const DC: Cardinal);
    procedure BeforeDestruction; override;
  end;

constructor TMethodOGL.Create(_Name: string);
begin
  Name := _Name;
end;

procedure TOpenGLExt.BeforeDestruction;
begin
  inherited;
  Assert(wfunc.wglMakeCurrent(0, 0), 'wglMakeCurrent = False');
  Assert(wfunc.wglDeleteContext(HGLRCARB), 'wglMakeCurrent = False');
  func.Free;
  wfunc.Free;
  wextfunc.Free;
  FreeLibrary(HMODULE(FLib));
end;

constructor TOpenGLExt.Create(const DC: Cardinal);
{$J+}
const
  pfd: TPixelFormatDescriptor = (nSize: SizeOf(TPixelFormatDescriptor); nVersion: 1;
    dwFlags: PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType: PFD_TYPE_RGBA; cColorBits: 32; cRedBits: 0; cRedShift: 0; cGreenBits: 0; cGreenShift: 0;
    cBlueBits: 0; cBlueShift: 0; cAlphaBits: 0; cAlphaShift: 0; cAccumBits: 0;
    cAccumRedBits: 0; cAccumGreenBits: 0; cAccumBlueBits: 0; cAccumAlphaBits: 0;
    cDepthBits: 24; cStencilBits: 8; cAuxBuffers: 0; iLayerType: PFD_MAIN_PLANE;
    bReserved: 0; dwLayerMask: 0; dwVisibleMask: 0; dwDamageMask: 0);

  PixelaAttribList: array [0..14] of Integer = (
      WGL_DRAW_TO_WINDOW_ARB, GL_TRUE,
      WGL_SUPPORT_OPENGL_ARB, GL_TRUE,
      WGL_DOUBLE_BUFFER_ARB, GL_TRUE,
      WGL_PIXEL_TYPE_ARB, $202B,
      WGL_COLOR_BITS_ARB, 32,
      WGL_DEPTH_BITS_ARB, 24,
      WGL_STENCIL_BITS_ARB, 8, 0);

  ContextAttribList: array [0..6] of Integer = (WGL_CONTEXT_MAJOR_VERSION_ARB, 4,
    WGL_CONTEXT_MINOR_VERSION_ARB, 1,
    WGL_CONTEXT_FLAGS_ARB, $0002,
    0);

  PixelFormat: Integer = 0;
  PixelFormatARB: Integer = 0;
  NumFormatsARB: Integer = 0;
  HGLRC: Integer = 0;
{$J-}
var
  Ext, ExtARB: String;
begin
  inherited Create;

  func := TOpenGLFunc.Create;
  wfunc := TOpenGLWFunc.Create;
  wextfunc := TOpenGLWExtFunc.Create;

  FLib := LoadLibrary('opengl32.dll');
  Assert(FLib <> 0, 'LoadLibrary = 0');
  Assert(Load(wfunc), 'Load(wfunc) = False');

  PixelFormat := ChoosePixelFormat(DC, @pfd);
  Assert(PixelFormat <> 0, 'ChoosePixelFormat = 0');
  Assert(SetPixelFormat(DC, PixelFormat, @pfd), 'SetPixelFormat = False');

  HGLRC := wfunc.wglCreateContext(DC);
  Assert(HGLRC <> 0, 'HGLRC = 0');
  HGLRCARB := HGLRC;
  Assert(wfunc.wglMakeCurrent(DC, HGLRC), 'wglMakeCurrent = False');

  Assert(Load(func), 'Load(func) = False');

  Writeln(func.glGetString(GL_VENDOR));
  Writeln(func.glGetString(GL_RENDERER));
  Writeln(func.glGetString(GL_VERSION));
  Writeln(func.glGetString(GL_SHADING_LANGUAGE_VERSION));
  Ext := func.glGetString(GL_EXTENSIONS);
  Writeln(Ext);

  Load(wextfunc);

  ExtARB := wextfunc.wglGetExtensionsStringARB(DC);
  Writeln(ExtARB);

  if (Pos('WGL_ARB_pixel_format', ExtARB) <> 0) and (Pos('WGL_ARB_create_context_profile', ExtARB) <> 0) then
  begin
    Assert(wfunc.wglMakeCurrent(0, 0), 'wglMakeCurrent = False');
    Assert(wfunc.wglDeleteContext(HGLRC), 'wglMakeCurrent = False');
    Assert(wextfunc.wglChoosePixelFormatARB(DC, @PixelaAttribList, nil, 1,
      @PixelFormatARB, @NumFormatsARB), 'wglChoosePixelFormatARB = False');
    HGLRCARB := wextfunc.wglCreateContextAttribsARB(DC, 0, nil);
    Assert(HGLRCARB <> 0, 'HGLRCARB = 0');
    Assert(wextfunc.wglMakeContextCurrentARB(DC, DC, HGLRCARB), 'wglMakeCurrent = False');
  end;
end;

function TOpenGLExt.GetProc(const Name: PAnsiChar): Pointer;
begin
  if FLib = 0 then Exit(nil);
  Result := GetProcAddress(FLib, Name);
  if Result <> nil then Exit;
  if Addr(wfunc.GetProc) <> nil then
    Result := wfunc.GetProc(Name);
end;

function TOpenGLExt.Load(const Obj: TObject): Boolean;
var
  Field: TArray<TRttiField>;
  I: Integer;
begin
  Result := False;
  Field := Rtti.GetType(Obj.ClassType).GetFields;
  for I := 0 to Length(Field) - 1 do
    with Field[I] do
    begin
      if Length(GetAttributes) <> 0 then
        PPointer(Integer(Obj) + Offset)^ := GetProc(PAnsiChar(AnsiString(TMethodOGL(GetAttributes[0]).Name)))
      else
        PPointer(Integer(Obj) + Offset)^ := GetProc(PAnsiChar(AnsiString(Name)));
      Result := PPointer(Integer(Obj) + Offset)^ <> nil;
      Writeln(Name, ' -> ', Result);
//      if not Result then Exit
    end;
end;

Раньше нам необходимо было указывать точное имя метода, и использовать его в коде, но теперь возможно указать ему любое имя и применить к нему атрибут TMethodOGL. Т.е. раньше объявление метода было таким

  
  TOpenGLWFunc = class(TObject)
    wglGetProcAddress: function(ProcName: PAnsiChar): Pointer; stdcall;

а стало таким

  
  TOpenGLWFunc = class(TObject)
    [TMethodOGL('wglGetProcAddress')] GetProc: function(ProcName: PAnsiChar): Pointer; stdcall;

И вызов поменялся соответственно

    
 if Addr(wfunc.GetProc) <> nil then
    Result := wfunc.GetProc(Name);

хотя вызываем всё так же wglGetProcAddress.