8 Classes, SysUtils, Windows, dglOpenGL;
11 TOpenGLWindow = packed record
18 function CreateOpenGLWindow(const aCaption: String; const aWidth, aHeight: Integer; const aWndProc: WNDPROC): TOpenGLWindow;
19 function ProgressMesages: Boolean;
20 procedure DestroyOpenGLWindow(const aWindow: TOpenGLWindow);
24 function CreateOpenGLWindow(const aCaption: String; const aWidth, aHeight: Integer; const aWndProc: WNDPROC): TOpenGLWindow;
27 result.LWndClass.hInstance := hInstance;
28 with result.LWndClass do begin
29 lpszClassName := 'MyWinApiWnd';
30 Style := CS_PARENTDC or CS_BYTEALIGNCLIENT;
31 hIcon := LoadIcon(hInstance,'MAINICON');
32 lpfnWndProc := aWndProc;
33 hbrBackground := COLOR_BTNFACE+1;
34 hCursor := LoadCursor(0,IDC_ARROW);
36 RegisterClass(result.LWndClass);
37 result.hMainHandle := CreateWindow(
38 result.LWndClass.lpszClassName,
40 WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU or WS_VISIBLE,
41 (GetSystemMetrics(SM_CXSCREEN) - aWidth) div 2,
42 (GetSystemMetrics(SM_CYSCREEN) - aHeight) div 2,
43 aWidth, aHeight, 0, 0, hInstance, nil);
45 // create and activate rendering context
46 result.DC := GetDC(result.hMainHandle);
47 if (result.DC = 0) then begin
48 WriteLn('unable to get DeviceContext');
51 result.RC := CreateRenderingContext(result.DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
52 if (result.RC = 0) then begin
53 WriteLn('unable to create RenderingContext');
56 ActivateRenderingContext(result.DC, result.RC);
59 glViewport(0, 0, aWidth, aHeight);
60 glClearColor(0, 0, 0, 0);
61 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
63 glDisable(GL_DEPTH_TEST);
64 glDisable(GL_CULL_FACE);
66 glMatrixMode(GL_PROJECTION);
68 glOrtho(0, aWidth, aHeight, 0, -10, 10);
69 glMatrixMode(GL_MODELVIEW);
73 function ProgressMesages: Boolean;
77 result := GetMessage(Msg, 0, 0, 0);
79 TranslateMessage(Msg);
84 procedure DestroyOpenGLWindow(const aWindow: TOpenGLWindow);
86 DestroyRenderingContext(aWindow.RC);
87 ReleaseDC(aWindow.hMainHandle, aWindow.DC);