SQLRU.net
Разработка приложений баз данных

Начало » Программирование » Delphi » Get OpenGL Version
Get OpenGL Version [сообщение #692] Thu, 29 September 2022 09:48
BlackEric в настоящее время не в онлайне  BlackEric
Сообщений: 368
Зарегистрирован: June 2022
Senior Member
Старый исходник получения версии OpenGL. Вдруг кому будет полезно.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OpenGL, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    glContext: HGLRC;
    glDC: HDC;
    errorCode: GLenum;
    openGLReady: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;

  Memo1.Lines.Add('OpenGL vendor: ' + glGetString(GL_VENDOR));
  Memo1.Lines.Add('OpenGL renderer: ' + glGetString(GL_RENDERER));
  Memo1.Lines.Add('OpenGL version: ' + glGetString(GL_VERSION));
  Memo1.Lines.Add('Supported OpenGL extensions: ' + glGetString(GL_EXTENSIONS));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  pfd: TPixelFormatDescriptor;
  FormatIndex: integer;
begin
  fillchar(pfd, SizeOf(pfd), 0);
  with pfd do
  begin
    nSize := SizeOf(pfd);
    nVersion := 1; { The current version of the desccriptor is 1 }
    dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 24; { support 24-bit color }
    cDepthBits := 32; { depth of z-axis }
    iLayerType := PFD_MAIN_PLANE;
  end; { with }
  glDC := getDC(handle);
  FormatIndex := ChoosePixelFormat(glDC, @pfd);
  if FormatIndex = 0 then
    raise Exception.Create('ChoosePixelFormat failed ' + IntToStr(GetLastError)
      );
  if not SetPixelFormat(glDC, FormatIndex, @pfd) then
    raise Exception.Create('SetPixelFormat failed ' + IntToStr(GetLastError));
  glContext := wglCreateContext(glDC);
  if glContext = 0 then
    raise Exception.Create('wglCreateContext failed ' + IntToStr(GetLastError));
  if not wglMakeCurrent(glDC, glContext) then
    raise Exception.Create('wglMakeCurrent failed ' + IntToStr(GetLastError));
  openGLReady := true;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglMakeCurrent(Canvas.handle, 0);
  wglDeleteContext(glContext);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  { if not openGLReady then
    exit;
    //background
    glClearColor(0.1,0.4,0.0,0.0);
    glClear(GL_COLOR_BUFFER_BIT);
    //error checking
    errorCode:=glGetError;
    if errorCode<>GL_NO_ERROR then
    raise Exception.Create('Error in Paint'#13+gluErrorString(errorCode));
    glFlush; }
end;

end.

 
Сообщение не прочитано
Предыдущая тема: ping
Следующая тема: Fastreport OnBeforePrint source code
Переход к форуму:
  


Текущее время: Wed Dec 18 20:18:49 GMT+3 2024

Общее время, затраченное на создание страницы: 0.01072 секунд