Тема: Текст OpenGL
Показать сообщение отдельно
  #17  
Старый 04.07.2012, 01:02
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

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

Код:
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.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием