win32 opengl errors ?

General FreeBASIC programming questions.
bluatigro
Posts: 448
Joined: Apr 25, 2012 10:35
Location: netherlands

win32 opengl errors ?

Postby bluatigro » Sep 14, 2017 12:44

hello
i m trying to translate
https://www.opengl.org/archives/resourc ... _tutorial/
from c++ into freebasic
i have some error's
all help is welkome

Code: Select all

'' bluatigro 14 sept 2017
'' opengl triangle

#include "windows.bi"
#include "GL\gl.bi"
#include "GL\glu.bi"

dim shared as integer key(256),leftbutton,rightbutton,mousex,mousey

#define FRAME_TIMER 12345

function WindowProc ( byval hWnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT

  dim rct as RECT
  dim pnt as PAINTSTRUCT
  dim hdc as HDC
   
  select case( wMsg )
    case WM_CREATE           
      SetTimer( hwnd , FRAME_TIMER , 40 , NULL )
    case WM_TIMER
      select case wParam
        case FRAME_TIMER
          ''todo : update game objects
          InvalidateRect( hwnd , NULL , TRUE )
        case else
      end select
    case WM_PAINT
         
      hdc = BeginPaint( hWnd, @pnt )
      GetClientRect( hWnd, @rct )
     
      ''  todo : draw game objects
           
      EndPaint( hWnd, @pnt )
    case WM_KEYDOWN
         if( lobyte( wParam ) = 27 ) then
            PostMessage( hWnd, WM_CLOSE, 0, 0 )
      else
        key( wParam ) = 1
         end if
    case WM_KEYUP
      key( wParam ) = 0
    case WM_MOUSEMOVE
      mousex = loword( lParam )   
      mousey = hiword( lParam )   
    case WM_LBUTTONDOWN
      leftbutton = 1
    case WM_LBUTTONUP
      leftbutton = 0
    case WM_RBUTTONDOWN
      rightbutton = 1
    case WM_RBUTTONUP
      rightbutton = 0
    case WM_DESTROY
      PostQuitMessage( 0 )
    case else
      return DefWindowProc( hWnd, wMsg, wParam, lParam )   
  end select 
  return 0
end function

function CreateOpenGLWindow(title as string _
  ,x as integer,y as integer,dx as integer,dy as integer,
  tipe as byte, flags as DWORD)as HWND
  dim as integer pf
  dim as HDC     DC
  dim as HWND    Wnd
  dim as WNDCLASS    wc
  dim as PIXELFORMATDESCRIPTOR pfd
  dim as HINSTANCE Instance = 0
''only register the window class once - use hInstance as a flag.
  if (not Instance)then
    Instance = GetModuleHandle(NULL)
      wc.style         = CS_OWNDC
     wc.lpfnWndProc   = (WNDPROC)WindowProc
     wc.cbClsExtra    = 0
     wc.cbWndExtra    = 0
     wc.hInstance     = Instance
     wc.hIcon         = LoadIcon(NULL, IDI_WINLOGO)
     wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
     wc.hbrBackground = NULL
     wc.lpszMenuName  = NULL
     wc.lpszClassName = "OpenGL"
      if (not RegisterClass(@wc)) then
        MessageBox(NULL, "RegisterClass() failed:  " _
            + "Cannot register window class.", _
                       "Error", MB_OK)
       return NULL
     end if
  end if
  Wnd = CreateWindow("OpenGL", title, _
                WS_OVERLAPPEDWINDOW or _
                WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
                x, y, _
                dx, dy, _
                NULL, NULL, Instance, NULL)
  if (Wnd = NULL) then
    MessageBox(NULL, _
        "CreateWindow() failed:  Cannot create a window.", _
        "Error", MB_OK)
    return NULL
  end if
  DC = GetDC(Wnd)
''there is no guarantee that the contents of the stack that become
''the pfd are zeroed, therefore _make sure_ to clear these bits. */
  memset(@pfd, 0, sizeof(pfd))
  pfd.nSize        = sizeof(pfd)
  pfd.nVersion     = 1
  pfd.dwFlags  = PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or flags
  pfd.iPixelType   = tipe
  pfd.cColorBits   = 32
  pf = ChoosePixelFormat(DC, @pfd)
  if (pf = 0)then
       MessageBox(NULL, "ChoosePixelFormat() failed:  " _
         +"Cannot find a suitable pixel format.", _
                   "Error", MB_OK)
    return 0
  end if
  if (SetPixelFormat(DC, pf, @pfd) = FALSE)then
    MessageBox(NULL, "SetPixelFormat() failed:  " _
                     +  "Cannot set format specified.", _
                       "Error", MB_OK)
    return 0
  end if
  DescribePixelFormat(DC, pf, _
    sizeof(PIXELFORMATDESCRIPTOR), @pfd)
  ReleaseDC(@DC, @Wnd)
  return Wnd
end function
function WinMain(hCurrentInst as HINSTANCE, _
        hPreviousInst as HINSTANCE, _
         lpszCmdLine as LPSTR, _
        nCmdShow as integer) as integer
    dim as HDC   DC            ''/* device context */
    dim as HGLRC hRC            ''/* opengl context */
    dim as HWND  Wnd            ''/* window */
    dim as MSG   msge            ''/* message */


    Wnd = CreateOpenGLWindow("minimal", _
    0, 0, 256, 256, PFD_TYPE_RGBA, 0)
    if (Wnd = NULL)then return 1
    DC = GetDC(Wnd)
    hRC = wglCreateContext(DC)
    wglMakeCurrent(DC, hRC)
    ShowWindow(Wnd, nCmdShow)
    while(GetMessage(@msge, Wnd, 0, 0))
       TranslateMessage(@msge)
      DispatchMessage(@msge)
    wend
    wglMakeCurrent(NULL, NULL)
    ReleaseDC(DC, Wnd)
    wglDeleteContext(hRC)
    DestroyWindow(Wnd)
    return msge.wParam
end function
bluatigro
Posts: 448
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: win32 opengl errors ?

Postby bluatigro » Sep 14, 2017 13:13

update :
some error's removed
triangle added
you shoot get a rotating color triangle

Code: Select all

'' bluatigro 14 sept 2017
'' opengl triangle

#include "windows.bi"
#include "GL\gl.bi"
#include "GL\glu.bi"

dim shared as integer key(256),leftbutton,rightbutton,mousex,mousey
dim shared as double angle

#define FRAME_TIMER 12345

function WindowProc ( byval Wnd as HWND, _
                   byval wMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT

  dim rct as RECT
  dim pnt as PAINTSTRUCT
  dim dc as HDC
   
  select case( wMsg )
    case WM_CREATE           
      SetTimer( wnd , FRAME_TIMER , 40 , NULL )
    case WM_TIMER
      select case wParam
        case FRAME_TIMER
          angle += 1
          InvalidateRect( wnd , NULL , TRUE )
        case else
      end select
    case WM_PAINT
      '' rotate a triangle around

      glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
      glLoadIdentity
      glRotated angle , 1 , 1 , 0
      glBegin GL_TRIANGLES
        glColor3f   1, 0, 0
        glVertex3f  0, 1, 0
        glColor3f   0, 1, 0
        glVertex3f -1,-1, 0
        glColor3f   0, 0, 1
        glVertex3f  1,-1, 0
      glEnd
      glFlush
     
      dc = BeginPaint( Wnd, @pnt )
      GetClientRect( Wnd, @rct )
     
      ''  todo : draw game objects
           
      EndPaint( Wnd, @pnt )
    case WM_KEYDOWN
         if( lobyte( wParam ) = 27 ) then
            PostMessage( Wnd, WM_CLOSE, 0, 0 )
      else
        key( wParam ) = 1
         end if
    case WM_KEYUP
      key( wParam ) = 0
    case WM_MOUSEMOVE
      mousex = loword( lParam )   
      mousey = hiword( lParam )   
    case WM_LBUTTONDOWN
      leftbutton = 1
    case WM_LBUTTONUP
      leftbutton = 0
    case WM_RBUTTONDOWN
      rightbutton = 1
    case WM_RBUTTONUP
      rightbutton = 0
    case WM_DESTROY
      PostQuitMessage( 0 )
    case else
      return DefWindowProc( Wnd, wMsg, wParam, lParam )   
  end select 
  return 0
end function

function CreateOpenGLWindow(title as string _
  ,x as integer,y as integer,dx as integer,dy as integer, _
  tipe as byte, flags as ulong)as HWND
  dim as integer pf
  dim as HDC     DC
  dim as HWND    Wnd
  dim as WNDCLASS    wc
  dim as PIXELFORMATDESCRIPTOR pfd
  dim as HINSTANCE Instance = 0
''only register the window class once - use hInstance as a flag.
  if (not Instance)then
    Instance = GetModuleHandle(NULL)
      wc.style         = CS_OWNDC
     wc.lpfnWndProc   = (WNDPROC)WindowProc
     wc.cbClsExtra    = 0
     wc.cbWndExtra    = 0
     wc.hInstance     = Instance
     wc.hIcon         = LoadIcon(NULL, IDI_WINLOGO)
     wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
     wc.hbrBackground = NULL
     wc.lpszMenuName  = NULL
     wc.lpszClassName = "OpenGL"
      if (not RegisterClass(@wc)) then
        MessageBox(NULL, "RegisterClass() failed:  " _
            + "Cannot register window class.", _
                       "Error", MB_OK)
       return NULL
     end if
  end if
  Wnd = CreateWindow("OpenGL", title, _
                WS_OVERLAPPEDWINDOW or _
                WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
                x, y, _
                dx, dy, _
                NULL, NULL, Instance, NULL)
  if (Wnd = NULL) then
    MessageBox(NULL, _
        "CreateWindow() failed:  Cannot create a window.", _
        "Error", MB_OK)
    return NULL
  end if
  DC = GetDC(Wnd)
''there is no guarantee that the contents of the stack that become
''the pfd are zeroed, therefore _make sure_ to clear these bits. */
  memset(@pfd, 0, sizeof(pfd))
  pfd.nSize        = sizeof(pfd)
  pfd.nVersion     = 1
  pfd.dwFlags  = PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or flags
  pfd.iPixelType   = tipe
  pfd.cColorBits   = 32
  pf = ChoosePixelFormat(DC, @pfd)
  if (pf = 0)then
       MessageBox(NULL, "ChoosePixelFormat() failed:  " _
         +"Cannot find a suitable pixel format.", _
                   "Error", MB_OK)
    return 0
  end if
  if (SetPixelFormat(DC, pf, @pfd) = FALSE)then
    MessageBox(NULL, "SetPixelFormat() failed:  " _
                     +  "Cannot set format specified.", _
                       "Error", MB_OK)
    return 0
  end if
  DescribePixelFormat(DC, pf, _
    sizeof(PIXELFORMATDESCRIPTOR), @pfd)
  ReleaseDC(DC, Wnd)
  return Wnd
end function
function WinMain(hCurrentInst as HINSTANCE, _
        hPreviousInst as HINSTANCE, _
         lpszCmdLine as LPSTR, _
        nCmdShow as integer) as integer
    dim as HDC   DC            ''/* device context */
    dim as HGLRC hRC            ''/* opengl context */
    dim as HWND  Wnd            ''/* window */
    dim as MSG   msge            ''/* message */


    Wnd = CreateOpenGLWindow("minimal", _
    0, 0, 256, 256, PFD_TYPE_RGBA, 0)
    if (Wnd = NULL)then return 1
    DC = GetDC(Wnd)
    hRC = wglCreateContext(DC)
    wglMakeCurrent(DC, hRC)
    ShowWindow(Wnd, nCmdShow)
    while(GetMessage(@msge, Wnd, 0, 0))
       TranslateMessage(@msge)
      DispatchMessage(@msge)
    wend
    wglMakeCurrent(NULL, NULL)
    ReleaseDC(DC, Wnd)
    wglDeleteContext(hRC)
    DestroyWindow(Wnd)
    return msge.wParam
end function

Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests