Code:
unit UOpenGL3xWindow;
interface
uses
Windows, Messages, Classes,
UGlobal, dglOpenGL;
type
{ .: TResizeEvent :. }
TResizeEvent = procedure(const NewX, NewY: Cardinal) of object;
{ .: TOpenGL3xWindow :. }
TOpenGL3xWindow = class sealed(TDaguObject)
private
{ Private declarations }
FWidth: Cardinal;
FHeight: Cardinal;
FCaption: String;
FFullScreen: Boolean;
FX: Cardinal;
FY: Cardinal;
FOnResize: TResizeEvent;
FOnMove: TResizeEvent;
FOnDestroy: TEvent;
FOnCreate: TEvent;
FOnIdle: TEvent;
procedure SetWndParams(const Index: Integer; const Value: Cardinal);
procedure SetCaption(const Value: String);
private
{ Private declarations }
WndProcPtr: Pointer;
WndHandle: HWND;
h_Instance: HINST;
DC: HDC;
RC: HGLRC;
IsMinimized: Boolean;
IsOGLInit: Boolean;
function CreateWnd(): Boolean;
function FreeWnd(): Boolean;
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
function MainFunction(): Integer;
public
{ Public declarations }
constructor Create(const AFullScreen: Boolean = False);
destructor Destroy(); override;
procedure CenterWindow();
procedure VerticalSync(const Activate: Boolean);
function Run(): Integer;
procedure Assign(const Source: TDaguObject); override;
procedure SaveToStream(const S: TStream); override;
procedure LoadFromStream(const S: TStream); override;
property Width: Cardinal index 0 read FWidth write SetWndParams;
property Height: Cardinal index 1 read FHeight write SetWndParams;
property X: Cardinal index 2 read FX write SetWndParams;
property Y: Cardinal index 3 read FY write SetWndParams;
property Caption: String read FCaption write SetCaption;
property FullScreen: Boolean read FFullScreen;
property OpenGLInitialized: Boolean read IsOGLInit;
property OnCreate: TEvent read FOnCreate write FOnCreate;
property OnDestroy: TEvent read FOnDestroy write FOnDestroy;
property OnResize: TResizeEvent read FOnResize write FOnResize;
property OnMove: TResizeEvent read FOnMove write FOnMove;
property OnIdle: TEvent read FOnIdle write FOnIdle;
end;
implementation
uses
SysUtils;
{ TOpenGL3xWindow }
procedure TOpenGL3xWindow.Assign(const Source: TDaguObject);
var
S: TOpenGL3xWindow;
begin
inherited Assign(Source);
if ((Assigned(Source)) and (Source is TOpenGL3xWindow)) then
begin
S := TOpenGL3xWindow(Source as TOpenGL3xWindow);
Self.SetWndParams(0, S.Width);
Self.SetWndParams(1, S.Height);
Self.SetWndParams(2, S.X);
Self.SetWndParams(3, S.Y);
FCaption := S.Caption;
FFullScreen := S.FullScreen;
IsOGLInit := S.OpenGLInitialized;
WndHandle := S.WndHandle;
WndProcPtr := S.WndProcPtr;
DC := S.DC;
RC := S.RC;
h_Instance := S.h_Instance;
FOnResize := S.OnResize;
FOnMove := S.OnMove;
FOnCreate := S.OnCreate;
FOnDestroy := S.OnDestroy;
FOnIdle := S.OnIdle;
end;
end;
procedure TOpenGL3xWindow.CenterWindow;
var
ScreenWidth, ScreenHeight: Cardinal;
begin
ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
SetWndParams(2, (ScreenWidth - FWidth) div 2);
SetWndParams(3, (ScreenHeight - FHeight) div 2);
end;
constructor TOpenGL3xWindow.Create(const AFullScreen: Boolean);
begin
inherited Create();
WndProcPtr := MethodToProcedure(Self, @TOpenGL3xWindow.WndProc);
h_Instance := GetModuleHandle(nil);
FWidth := 800;
FHeight := 600;
CenterWindow();
WndHandle := 0;
FCaption := BrainEngineString;
FFullScreen := AFullScreen;
RC := 0;
DC := 0;
IsMinimized := False;
IsOGLInit := False;
FOnResize := nil;
FOnMove := nil;
FOnCreate := nil;
FOnDestroy := nil;
FOnIdle := nil;
end;
function TOpenGL3xWindow.CreateWnd: Boolean;
var
WndClass: TWndClass;
dwStyle, dwExStyle: DWORD;
dmScreenSettings: DEVMODE;
PixelFormat: Cardinal;
PFD: TPIXELFORMATDESCRIPTOR;
TempRC: HGLRC;
OGLAttr: array[0..6] of Cardinal;
begin
Result := False;
{$IFDEF DEBUG}
Log(SystemInformation());
{$ENDIF}
if (not InitOpenGL()) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to initialize OpenGL');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to initialize OpenGL');
{$ENDIF}
exit;
end;
ZeroMemory(@WndClass, SizeOf(WndClass));
FreeWnd();
// Window class creation
with WndClass do
begin
style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
lpfnWndProc := WndProcPtr;
hInstance := h_Instance;
hCursor := LoadCursor(0, IDC_ARROW);
lpszClassName := 'BrainEngineWnd';
end;
if (Windows.RegisterClass(WndClass) = 0) then
exit;
// Fullscreen setup
if (FFullScreen) then
begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do
begin
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := FWidth;
dmPelsHeight := FHeight;
dmBitsPerPel := 32;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
end;
if (ChangeDisplaySettings(dmScreenSettings,
CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
begin
FFullScreen := False;
{$IFDEF DEBUG}
ThrowAndLog('Unable to switch to fullscreen');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to switch to fullscreen');
{$ENDIF}
end;
end;
// Window properties setup
if (FFullScreen) then
begin
dwStyle := WS_POPUP or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW;
FX := 0;
FY := 0;
end else
begin
dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
end;
// Window handle creation
WndHandle := CreateWindowEx(dwExStyle, 'BrainEngineWnd', PChar(FCaption),
dwStyle, FX, FY, FWidth, FHeight, 0, 0, h_Instance, nil);
if (WndHandle = 0) then
exit;
// Getting a DC
DC := GetDC(WndHandle);
if (DC = 0) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to get a device context');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to get a device context');
{$ENDIF}
exit;
end;
// Setting the pixel format
with PFD do
begin
nSize := SizeOf(TPIXELFORMATDESCRIPTOR);
nVersion := 1;
dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := 32;
cRedBits := 0;
cRedShift := 0;
cGreenBits := 0;
cGreenShift := 0;
cBlueBits := 0;
cBlueShift := 0;
cAlphaBits := 0;
cAlphaShift := 0;
cAccumBits := 0;
cAccumRedBits := 0;
cAccumGreenBits := 0;
cAccumBlueBits := 0;
cAccumAlphaBits := 0;
cDepthBits := 32;
cStencilBits := 0;
cAuxBuffers := 0;
iLayerType := PFD_MAIN_PLANE;
bReserved := 0;
dwLayerMask := 0;
dwVisibleMask := 0;
dwDamageMask := 0;
end;
PixelFormat := ChoosePixelFormat(DC, @PFD);
if (PixelFormat = 0) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to find a suitable pixel format');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to find a suitable pixel format');
{$ENDIF}
exit;
end;
if (not SetPixelFormat(DC, PixelFormat, @PFD)) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to set the pixel format');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to set the pixel format');
{$ENDIF}
exit;
end;
// Creating a temporary RC
TempRC := wglCreateContext(DC);
if (TempRC = 0) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to create a temporary RC');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to create a temporary RC');
{$ENDIF}
exit;
end;
if (not wglMakeCurrent(DC, TempRC)) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to activate the temporary RC');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to activate the temporary RC');
{$ENDIF}
exit;
end;
// Known to throw AVs, that's why they're put in a try-except
try
ReadExtensions();
ReadImplementationProperties();
except
{$IFDEF DEBUG}
ThrowAndLog('Unable to read implementation properties of OpenGL');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to read implementation properties of OpenGL');
{$ENDIF}
exit;
end;
if (not dglCheckExtension('WGL_ARB_create_context')) then
begin
{$IFDEF DEBUG}
ThrowAndLog('OpenGL 3.x not present');
{$ELSE IFDEF RELEASE}
ThrowException('OpenGL 3.x not present');
{$ENDIF}
exit;
end;
OGLAttr[0] := WGL_CONTEXT_MAJOR_VERSION_ARB;
OGLAttr[1] := OPENGL_MAJOR_VERSION;
OGLAttr[2] := WGL_CONTEXT_MINOR_VERSION_ARB;
OGLAttr[3] := OPENGL_MINOR_VERSION;
OGLAttr[4] := WGL_CONTEXT_FLAGS_ARB;
OGLAttr[5] := WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB;
OGLAttr[6] := 0;
RC := wglCreateContextAttribsARB(DC, 0, @OGLAttr);
if (RC = 0) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to initialize OpenGL 3.2 context');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to initialize OpenGL 3.2 context');
{$ENDIF}
exit;
end;
wglMakeCurrent(0, 0);
wglDeleteContext(TempRC);
if (not wglMakeCurrent(DC, RC)) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to activate OpenGL 3.2 context');
{$ELSE IFDEF RELEASE}
ThrowException('Unable to activate OpenGL 3.2 context');
{$ENDIF}
exit;
end else
IsOGLInit := True;
ShowWindow(WndHandle, SW_SHOW);
SetForegroundWindow(WndHandle);
SetFocus(WndHandle);
if (FFullScreen) then
ShowCursor(False);
{$IFDEF DEBUG}
Log('Graphic card vendor: ' + glGetString(GL_VENDOR));
Log('Graphic card: ' + glGetString(GL_RENDERER));
Log('OpenGL version used: ' + glGetString(GL_VERSION));
Log('OpenGL context initialization successful.');
{$ENDIF}
if Assigned(FOnResize) then
FOnResize(FWidth, FHeight);
if Assigned(FOnMove) then
FOnMove(FX, FY);
// "And all is well, that ends ok"
Result := True;
end;
destructor TOpenGL3xWindow.Destroy;
begin
Dispose(WndProcPtr);
inherited Destroy();
end;
function TOpenGL3xWindow.FreeWnd: Boolean;
begin
Result := False;
if ((WndHandle <> 0) and (not DestroyWindow(WndHandle))) then
begin
WndHandle := 0;
exit;
end;
if (not Windows.UnregisterClass('BrainEngineWnd', h_Instance)) then
begin
h_Instance := 0;
exit;
end;
Result := True;
end;
procedure TOpenGL3xWindow.LoadFromStream(const S: TStream);
begin
inherited LoadFromStream(S);
if (Assigned(S)) then
begin
FWidth := S.ReadCardinal();
FHeight := S.ReadCardinal();
FCaption := S.ReadString();
FFullScreen := S.ReadBoolean();
FX := S.ReadCardinal();
FY := S.ReadCardinal();
end;
end;
function TOpenGL3xWindow.MainFunction: Integer;
var
IsDone: Boolean;
Msg: TMsg;
begin
IsDone := False;
while (not IsDone) do
if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then
begin
if (msg.message = WM_QUIT) then
IsDone := True
else
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end else
begin
if (not IsMinimized) then
if Assigned(FOnIdle) then
FOnIdle();
SwapBuffers(DC);
end;
FreeWnd();
if Assigned(FOnDestroy) then
FOnDestroy();
Result := Msg.wParam;
end;
function TOpenGL3xWindow.Run: Integer;
begin
Result := -1;
if (not CreateWnd()) then
begin
{$IFDEF DEBUG}
ThrowAndLog('Unable to create window');
{$ELSE IFDEF RELEASE}
Self.ThrowException('Unable to create window');
{$ENDIF}
exit;
end else
begin
if Assigned(FOnCreate) then
FOnCreate();
{$IFDEF DEBUG}
Log('Window created');
{$ENDIF}
end;
Result := MainFunction();
end;
procedure TOpenGL3xWindow.SaveToStream(const S: TStream);
begin
inherited SaveToStream(S);
if (Assigned(S)) then
begin
S.WriteCardinal(FWidth);
S.WriteCardinal(FHeight);
S.WriteString(FCaption);
S.WriteBoolean(FFullScreen);
S.WriteCardinal(FX);
S.WriteCardinal(FY);
end;
end;
procedure TOpenGL3xWindow.SetCaption(const Value: String);
begin
if (Value <> FCaption) then
begin
FCaption := Value;
if (WndHandle <> 0) then
SetWindowText(WndHandle, PChar(FCaption));
end;
end;
procedure TOpenGL3xWindow.SetWndParams(const Index: Integer;
const Value: Cardinal);
var
Changed: Boolean;
begin
Changed := False;
case Index of
0: begin
Changed := (FWidth <> Value);
if (Changed) then
FWidth := Value;
end;
1: begin
Changed := (FHeight <> Value);
if (Changed) then
FHeight := Value;
end;
2: begin
Changed := (FX <> Value);
if (Changed) then
FX := Value;
end;
3: begin
Changed := (FY <> Value);
if (Changed) then
FY := Value;
end;
end;
if ((Changed) and (WndHandle <> 0)) then
begin
SetWindowPos(WndHandle, 0, FX, FY, FWidth, FHeight, SWP_NOREDRAW);
if Assigned(FOnResize) then
FOnResize(FWidth, FHeight);
if Assigned(FOnMove) then
FOnMove(FX, FY);
end;
end;
procedure TOpenGL3xWindow.VerticalSync(const Activate: Boolean);
begin
if (not IsOGLInit) then
exit;
if dglCheckExtension('WGL_EXT_swap_control') then
begin
wglSwapIntervalEXT(Integer(Activate));
{$IFDEF DEBUG}
Log('VSync -> ' + BoolToStr(Activate, True));
{$ENDIF}
end else
{$IFDEF DEBUG}
Log('WGL_EXT_swap_control not present');
{$ENDIF}
end;
function TOpenGL3xWindow.WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT;
begin
case (Msg) of
WM_CLOSE:
begin
PostQuitMessage(0);
Result := 0;
end;
WM_SIZE:
begin
FWidth := LoWord(lParam);
FHeight := HiWord(lParam);
if Assigned(FOnResize) then
FOnResize(FWidth, FHeight);
IsMinimized := (wParam = SIZE_MINIMIZED);
Result := 0;
end;
WM_MOVE:
begin
FX := LoWord(lParam);
FY := HiWord(lParam);
if Assigned(FOnMove) then
FOnMove(FX, FY);
Result := 0;
end
else
Result := DefWindowProc(hWnd, Msg, WParam, LParam);
end;
end;
end.
Reply With Quote
Bookmarks