[angvelem]

Разобрался с XE2:

Код:

program lesson14a;

uses
  Windows, Messages, sysutils, OpenGL;

var
  h_Rc		: HGLRC;
  h_Dc		: HDC;
  h_Wnd		: HWND;
  keys		: array[0..255] of Boolean;
  Active	: Boolean = True;
  FullScreen	: Boolean = true;
  base		: GLuint;
  rot		: GLfloat = 0.01;
  gmf		: array[Byte] of GLYPHMETRICSFLOAT;
  Color		: Glfloat = 0.0;
  ColorShowDelay	: Glfloat = 0.0;
  ColorNightDelay	: Glfloat = 0.0;
  ColorInverse	: Boolean = False;
  ColorPause	: Boolean = False;
  ColorNight	: Boolean = False;

procedure BuildFont;
var
  Font: HFONT;
begin
  base := glGenLists(256);
  font := CreateFontA(-MulDiv(12, GetDeviceCaps(h_DC, LOGPIXELSY), 72),
                      0, 0, 0, FW_BOLD, 0, 0, 0,
                      ANSI_CHARSET or RUSSIAN_CHARSET,
                      OUT_TT_PRECIS,
                      CLIP_DEFAULT_PRECIS,
                      ANTIALIASED_QUALITY,
                      FF_DONTCARE or DEFAULT_PITCH,
                      'Courier New CYR');
  SelectObject(h_dc, font);
  wglUseFontOutlinesA(h_dc, 0, 255, base, 0, 0, WGL_FONT_POLYGONS, @gmf);
end;

procedure KillFont;
begin
  glDeleteLists(base, 256);
end;

procedure glPrint(Text : AnsiString);
var
  len  : glfloat;
  loop : integer;
begin
  if text = '' then
    Exit;
  len := 0;
  for loop := 1 to length(text) - 1 do
    len := len + gmf[loop].gmfCellIncX;
  glTranslatef(-len / 2, 0.0, 0.0);
  glPushAttrib(GL_LIST_BIT);
  glListBase(base);
  glCallLists(Length(text), GL_UNSIGNED_BYTE, PAnsiChar(Text));
  glPopAttrib;
end;

procedure ReSizeGLScene(Width: GLsizei; Height: GLsizei);
begin
  if Height = 0 then
    Height := 1;
  glViewport(0, 0, Width, Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, Width / Height, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;


function InitGL : Boolean;
begin
  glShadeModel(GL_SMOOTH);
  glClearColor(0.0, 0.0, 0.0, 0.5);
  glClearDepth(1.0);
  glEnable(GL_DEPTH_TEST);
  glDepthFunc(GL_LEQUAL);
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
  glEnable(GL_LIGHT0);
  glEnable(GL_LIGHTING);
  glEnable(GL_COLOR_MATERIAL);
  BuildFont;
  Result := True;
end;

function DrawGLScene : Boolean;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;
  glTranslatef(0, 0, -30);

  if ColorPause then
  begin
    ColorShowDelay := ColorShowDelay + rot;
    if ColorShowDelay >= 2.0 then
    begin
      ColorShowDelay := 0.0;
      ColorPause := False;
    end;
  end
  else if ColorNight then
  begin
    ColorNightDelay := ColorNightDelay + rot;
    if ColorNightDelay >= 5.0 then
    begin
      ColorNightDelay := 0.0;
      ColorNight := False;
    end;
  end
  else
  begin
    if not ColorInverse then
    begin
      Color := Color + rot;
      if Color >= 1.0 then
      begin
        ColorInverse := True;
        ColorPause := True;
      end;
    end
    else
    begin
      Color := Color - rot;
      if Color <= 0.0 then
      begin
        ColorInverse := False;
        ColorNight := True;
      end
    end;
  end;

  glColor3f(0.0, Color, Color);
  glPrint('Всё Круто');
  Result := True;
end;


function WndProc(Wnd : HWND; Msg, wParam, lParam : Longint) : Longint; stdcall;
begin
  Result := 0;
  
  case Msg of
    WM_SYSCOMMAND :
    begin
      case wParam of
        SC_SCREENSAVE,
        SC_MONITORPOWER : Exit;
      end;
    end;

    WM_ACTIVATE :
    begin
      if Hiword(wParam) = 0 then
        Active := True
      else
        Active := False;
      Exit;
    end;

    WM_CLOSE :
    begin
      PostQuitMessage(0);
      Exit;
    end;

    WM_KEYDOWN :
    begin
      keys[wParam] := True;
      Exit;
    end;

    WM_KEYUP :
    begin
      keys[wParam] := False;
      Exit;
    end;

    WM_SIZE :
    begin
      ReSizeGLScene(LOWORD(lParam), HIWORD(lParam));
      Exit;
    end;
  end;
  Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;

procedure KillGLWindow;
begin
  if FullScreen then
  begin
    ChangeDisplaySettings(devmode(NIL^), 0);
    ShowCursor(True);
  end;

  if h_rc <> 0 then
  begin
    if not wglMakeCurrent(h_Dc, 0) then
      MessageBox(0, 'Release of DC and RC failed.', ' Shutdown Error', MB_OK or MB_ICONERROR);

    if not wglDeleteContext(h_Rc) then
    begin
      MessageBox(0, 'Release of Rendering Context failed.', ' Shutdown Error', MB_OK or MB_ICONERROR);
      h_Rc := 0;
    end;
  end;

  if (h_Dc = 1) and (ReleaseDC(h_Wnd, h_Dc) <> 0) then
  begin
    MessageBox(0, 'Release of Device Context failed.', ' Shutdown Error', MB_OK or MB_ICONERROR);
    h_Dc := 0;
  end;

  if (h_Wnd <> 0) and (not DestroyWindow(h_Wnd)) then
  begin
    MessageBox(0, 'Could not release hWnd.', ' Shutdown Error', MB_OK or MB_ICONERROR);
    h_Wnd := 0;
  end;

  if not UnregisterClass('OpenGL', hInstance) then
    MessageBox(0, 'Could Not Unregister Class.', 'SHUTDOWN ERROR', MB_OK or MB_ICONINFORMATION);
  KillFont;
end;

function DoRegister : Boolean;
var
  WC : TWndClass;
begin
  wc.style		:= CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
  wc.lpfnWndProc	:= @WndProc;
  wc.cbClsExtra		:= 0;
  wc.cbWndExtra		:= 0;
  wc.hInstance		:= hInstance;
  wc.hIcon		:= LoadIcon(0, IDI_WINLOGO);
  wc.hCursor		:= LoadCursor(0, IDC_ARROW);
  wc.hbrBackground	:= GetStockObject(BLACK_BRUSH);
  wc.lpszMenuName	:= '';
  wc.lpszClassName	:= 'OpenGl';

  Result := RegisterClass(wc) <> 0;
end;

[angvelem]

Продолжение:

Код:

function CreateGlWindow(title: PAnsiChar; width, height, bits : Integer; FullScreenflag : Boolean) : Boolean; stdcall;
var
  Pixelformat      : GLuint;
  dwExStyle        : dword;
  dwStyle          : dword;
  pfd              : pixelformatdescriptor;
  dmScreenSettings : Devmode;
  WindowRect       : TRect;
begin
  Result := False;
  
  SetRect(WindowRect, 0, 0, width, height);

  FullScreen := FullScreenflag;

  if not DoRegister then
  begin
    MessageBox(0, 'Failed To Register The Window Class.', 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  if FullScreen then
  begin
    ZeroMemory(@dmScreenSettings, sizeof(dmScreenSettings));
    with dmScreensettings do
    begin
      dmSize       := sizeof(dmScreenSettings);
      dmPelsWidth  := width;
      dmPelsHeight := height;
      dmBitsPerPel := bits;
      dmFields     := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
    end;

    if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN)) <> DISP_CHANGE_SUCCESSFUL then
    begin
      if MessageBox(0, 'This FullScreen Mode Is Not Supported. Use Windowed Mode Instead?'
                    ,'NeHe GL', MB_YESNO or MB_ICONEXCLAMATION) = IDYES then
        FullScreen := False
      else
      begin
        MessageBox(0, 'Program Will Now Close.', 'Error', MB_OK or MB_ICONERROR);
        Exit;
      end;
    end;
  end;

  if FullScreen then
  begin
    dwExStyle := WS_EX_APPWINDOW;
    dwStyle   := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
    Showcursor(False);
  end
  else
  begin
    dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
    dwStyle   := WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
  end;

  AdjustWindowRectEx(WindowRect, dwStyle, False, dwExStyle);

  H_wnd := CreateWindowExA(dwExStyle, 'OpenGl', PAnsiChar(Title), dwStyle,
                          0, 0, WindowRect.Right - WindowRect.Left, WindowRect.Bottom - WindowRect.Top,
                          0, 0, hinstance, NIL);

  if h_Wnd = 0 then
  begin
    KillGlWindow;
    MessageBox(0, 'Window creation error.', ' Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do
  begin
    nSize      := SizeOf(PIXELFORMATDESCRIPTOR);
    nVersion   := 1;
    dwFlags    := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := bits;
    cDepthBits := 16;
    iLayerType := PFD_MAIN_PLANE;
  end;

  h_Dc := GetDC(h_Wnd);
  if h_Dc = 0 then
  begin
    KillGLWindow;
    MessageBox(0, 'Cant''t create a GL device context.', 'Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  PixelFormat := ChoosePixelFormat(h_Dc, @pfd);
  if PixelFormat = 0 then
  begin
    KillGLWindow;
    MessageBox(0, 'Cant''t Find A Suitable PixelFormat.', 'Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  if not SetPixelFormat(h_Dc, PixelFormat, @pfd) then
  begin
    KillGLWindow;
    MessageBox(0, 'Cant''t set PixelFormat.', 'Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  h_Rc := wglCreateContext(h_Dc);
  if h_Rc = 0 then
  begin
    KillGLWindow;
    MessageBox(0, 'Cant''t create a GL rendering context.', 'Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  if not wglMakeCurrent(h_Dc, h_Rc) then
  begin
    KillGLWindow;
    MessageBox(0, 'Cant''t activate the GL rendering context.', 'Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  ShowWindow(h_Wnd, SW_SHOW);
  SetForegroundWindow(h_Wnd);
  SetFocus(h_Wnd);

  ReSizeGLScene(width, height);

  if not InitGl then
  begin
    KillGLWindow;
    MessageBox(0, 'initialization failed.', 'Error', MB_OK or MB_ICONEXCLAMATION);
    Exit;
  end;

  Result := True;
end;

procedure WinMain;
var
  msg  : TMsg;
  done : Boolean;
begin
  done := False;

  if MessageBox(0, 'Would You Like To Run In FullScreen Mode?', 'Start FullScreen',
                MB_YESNO or MB_ICONQUESTION) = IDNO then
    FullScreen := False
  else
    FullScreen := True;

  if not CreateGLWindow('NeHe''s OpenGL Framework', 640, 480, 16, FullScreen) then
    Exit;

  while not done do
  begin
    if PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
    begin
      if msg.message = WM_QUIT then
        done := True
      else
      begin
        TranslateMessage(msg);
        DispatchMessage(msg);
      end;
    end
    else
    begin
      if (active and not DrawGLScene) or keys[VK_ESCAPE] then
        done := True
      else
        SwapBuffers(h_Dc);

      if keys[VK_F1] then
      begin
        Keys[VK_F1] := False;
        KillGLWindow;
        FullScreen := not FullScreen;

        if not CreateGLWindow('NeHe''s OpenGL Framework', 640, 480, 16, fullscreen) then
          Exit;
      end;
    end;
  end;
 
  killGLwindow;
end;

begin
  WinMain;
end.

неизвестный тип PTAUX_RGBImageRec и неизвестная функция auxDIBImageLoadA

Это нужно для загрузки картинки, но удобнее использовать OleLoadPicture.

[Arvo]

*летаю от радости* наконец-то. Эх, сколько секретов таит в себе хе2