OpenGLCore/examples/Helper.pas

unit Helper;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Windows, dglOpenGL;

type
  TOpenGLWindow = packed record
    LWndClass: TWndClass;
    hMainHandle: HWND;
    DC: HDC;
    RC: HGLRC;
  end;

function CreateOpenGLWindow(const aCaption: String; const aWidth, aHeight: Integer; const aWndProc: WNDPROC): TOpenGLWindow;
function ProgressMesages: Boolean;
procedure DestroyOpenGLWindow(const aWindow: TOpenGLWindow);

implementation

function CreateOpenGLWindow(const aCaption: String; const aWidth, aHeight: Integer; const aWndProc: WNDPROC): TOpenGLWindow;
begin
  //create the window
  result.LWndClass.hInstance := hInstance;
  with result.LWndClass do begin
    lpszClassName := 'MyWinApiWnd';
    Style         := CS_PARENTDC or CS_BYTEALIGNCLIENT;
    hIcon         := LoadIcon(hInstance,'MAINICON');
    lpfnWndProc   := aWndProc;
    hbrBackground := COLOR_BTNFACE+1;
    hCursor       := LoadCursor(0,IDC_ARROW);
  end;
  RegisterClass(result.LWndClass);
  result.hMainHandle := CreateWindow(
    result.LWndClass.lpszClassName,
    PAnsiChar(aCaption),
    WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU or WS_VISIBLE,
    (GetSystemMetrics(SM_CXSCREEN) - aWidth)  div 2,
    (GetSystemMetrics(SM_CYSCREEN) - aHeight) div 2,
    aWidth, aHeight, 0, 0, hInstance, nil);

  // create and activate rendering context
  result.DC := GetDC(result.hMainHandle);
  if (result.DC = 0) then begin
    WriteLn('unable to get DeviceContext');
    halt;
  end;
  result.RC := CreateRenderingContext(result.DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
  if (result.RC = 0) then begin
    WriteLn('unable to create RenderingContext');
    halt;
  end;
  ActivateRenderingContext(result.DC, result.RC);

  // init OpenGL
  glViewport(0, 0, aWidth, aHeight);
  glClearColor(0, 0, 0, 0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glDisable(GL_DEPTH_TEST);
  glDisable(GL_CULL_FACE);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(0, aWidth, aHeight, 0, -10, 10);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

function ProgressMesages: Boolean;
var
  Msg: TMSG;
begin
  result := GetMessage(Msg, 0, 0, 0);
  if result then begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

procedure DestroyOpenGLWindow(const aWindow: TOpenGLWindow);
begin
  DestroyRenderingContext(aWindow.RC);
  ReleaseDC(aWindow.hMainHandle, aWindow.DC);
end;

end.