18 дек. 2011 г.

Инициализация OpenGL на Delphi XE2 ver. 2.0

Прошлая версия была не очень удачной.
Выкладываю полный код.

{$REGION 'Types OpenGL'}
type
  GLenum = Cardinal;
  GLboolean = BYTEBOOL;
  GLbitfield = Cardinal;
  GLbyte = Shortint;
  GLshort = SmallInt;
  GLint = Integer;
  GLsizei = Integer;
  GLubyte = Byte;
  GLushort = Word;
  GLuint = Cardinal;
  GLfloat = Single;
  GLclampf = Single;
  GLdouble = Double;
  GLclampd = Double;
  GLvoid = Pointer;
  GLint64 = Int64;

  PGLenum = ^GLenum;
  PGLboolean = ^GLboolean;
  PGLbitfield = ^GLbitfield;
  PGLbyte = ^GLbyte;
  PGLshort = ^GLshort;
  PGLint = ^GLint;
  PGLsizei = ^GLsizei;
  PGLubyte = ^GLubyte;
  PGLushort = ^GLushort;
  PGLuint = ^GLuint;
  PGLfloat = ^GLfloat;
  PGLclampf = ^GLclampf;
  PGLdouble = ^GLdouble;
  PGLclampd = ^GLclampd;
  PGLvoid = ^GLvoid;
  PGLint64 = ^GLint64;

const
  GL_TRUE = 1;
  GL_FALSE = 0;
{$ENDREGION}

type
  TOpenGLWFunc = class(TObject)
    wglGetProcAddress: 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;
    wglGetPixelFormat: function(DC: HDC): Integer; stdcall;
    wglGetDefaultProcAddress: function(ProcName: PAnsiChar): Pointer; stdcall;
    wglChoosePixelFormat: function(DC: HDC; p2: PPixelFormatDescriptor): Integer; stdcall;
    wglCopyContext: function(p1: HGLRC; p2: HGLRC; p3: Cardinal): Boolean; stdcall;
    wglCreateContext: function(DC: HDC): HGLRC; stdcall;
    wglCreateLayerContext: function(p1: HDC; p2: Integer): HGLRC; stdcall;
    wglDeleteContext: function(p1: HGLRC): Boolean; stdcall;
    wglDescribeLayerPlane: function(p1: HDC; p2, p3: Integer; p4: Cardinal;
      p5: PLayerPlaneDescriptor): Boolean; stdcall;
    wglGetCurrentContext: function: HGLRC; stdcall;
    wglGetCurrentDC: function: HDC; stdcall;
    wglGetLayerPaletteEntries: function(p1: HDC; p2, p3, p4: Integer;
      var pcr): Integer; stdcall;
    wglMakeCurrent: function(DC: HDC; p2: HGLRC): Boolean; stdcall;
    wglRealizeLayerPalette: function(p1: HDC; p2: Integer;
      p3: Boolean): Boolean; stdcall;
    wglSetLayerPaletteEntries: function(p1: HDC; p2, p3, p4: Integer;
      var pcr): Integer; stdcall;
    wglShareLists: function(p1, p2: HGLRC): Boolean; stdcall;
    wglSwapLayerBuffers: function(p1: HDC; p2: Cardinal): Boolean; stdcall;
    wglUseFontBitmapsA: function(DC: HDC; p2, p3, p4: Cardinal): Boolean; stdcall;
    wglUseFontBitmapsW: function(DC: HDC; p2, p3, p4: Cardinal): Boolean; stdcall;
//      WTF
//      wglSwapMultipleBuffers: function(p1: UINT;
//        const p2: PWGLSWAP): Cardinal; stdcall;
//      wglUseFontOutlineA
//      wgluseFontOutlineW
  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;
    glColor3f: procedure(const red, green, blue: GLfloat); stdcall;
    glColor3fv: procedure(const v: PGLfloat); stdcall;
    glVertex2f: procedure(const x, y: GLfloat); stdcall;
    glVertex2fv: procedure(const v: PGLfloat); stdcall;
    glLoadIdentity: procedure; stdcall;
    glMatrixMode: procedure(mode: GLenum); stdcall;
    glOrtho: procedure(left, right, bottom, top, zNear, zFar: GLdouble); stdcall;
    glColor4fv: procedure(const v: PGLfloat); stdcall;
    glColor4f: procedure(x, y, z, w: GLfloat); stdcall;
    glClear: procedure(mask: GLenum); stdcall;
    glCompressedTexImage2D: procedure(target: GLenum; level: GLint;
      internalformat: GLenum; width, height: GLsizei; border: GLint;
      imageSize: GLsizei; const data: PGLvoid); stdcall;
    glTexImage2D: procedure(target: GLenum; level: GLint; internalformat: GLint;
      width, height: GLsizei; border: GLint; format: GLenum; _type: GLenum;
      const pixels: PGLvoid); stdcall;
    glGenTextures: procedure(n: GLsizei; textures: PGLuint); stdcall;
    glBindTexture: procedure(target: GLenum; texture: GLuint); stdcall;
    glPixelStoref: procedure(pname: GLenum; param: GLfloat); stdcall;
    glTexParameterf: procedure(target: GLenum; pname: GLenum;
      param: GLfloat); stdcall;
    glTexCoord2f: procedure(s, T: GLfloat); stdcall;
    glTexCoord2fv: procedure(const v: PGLfloat); stdcall;
    glEnable: procedure(cap: GLenum); stdcall;
    glDisable: procedure(cap: GLenum); stdcall;
    glBlendFunc: procedure(sfactor: GLenum; dfactor: GLenum); stdcall;
    glTranslatef: procedure(x, y, z: GLfloat); stdcall;
    glScalef: procedure(x, y, z: GLfloat); stdcall;
    glRotatef: procedure(angle, x, y, z: GLfloat); stdcall;
    glTexCoordPointer: procedure(size: GLint; _type: GLenum; stride: GLsizei;
      const Pointer: GLvoid); stdcall;
    glVertexPointer: procedure(size: GLint; _type: GLenum; stride: GLsizei;
      const Pointer: GLvoid); stdcall;
    glNormalPointer: procedure(_type: GLenum; stride: GLsizei;
      const Pointer: GLvoid); stdcall;
    glEnableClientState: procedure(cap: GLenum); stdcall;
    glDisableClientState: procedure(cap: GLenum); stdcall;
    glDrawElements: procedure(mode: GLenum; count: GLsizei; _type: GLenum;
      const indices: GLvoid); stdcall;
    glColorPointer: procedure(size: GLint; _type: GLenum; stride: GLsizei;
      const Pointer: GLvoid); stdcall;
    glGenBuffers: procedure(n: GLsizei; buffers: PGLuint); stdcall;
    glDeleteBuffers: procedure(n: GLsizei; const buffers: PGLuint); stdcall;
    glBindBuffer: procedure(target: GLenum; buffer: GLuint); stdcall;
    glBufferData: procedure(target: GLenum; size: GLsizei; const data: GLvoid;
      usage: GLenum); stdcall;
    glMapBuffer: function(target: GLenum; access: GLenum): GLvoid; stdcall;
    glUnmapBuffer: function(target: GLenum): GLboolean; stdcall;
    glPushMatrix: procedure; stdcall;
    glPopMatrix: procedure; stdcall;
    glFrontFace: procedure(mode: GLenum); stdcall;
    glGetFloatv: procedure(pname: GLenum; params: PGLfloat); stdcall;
    glGetIntegerv: procedure(pname: GLenum; params: PGLint); stdcall;
    glTexEnvf: procedure(target, pname: GLenum; param: GLfloat); stdcall;
    glDeleteTextures: procedure(n: GLsizei; const textures: PGLuint); stdcall;
    glViewport: procedure(const x, y: GLint; const width, height: GLsizei); stdcall;
    glTranslated: procedure(x, y, z: GLdouble); stdcall;
    glScaled: procedure(x, y, z: GLdouble); stdcall;
    glRotated: procedure(angle, x, y, z: GLdouble); stdcall;
    glPolygonMode: procedure(face: GLenum; mode: GLenum); stdcall;
    glLineWidth: procedure(width: GLfloat); stdcall;
    glPointSize: procedure(size: GLfloat); stdcall;
  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;
    wglGetExtensionsStringARB: function(hdc: LongWord): PAnsiChar; stdcall;
    wglGetPixelFormatAttribivARB: function(hdc: HDC;
      iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint;
      const piAttributes: PGLint; piValues: PGLint): Boolean; stdcall;
    wglMakeContextCurrentARB: function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): Boolean; stdcall;
    wglGetCurrentReadDCARB: function(): HDC; stdcall;
  end;

  TOpenGLExt = class(TObject)
  strict private
    HGLRCARB: Cardinal;
    FRtti: TRttiContext;
    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;
procedure TOpenGLExt.BeforeDestruction;
begin
  inherited;
  Assert(wfunc.wglMakeCurrent(0, 0), 'wglMakeCurrent = False');
  Assert(wfunc.wglDeleteContext(HGLRCARB), 'wglMakeCurrent = False');
  FRtti.Free;
  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;
//  TempWnd: Cardinal = 0;
//  TempDC: Cardinal = 0;
{$J-}
var
  Ext, ExtARB: String;
begin
  inherited Create;
  FRtti := TRttiContext.Create;

//  TempWnd := CreateWindow('BUTTON', nil, 0, 0, 0, 0, 0, 0, 0, 0, nil);
//  Assert(TempWnd <> 0, 'Temp windows is not created');
//  TempDC := GetDC(tempWnd);
//  Assert(TempDC <> 0, 'Temp dc windows is not created');

  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(DestroyWindow(TempWnd), 'Temp window is not destroy');
    Assert(wextfunc.wglChoosePixelFormatARB(DC, @PixelaAttribList, nil, 1,
      @PixelFormatARB, @NumFormatsARB), 'wglChoosePixelFormatARB = False');
//    Assert(SetPixelFormat(DC, PixelFormatARB, nil), 'SetPixelFormat = 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(NativeUInt(FLib), Name);
  if Result <> nil then Exit;
  if Addr(wfunc.wglGetProcAddress) <> nil then
    Result := wfunc.wglGetProcAddress(Name);
end;

function TOpenGLExt.Load(const Obj: TObject): Boolean;
var
  Field: TArray<TRttiField>;
  I: Integer;
begin
  Result := False;
  Field := FRtti.GetType(Obj.ClassType).GetFields;
  for I := 0 to Length(Field) - 1 do
    with Field[I] do
    begin
      PPointer(Integer(Obj) + Offset)^ := GetProc(PAnsiChar(AnsiString(Name)));
      Result := Pointer(Pointer(Integer(Obj) + Offset)^) <> nil;
      Writeln(Name, ' -> ', Result);
//      if not Result then Exit
    end;
end;
Комментарии не стал делать. Если нужно будет - напишу.

Комментариев нет:

Отправить комментарий