fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
openGL Childwindowcode (nw)

Uploader:	csde_rats
Datum/Zeit:	28.09.2008 15:14:58
#Include "fbProcMon.bi"



#Include Once "gl/gl.bi"

#Include Once "gl/glu.bi"

#Include Once "gl/glut.bi"



Dim Shared As HWND ghWnd

Dim Shared As HDC ghDC

Dim Shared As HGLRC ghRC



'#Define SwapBuffers SwapBuffers(ghDC)

#Define BLACK_INDEX     0

#Define RED_INDEX       13

#Define GREEN_INDEX     14

#Define BLUE_INDEX      16



Const wireframe = TRUE

Const sz = 1



Const near_plane = 3.0

Const far_plane = 7.0



Declare Function oglinit(hParent As HWND, x As Integer, y As Integer, w As Integer, h As Integer, style As Dword=WS_CHILD) As Integer

Declare Function oglProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer

Declare Function bSetupPixelFormat(hdc As HDC) As Integer

Declare Sub initializeGL(x As GLsizei, y As GLsizei)

Declare Sub resize(x As GLsizei, y As GLsizei)

Declare Sub drawScene ()



Function oglinit(hParent As HWND, x As Integer, y As Integer, w As Integer, h As Integer, style As Dword=WS_CHILD) As Integer

    Dim As MSG msg

    Dim As WNDCLASS wndclass



    wndclass.style         = 0

   wndclass.lpfnWndProc   = @oglProc

   wndclass.cbClsExtra    = 0

   wndclass.cbWndExtra    = 0

   wndclass.hInstance     = GetModuleHandle(NULL)

   wndclass.hIcon         = NULL 'LoadIcon (hInstance, szAppName)

   wndclass.hCursor       = LoadCursor (NULL, IDC_ARROW)

   wndclass.hbrBackground = Cast(HBRUSH,COLOR_WINDOW+1)

   wndclass.lpszMenuName  = NULL

   wndclass.lpszClassName = StrPtr("OGLWIN")



   If RegisterClass(@wndclass) = FALSE Then Return FALSE



    ghWnd = CreateWindow(StrPtr("OGLWIN"), _

        StrPtr("oglwin"), _

        style, _

        x, y, _

        w, h, _

        hParent, _

        NULL, _

        hInstance, _

        NULL)



    If ghWnd = 0 Then Return FALSE



    ShowWindow(ghWnd, SW_SHOW)

    UpdateWindow(ghWnd)

End Function



Sub drawScene ()

    glClear(GL_COLOR_BUFFER_BIT)



    If wireframe = TRUE Then

        glutWireTeapot(sz)

    Else

        glutSolidTeapot(sz)

    EndIf



    SwapBuffers(ghDC)

End Sub



Function oglProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer

    Dim As Long lRet = TRUE

    Dim As PAINTSTRUCT ps

    Dim As RECT rect



    Select Case uMsg

        Case WM_CREATE

            ghDC = GetDC(hWnd)



            If bSetupPixelFormat(ghDC) = FALSE Then PostQuitMessage(0)



            ghRC = wglCreateContext(ghDC)



            GetClientRect(hWnd, @rect)

            initializeGL(rect.right, rect.bottom)

        Case WM_PAINT

            BeginPaint(hWnd, @ps)

            EndPaint(hWnd, @ps)

        Case WM_SIZE

            GetClientRect(hWnd, @rect)

            resize(rect.right, rect.bottom)

        Case WM_CLOSE

            If ghRC <> 0 Then wglDeleteContext(ghRC)

            If ghDC <> 0 Then ReleaseDC(hWnd, ghDC)



            ghRC = 0

            ghDC = 0





            DestroyWindow(hWnd)

        Case WM_DESTROY

            If ghRC <> 0 Then wglDeleteContext(ghRC)

            If ghDC <> 0 Then ReleaseDC(hWnd, ghDC)



            ghRC = 0

            ghDC = 0



            PostQuitMessage(0)

        Case Else

            lRet = DefWindowProc(hWnd, uMsg, wParam, lParam)

    End Select



    Return lRet

End Function



Function bSetupPixelFormat(hdc As HDC) As Integer

    Dim As PIXELFORMATDESCRIPTOR Ptr ppfd

    Dim As Integer pixelformat



    ppfd = New PIXELFORMATDESCRIPTOR



    ppfd->nSize = SizeOf(PIXELFORMATDESCRIPTOR)

   ppfd->nVersion = 1

   ppfd->dwFlags = PFD_DRAW_TO_WINDOW Or PFD_SUPPORT_OPENGL Or PFD_DOUBLEBUFFER

   ppfd->dwLayerMask = PFD_MAIN_PLANE

   ppfd->iPixelType = PFD_TYPE_COLORINDEX

   ppfd->cColorBits = 32

   ppfd->cDepthBits = 16

   ppfd->cAccumBits = 0

   ppfd->cStencilBits = 0



   pixelformat = ChoosePixelFormat(hDC, ppfd)



   If pixelformat = 0 Then Return FALSE

   If SetPixelFormat(hDC, pixelformat, ppfd) = FALSE Then Return FALSE



   Delete ppfd



   Return TRUE

End Function



Sub resize(w As GLsizei, h As GLsizei)

    Dim As GLfloat aspect



    glViewport(0, 0, w, h)



    aspect = w/h



    glMatrixMode(GL_PROJECTION)

    glLoadIdentity()

    gluPerspective(45.0, aspect, near_plane, far_plane)

    glMatrixMode(GL_MODELVIEW)

End Sub



Sub initializeGL(w As GLsizei, h As GLsizei)

    Dim As GLfloat maxObjectSize, aspect



    glClearIndex(BLACK_INDEX)

    glClearDepth(1.0)



    glEnable(GL_DEPTH_TEST)



    glMatrixMode(GL_PROJECTION)

    aspect = w/h

    gluPerspective(45.0, aspect, near_plane, far_plane)

    glMatrixMode(GL_MODELVIEW)



    maxObjectSize = 3.0



End Sub