|
#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 в.д. |