|
#16
|
||||
|
||||
Разобрался с 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; Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#17
|
||||
|
||||
Продолжение:
Код:
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. Цитата:
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
Arvo (04.07.2012)
|
#18
|
|||
|
|||
*летаю от радости* наконец-то. Эх, сколько секретов таит в себе хе2
|