examples/Helper.pas

   1 unit Helper;
   2
   3 {$mode objfpc}{$H+}
   4
   5 interface
   6
   7 uses
   8   Classes, SysUtils, Windows, dglOpenGL;
   9
  10 type
  11   TOpenGLWindow = packed record
  12     LWndClass: TWndClass;
  13     hMainHandle: HWND;
  14     DC: HDC;
  15     RC: HGLRC;
  16   end;
  17
  18 function CreateOpenGLWindow(const aCaption: String; const aWidth, aHeight: Integer; const aWndProc: WNDPROC): TOpenGLWindow;
  19 function ProgressMesages: Boolean;
  20 procedure DestroyOpenGLWindow(const aWindow: TOpenGLWindow);
  21
  22 implementation
  23
  24 function CreateOpenGLWindow(const aCaption: String; const aWidth, aHeight: Integer; const aWndProc: WNDPROC): TOpenGLWindow;
  25 begin
  26   //create the window
  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);
  35   end;
  36   RegisterClass(result.LWndClass);
  37   result.hMainHandle := CreateWindow(
  38     result.LWndClass.lpszClassName,
  39     PAnsiChar(aCaption),
  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);
  44
  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');
  49     halt;
  50   end;
  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');
  54     halt;
  55   end;
  56   ActivateRenderingContext(result.DC, result.RC);
  57
  58   // init OpenGL
  59   glViewport(0, 0, aWidth, aHeight);
  60   glClearColor(0, 0, 0, 0);
  61   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  62
  63   glDisable(GL_DEPTH_TEST);
  64   glDisable(GL_CULL_FACE);
  65
  66   glMatrixMode(GL_PROJECTION);
  67   glLoadIdentity;
  68   glOrtho(0, aWidth, aHeight, 0, -10, 10);
  69   glMatrixMode(GL_MODELVIEW);
  70   glLoadIdentity;
  71 end;
  72
  73 function ProgressMesages: Boolean;
  74 var
  75   Msg: TMSG;
  76 begin
  77   result := GetMessage(Msg, 0, 0, 0);
  78   if result then begin
  79     TranslateMessage(Msg);
  80     DispatchMessage(Msg);
  81   end;
  82 end;
  83
  84 procedure DestroyOpenGLWindow(const aWindow: TOpenGLWindow);
  85 begin
  86   DestroyRenderingContext(aWindow.RC);
  87   ReleaseDC(aWindow.hMainHandle, aWindow.DC);
  88 end;
  89
  90 end.
  91