Results 1 to 7 of 7

Thread: WinAPI window class

  1. #1

    WinAPI window class

    Hello.

    I was bored and just put up together a class for creating a window using Windows API. Notice that the window procedure is a member of the class.

    STILL WIP
    Code:
    unit UWindow;
    
    interface
    
    uses
      Windows, Messages;
    
    type
      { .: TWindow :. }
      TWindow = class sealed(TObject)
      private
        { Private declarations }
        FWidth: Cardinal;
        FHeight: Cardinal;
    
        WndProcPtr: Pointer;
        WndHandle: HWND;
        h_Instance: HINST;
    
        function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
          lParam: LPARAM): LRESULT; stdcall;
        function WinMain(hInstance: HINST; hPrevInstance: HINST;
          lpCmdLine: PChar; nCmdShow: Integer): Integer; stdcall;
    
        function CreateWnd(): Boolean;
        function FreeWnd(): Boolean;
        procedure SetWndParams(const Index: Integer; const Value: Cardinal);
      public
        { Public declarations }
        constructor Create();
        destructor Destroy(); override;
    
        function Run(): Integer;
    
        property Width: Cardinal index 0 read FWidth write SetWndParams;
        property Height: Cardinal index 1 read FHeight write SetWndParams;
      end;
    
    implementation
    
    type
      { .: TMethodToProc :. }
      TMethodToProc = packed record
        popEax: Byte;
        pushSelf: record
          opcode: Byte;
          Self: Pointer;
        end;
        pushEax: Byte;
        jump: record
          opcode: Byte;
          modRm: Byte;
          pTarget: ^Pointer;
          target: Pointer;
        end;
      end;
    
    { .: MethodToProcedure :. }
    function MethodToProcedure(self: TObject; methodAddr: Pointer): Pointer;
    var
      mtp: ^TMethodToProc absolute Result;
    begin
      New(mtp);
      with mtp^ do
      begin
        popEax := $58;
        pushSelf.opcode := $68;
        pushSelf.Self := Self;
        pushEax := $50;
        jump.opcode := $FF;
        jump.modRm := $25;
        jump.pTarget := @jump.target;
        jump.target := methodAddr;
      end;
    end;
    
    { TWindow }
    
    constructor TWindow.Create;
    begin
      inherited Create();
    
      WndProcPtr := MethodToProcedure(Self, @TWindow.WndProc);
      h_Instance := GetModuleHandle(nil);
      FWidth := 800;
      FHeight := 600;
    end;
    
    function TWindow.CreateWnd: Boolean;
    var
      WndClass: TWndClass;
      dwStyle, dwExStyle: DWORD;
    begin
      Result := False;
    
      ZeroMemory(@WndClass, SizeOf(WndClass));
      FreeWnd();
    
      with WndClass do
      begin
        style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
        lpfnWndProc := WndProcPtr;
        hInstance := h_Instance;
        hCursor := LoadCursor(0, IDC_ARROW);
        lpszClassName := 'BrainerWindow';
      end;
    
      if (Windows.RegisterClass(WndClass) = 0) then
        exit;
    
      dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
      dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
    
      WndHandle := CreateWindowEx(dwExStyle, 'BrainerWindow', '', dwStyle, 0, 0,
        FWidth, FHeight, 0, 0, h_Instance, nil);
    
      if (WndHandle = 0) then
        exit;
    
      ShowWindow(WndHandle, SW_SHOW);
      SetForegroundWindow(WndHandle);
      SetFocus(WndHandle);
    
      Result := True;
    end;
    
    destructor TWindow.Destroy;
    begin
      Dispose(WndProcPtr);
    
      inherited;
    end;
    
    function TWindow.FreeWnd: Boolean;
    begin
      Result := False;
    
      if ((WndHandle <> 0) and (not DestroyWindow(WndHandle))) then
      begin
        WndHandle := 0;
        exit;
      end;
    
      if (not Windows.UnregisterClass('BrainerWindow', h_Instance)) then
      begin
        h_Instance := 0;
        exit;
      end;
    
      Result := True;
    end;
    
    function TWindow.Run: Integer;
    begin
      Result := -1;
    
      if (not CreateWnd()) then
        exit;
      Result := WinMain(h_Instance, hPrevInst, CmdLine, CmdShow);
    end;
    
    procedure TWindow.SetWndParams(const Index: Integer; const Value: Cardinal);
    var
      Changed: Boolean;
    begin
      Changed := False;
      case Index of
        0:  Changed := (FWidth <> Value);
        1:  Changed := (FHeight <> Value);
      end;
    
      if (Changed) then
        SetWindowPos(WndHandle, 0, 0, 0, FWidth, FHeight, SWP_NOREDRAW);
    end;
    
    function TWindow.WinMain(hInstance, hPrevInstance: HINST; lpCmdLine: PChar;
      nCmdShow: Integer): 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;
      FreeWnd();
    
      Result := Msg.wParam;
    end;
    
    function TWindow.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);
            Result := 0;
          end;
      else
        Result := DefWindowProc(hWnd, Msg, WParam, LParam);
      end;
    end;
    
    end.

  2. #2
    Clever, generating a function on the fly
    From brazil (:

    Pascal pownz!

  3. #3
    Nice. I remember I did something like this in C++ for Windows 3.11 a long time ago.

    I think it should raise some exceptions (and define its own Exception class) instead of just "exit". I hope I can remember this post when I start the Allegro.pas 4.5 version because I'll need it for sure.
    No signature provided yet.

  4. #4
    What's wrong with the good old SetWindowLong with GWL_USERDATA trick? I realize that you save one function, but in the reliability section it certainly takes a hit

    Nice hack though
    Peregrinus, expectavi pedes meos in cymbalis
    Nullus norvegicorum sole urinat

  5. #5
    Quote Originally Posted by JSoftware View Post
    What's wrong with the good old SetWindowLong with GWL_USERDATA trick?
    Nothing - I just wanted it done like that. The purpose was to show that there are different ways of doing the same thing. Of course, the above is a rough sketch, still waiting for improvements. I just wanted to show you a concept you could possibly use to build your own class.

  6. #6
    LOL, that's quite clever indeed. I know this problem. WndProc can be hard to use when you're writing OOP code. This is the hakish solution. Nice one.
    Coders rule nr 1: Face ur bugz.. dont cage them with code, kill'em with ur cursor.

  7. #7
    29th of December, 2010
    * OpenGL 3.x context initialization added
    * Added events to react to the execution flow
    The code contains classes from my engine, but I think it's easy to replace them with your code or even completely get rid of them.
    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.

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •