Code:
function GetDesktopBitsPerPixel: Integer;
var
DesktopDC: HDC;
begin
DesktopDC := GetDC(0);
try
Result := GetDeviceCaps(DesktopDC, BITSPIXEL) * GetDeviceCaps(DesktopDC, PLANES);
finally
ReleaseDC(0, DesktopDC);
end;
end;
function CreateGlWindow(title: PChar; width,height: integer; FullScreenflag: bool): boolean;
var
Pixelformat : GLuint;
wc : TWndclass;
dwExStyle : dword;
dwStyle : dword;
pfd : pixelformatdescriptor;
dmScreenSettings : Devmode;
h_Instance : hinst;
WindowRect : TRect;
bits : Integer;
begin
bits := GetDesktopBitsPerPixel;
WindowRect.Left := 0;
WindowRect.Top := 0;
WindowRect.Right := width;
WindowRect.Bottom := height;
h_instance := GetModuleHandle(nil);
FullScreen := FullScreenflag;
ViewPort.Width := width;
ViewPort.Height := height;
wc.style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
wc.lpfnWndProc := @WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := h_Instance;
wc.hIcon := LoadIcon(0,IDI_WINLOGO);
wc.hCursor := LoadCursor(0,IDC_ARROW);
wc.hbrBackground := 0;
wc.lpszMenuName := nil;
wc.lpszClassName := cClassName;
if RegisterClass(wc) = 0 then
begin
MessageBox(0,'Failed To Register The Window Class.','Error',MB_OK or MB_ICONERROR);
Result := false;
exit;
end;
if FullScreen then
begin
ZeroMemory( @dmScreenSettings, sizeof(dmScreenSettings) );
dmScreensettings.dmSize := sizeof(dmScreenSettings);
dmScreensettings.dmPelsWidth := width;
dmScreensettings.dmPelsHeight := height;
dmScreensettings.dmBitsPerPel := bits;
dmScreensettings.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN)) <> DISP_CHANGE_SUCCESSFUL then
begin
if MessageBox(0,'This FullScreen Mode Is Not Supported. Use Windowed Mode Instead?'
,'xeEngine',MB_YESNO or MB_ICONEXCLAMATION) = IDYES then
FullScreen := false
else
begin
MessageBox(0,'Program Will Now Close.','Error',MB_OK or MB_ICONERROR);
Result := False;
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 := CreateWindowEx(dwExStyle,
cClassName,
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: h_Wnd = 0','Error',MB_OK or MB_ICONEXCLAMATION);
Result := False;
Exit;
end;
pfd.nSize := SizeOf( PIXELFORMATDESCRIPTOR );
pfd.nVersion := 1;
pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
pfd.iPixelType := PFD_TYPE_RGBA;
pfd.cColorBits := bits;
pfd.cRedBits := 0;
pfd.cRedShift := 0;
pfd.cGreenBits := 0;
pfd.cBlueBits := 0;
pfd.cBlueShift := 0;
pfd.cAlphaBits := 0;
pfd.cAlphaShift := 0;
pfd.cAccumBits := 0;
pfd.cAccumRedBits := 0;
pfd.cAccumGreenBits := 0;
pfd.cAccumBlueBits := 0;
pfd.cAccumAlphaBits := 0;
pfd.cDepthBits := 16;
pfd.cStencilBits := 0;
pfd.cAuxBuffers := 0;
pfd.iLayerType := PFD_MAIN_PLANE;
pfd.bReserved := 0;
pfd.dwLayerMask := 0;
pfd.dwVisibleMask := 0;
pfd.dwDamageMask := 0;
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);
Result:=false;
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);
Result:=false;
exit;
end;
if (not SetPixelFormat(h_Dc,PixelFormat,@pfd)) then
begin
KillGLWindow;
MessageBox(0,'Cant''t set PixelFormat.','Error',MB_OK or MB_ICONEXCLAMATION);
Result := false;
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);
Result := false;
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);
Result := false;
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);
Result := false;
Exit;
end;
Result := true;
end;
In case it makes a difference, here is the include file that my window unit uses:
Reply With Quote
Bookmarks