PDA

View Full Version : Powerbasic: question OpenGL Window in a SDK Window


Lionheart008
13-11-2024, 15:16
Update

Hello Petr,. perhaps you can Help or give an advices how to Insert an OpenGL Window into a SDK Window frame? I cannot find any example because I have lost Most openGl example I have created with Powerbasic..

Thanks, Frank



' test openGL sdk window + window frame included with a control
' how to insert an openGL window frame into a sdk window?
'
' a question for petr schreiber :-)
' thanks, frank
'
#COMPILER PBWIN 10
#COMPILE EXE
#DIM ALL

#INCLUDE ONCE "Win32API.inc"

%IDC_STATIC=1001
%IDC_BUTTON=1002
%BS_PUSHBUTTON = &H0&

'==============================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, _
BYVAL hPrevInstance AS DWORD, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG


LOCAL Msg AS tagMsg
LOCAL wce AS WndClassEx
LOCAL szAppName AS ASCIIZ * 80
LOCAL szAppName2 AS ASCIIZ * 80
LOCAL hWnd AS DWORD
LOCAL hWndOpgl AS DWORD

szAppName = "HelloWin"
wce.cbSize = SIZEOF(wce)
wce.STYLE = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(WndProc)
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInstance
wce.hIcon = LoadIcon(hInstance, "HELLOWIN")
wce.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wce.hbrBackground = %NULL ' No class background, we do it outselves
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szAppName)
wce.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)

RegisterClassEx wce


szAppName2 = "HelloOpenGL"
wce.cbSize = SIZEOF(wce)
wce.STYLE = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(WndProc)
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInstance
wce.hIcon = LoadIcon(hInstance, "HELLOWIN")
wce.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wce.hbrBackground = %NULL ' No class background, we do it outselves
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szAppName2)
wce.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)

RegisterClassEx wce


' Create a window using the registered class
hWnd = CreateWindow(szAppName, _
"The Hello Program", _
%WS_OVERLAPPEDWINDOW, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%NULL, _
%NULL, _
hInstance, _
BYVAL %NULL)

IF hWnd = 0 THEN ' exit on failure
MSGBOX "Unable to create window"
EXIT FUNCTION
END IF

' Create a window using the registered class
hWndOpgl = CreateWindow(szAppName2, _
"OpenGL window", _
%WS_OVERLAPPEDWINDOW, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%NULL, _
%NULL, _
hInstance, _
BYVAL %NULL)

IF hWndOpgl = 0 THEN ' exit on failure
MSGBOX "Unable to create openGLwindow"
EXIT FUNCTION
END IF

LOCAL hCtl AS DWORD
LOCAL hCtlBtn AS DWORD
LOCAL hFont AS DWORD

hCtl = CreateWindowEx(0, "Static", "openGL", _
%WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR _
%SS_NOTIFY OR %SS_LEFT, _ '%SS_RIGHT
18, 40, 440, 324, _
hwnd, %IDC_STATIC, GetModuleHandle(""), BYVAL %NULL)
IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

hCtlBtn = CreateWindowEx(0, "Button", "push-me", _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR _
%WS_CLIPSIBLINGS OR %WS_TABSTOP, _
650, 440, 80, 24, _
hwnd, %IDC_BUTTON, GetModuleHandle(""), BYVAL %NULL)
IF hFont THEN SendMessage hCtlBtn, %WM_SETFONT, hFont, 0

IF hWnd = 0 THEN
MessageBox(0, "Window Creation Failed!", "Error", 0)
EXIT FUNCTION
END IF

' Display the window on the screen
ShowWindow hWnd, iCmdShow
UpdateWindow hWnd

DO WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
LOOP
FUNCTION = msg.wParam

END FUNCTION


'==============================================================================
SUB DrawGradient (BYVAL hDC AS DWORD)
'------------------------------------------------------------------------------
' Custom draw procedure for gradiend fill
'--------------------------------------------------------------------------

LOCAL rectFill AS RECT
LOCAL rectClient AS RECT
LOCAL fStep AS SINGLE
LOCAL hBrush AS DWORD
LOCAL lOnBand AS LONG

GetClientRect WindowFromDC(hDC), rectClient
fStep = rectClient.nbottom / 200

FOR lOnBand = 0 TO 199
SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
hBrush = CreateSolidBrush(RGB(0, 0, 255 - lOnBand))
Fillrect hDC, rectFill, hBrush
DeleteObject hBrush
NEXT

END SUB


'==============================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) EXPORT AS LONG

LOCAL hDC AS DWORD
LOCAL hInstance AS DWORD
LOCAL pPaint AS PAINTSTRUCT
LOCAL tRect AS RECT

SELECT CASE wMsg

CASE %WM_CREATE

CASE %WM_COMMAND
SELECT CASE LOWRD(wParam)
CASE %IDOK
IF HIWRD(wParam) = %BN_CLICKED THEN
'Trigger search code..
END IF

CASE %IDC_BUTTON
IF HIWRD(wParam) = %BN_CLICKED THEN
MSGBOX "pushed"
END IF
END SELECT

CASE %WM_PAINT
hDC = BeginPaint(hWnd, pPaint)
GetClientRect hWnd, tRect
SetBkMode hDC, %TRANSPARENT
SetTextColor hDC, %WHITE
DrawText hDC, "Hello, openGL Windows!", -1, tRect, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
EndPaint hWnd, pPaint
FUNCTION = 1
EXIT FUNCTION

CASE %WM_ERASEBKGND
hDC = wParam
DrawGradient hDC
FUNCTION = 1
EXIT FUNCTION

CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION

END SELECT

FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
Lionheart008
13-11-2024, 19:03
Have forgotten initOpenGl function

Updated Code example Powerbasic



' test openGL sdk window + window frame included with a control
' how to insert an openGL window frame into a sdk window?
'
' a question for petr schreiber :-)
' thanks, frank
'
#COMPILE EXE
#DIM ALL

#INCLUDE ONCE "Win32API.inc"
#INCLUDE ONCE "glu.inc"
#INCLUDE ONCE "GDIPUTILS.INC"

%IDC_STATIC=1001
%IDC_BUTTON=1002
%BS_PUSHBUTTON = &H0&

%ZI_GLDC = 100
%ZI_GLRC = 101
%Extend_cbWndExtra = 103

GLOBAL m_hdc AS DWORD ' // Device context
GLOBAL m_hrc AS DWORD ' // Rendering context
GLOBAL m_hDlg AS DWORD ' // Dialog handle

GLOBAL m_TextureHandles() AS DWORD
GLOBAL m_FontBase AS DWORD
GLOBAL m_cnt1 AS SINGLE
GLOBAL m_cnt2 AS SINGLE

'==============================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, _
BYVAL hPrevInstance AS DWORD, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG


LOCAL Msg AS tagMsg
LOCAL wce AS WndClassEx
LOCAL szAppName AS ASCIIZ * 80
LOCAL szAppName2 AS ASCIIZ * 80
LOCAL hWnd AS DWORD
LOCAL hWndOpgl AS DWORD

szAppName = "HelloWin"
wce.cbSize = SIZEOF(wce)
wce.STYLE = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(GL_WindowProc)
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInstance
wce.hIcon = LoadIcon(hInstance, "HELLOWIN")
wce.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wce.hbrBackground = %NULL ' No class background, we do it outselves
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szAppName)
wce.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)

RegisterClassEx wce


szAppName2 = "HelloOpenGL"
wce.cbSize = SIZEOF(wce)
wce.STYLE = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(GL_WindowProc)
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInstance
wce.hIcon = LoadIcon(hInstance, "HELLOWIN")
wce.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wce.hbrBackground = %NULL ' No class background, we do it outselves
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szAppName2)
wce.hIconSm = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)

RegisterClassEx wce


' Create a window using the registered class
hWnd = CreateWindow(szAppName, _
"The Hello Program", _
%WS_OVERLAPPEDWINDOW, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%NULL, _
%NULL, _
hInstance, _
BYVAL %NULL)

IF hWnd = 0 THEN ' exit on failure
MSGBOX "Unable to create window"
EXIT FUNCTION
END IF

' Create a window using the registered class
hWndOpgl = CreateWindow(szAppName2, _
"OpenGL window", _
%WS_OVERLAPPEDWINDOW, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%CW_USEDEFAULT, _
%NULL, _
%NULL, _
hInstance, _
BYVAL %NULL)

IF hWndOpgl = 0 THEN ' exit on failure
MSGBOX "Unable to create openGLwindow"
EXIT FUNCTION
END IF

LOCAL hCtl AS DWORD
LOCAL hCtlBtn AS DWORD
LOCAL hFont AS DWORD

hCtl = CreateWindowEx(0, "Static", "openGL", _
%WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR _
%SS_NOTIFY OR %SS_LEFT, _ '%SS_RIGHT
18, 40, 440, 324, _
hwnd, %IDC_STATIC, GetModuleHandle(""), BYVAL %NULL)
IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

hCtlBtn = CreateWindowEx(0, "Button", "push-me", _
%WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR _
%WS_CLIPSIBLINGS OR %WS_TABSTOP, _
650, 440, 80, 24, _
hwnd, %IDC_BUTTON, GetModuleHandle(""), BYVAL %NULL)
IF hFont THEN SendMessage hCtlBtn, %WM_SETFONT, hFont, 0

IF hWnd = 0 THEN
MessageBox(0, "Window Creation Failed!", "Error", 0)
EXIT FUNCTION
END IF

' wgl_createWindow(1,1,200,200,300,300,1,1) '' test

' Display the window on the screen
ShowWindow hWnd, iCmdShow
UpdateWindow hWnd

DO WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
LOOP
FUNCTION = msg.wParam

END FUNCTION


'==============================================================================
SUB DrawGradient (BYVAL hDC AS DWORD)
'------------------------------------------------------------------------------
' Custom draw procedure for gradiend fill
'--------------------------------------------------------------------------

LOCAL rectFill AS RECT
LOCAL rectClient AS RECT
LOCAL fStep AS SINGLE
LOCAL hBrush AS DWORD
LOCAL lOnBand AS LONG

GetClientRect WindowFromDC(hDC), rectClient
fStep = rectClient.nbottom / 200

FOR lOnBand = 0 TO 199
SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
hBrush = CreateSolidBrush(RGB(0, 0, 255 - lOnBand))
Fillrect hDC, rectFill, hBrush
DeleteObject hBrush
NEXT

END SUB

FUNCTION ZI_GetProperty(BYVAL a AS DWORD, BYVAL b AS DWORD) EXPORT AS DWORD

END FUNCTION

FUNCTION ZI_SetProperty(BYVAL a AS DWORD, BYVAL b AS DWORD,BYVAL c AS DWORD) EXPORT AS DWORD

END FUNCTION

FUNCTION InitMultisample(BYVAL a AS DWORD, BYVAL b AS LONG) EXPORT AS DWORD

END FUNCTION



FUNCTION WGL_CreateWindow ALIAS "WGL_CreateWindow" (BYVAL dwExStyle AS DWORD, _
BYVAL dwStyle AS DWORD, _
BYVAL x AS LONG, BYVAL y AS LONG, _
BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
BYVAL hWndParent AS DWORD, _
BYVAL CtrlID AS DWORD) EXPORT AS DWORD

LOCAL IsInitialized, wcStyle, glDC, glRC AS LONG
LOCAL hWnd, hTemp AS DWORD
LOCAL wc AS WndClassEx
LOCAL zClass AS ASCIIZ * 16
LOCAL GLImageClassName AS WSTRINGZ*180 ' $GLImageClassName

'$GLImageClassName="WGL_OpenGL" ' ???

LOCAL zInstance AS DWORD
LOCAL gn_arbMultisampleFormat AS LONG

zClass = "GL_CHARTCTRL"

' Create a temporary window for initializing OpenGL context
hTemp = CreateWindowEx(dwExStyle, "", "", dwStyle, _ '$GLImageClassName ......... ???
0, 0, 0, 0, hWndParent, CtrlID, zInstance, BYVAL 0)
IF hTemp THEN
' Get device context and rendering context properties from the temporary window
glDC = ZI_GetProperty(hTemp, %ZI_GLDC)
glRC = ZI_GetProperty(hTemp, %ZI_GLRC)

LOCAL pfd AS PIXELFORMATDESCRIPTOR

' Set up the PIXELFORMATDESCRIPTOR structure
pfd.nSize = SIZEOF(pfd)
pfd.nVersion = 1
pfd.dwFlags = %PFD_DRAW_TO_WINDOW OR %PFD_SUPPORT_OPENGL OR %PFD_DOUBLEBUFFER OR %PFD_SUPPORT_GDI
pfd.iPixelType = 0 ' PFD_TYPE_RGBA
pfd.cColorBits = 32
pfd.cRedBits = 0
pfd.cRedShift = 0
pfd.cGreenBits = 0
pfd.cGreenShift = 0
pfd.cBlueBits = 0
pfd.cBlueShift = 0
pfd.cAlphaBits = 1
pfd.cAlphaShift = 0
pfd.cAccumBits = 0
pfd.cAccumRedBits = 0
pfd.cAccumGreenBits = 0
pfd.cAccumBlueBits = 0
pfd.cAccumAlphaBits = 0
pfd.cDepthBits = 24 ' Depth buffer
pfd.cStencilBits = 0
pfd.cAuxBuffers = 0
pfd.iLayerType = 0 ' %PFD_MAIN_PLANE
pfd.bReserved = 0
pfd.dwLayerMask = 0
pfd.dwVisibleMask = 0
pfd.dwDamageMask = 0

' Initialize multisampling
InitMultisample(glDC, VARPTR(pfd)) ' ???

IF gn_arbMultisampleFormat THEN
' Set up the window class for the OpenGL control
wcStyle = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS OR %CS_OWNDC
wc.cbSize = SIZEOF(wc)
IsInitialized = GetClassInfoEx(zInstance, zClass, wc)
IF IsInitialized = 0 THEN
wc.cbSize = SIZEOF(wc)
wc.style = wcStyle
wc.lpfnWndProc = CODEPTR(GL_WindowProc)
wc.cbClsExtra = 0
wc.cbWndExtra = %Extend_cbWndExtra * 4
wc.hInstance = zInstance
wc.hIcon = %NULL
wc.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = %NULL ' Don't paint the class window background
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(zClass)
wc.hIconSm = %NULL
IF RegisterClassEx(wc) THEN IsInitialized = %TRUE
END IF

IF IsInitialized THEN
' Create the OpenGL control window
hWnd = CreateWindowEx(dwExStyle, _
zClass, _ ' Make it an OpenGL control
"", _ ' Currently not used
dwStyle, _ ' window style
x, _ ' initial x position
y, _ ' initial y position
nWidth, _ ' Calculate Window Width
nHeight, _ ' Calculate Window Height
hWndParent, _ ' parent window handle
CtrlID, _ ' ControlID
zInstance, _ ' program instance handle
BYVAL 0) ' creation parameters
IF hWnd THEN
' Get device context and set pixel format
glDC = GetDC(hWnd)
IF SetPixelFormat(glDC, gn_arbMultisampleFormat, pfd) THEN
' Destroy the temporary window and create the OpenGL context
DestroyWindow(hTemp)
glRC = wglCreateContext(glDC)
wglMakeCurrent(glDC, glRC)
ZI_SetProperty(hWnd, %ZI_GLDC, glDC)
ZI_SetProperty(hWnd, %ZI_GLRC, glRC)
ELSE
' Fallback: use the temporary window
DestroyWindow(hWnd)
MoveWindow(hTemp, x, y, nWidth, nHeight, 0)
hWnd = hTemp
END IF
END IF

END IF
ELSE
' Fallback: use the temporary window
MoveWindow(hTemp, x, y, nWidth, nHeight, 0)
hWnd = hTemp
END IF
END IF
FUNCTION = hWnd
END FUNCTION

FUNCTION GL_WindowProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
BYVAL wParam AS DWORD, BYVAL lParam AS LONG) EXPORT AS LONG

LOCAL hDC AS DWORD
LOCAL hInstance AS DWORD
LOCAL pPaint AS PAINTSTRUCT
LOCAL tRect AS RECT

SELECT CASE wMsg

CASE %WM_CREATE

CASE %WM_COMMAND
SELECT CASE LOWRD(wParam)
CASE %IDOK
IF HIWRD(wParam) = %BN_CLICKED THEN
'Trigger search code..
END IF

CASE %IDC_BUTTON
IF HIWRD(wParam) = %BN_CLICKED THEN
MSGBOX "pushed"
END IF
END SELECT

CASE %WM_PAINT
hDC = BeginPaint(hWnd, pPaint)
GetClientRect hWnd, tRect
SetBkMode hDC, %TRANSPARENT
SetTextColor hDC, %WHITE
DrawText hDC, "Hello, openGL Windows!", -1, tRect, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
EndPaint hWnd, pPaint
FUNCTION = 1
EXIT FUNCTION

CASE %WM_ERASEBKGND
hDC = wParam
DrawGradient hDC
FUNCTION = 1
EXIT FUNCTION

CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION

END SELECT

FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION

FUNCTION InitOpenGL (BYVAL hDlg AS DWORD) AS LONG

IF hDlg = 0 THEN EXIT FUNCTION
m_hDlg = hDlg

' // Get the device context
m_hdc = GetDC(m_hDlg)
IF m_hdc = 0 THEN EXIT FUNCTION

' // Bits per pixel
LOCAL nBitsPerPel AS LONG
nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)

' // Depth bits
LOCAL cDepthBits AS LONG
cDepthBits = nBitsPerPel - 8
IF cDepthBits < 16 THEN cDepthBits = 16

' // Pixel format
LOCAL pfd AS PIXELFORMATDESCRIPTOR
pfd.nSize = SIZEOF(PIXELFORMATDESCRIPTOR)
pfd.nVersion = 1
pfd.dwFlags = %PFD_DRAW_TO_WINDOW OR %PFD_SUPPORT_OPENGL OR %PFD_DOUBLEBUFFER
pfd.iPixelType = %PFD_TYPE_RGBA
pfd.cColorBits = nBitsPerPel
pfd.cDepthBits = cDepthBits

' // Find a matching pixel format
LOCAL pf AS LONG
pf = ChoosePixelFormat(m_hdc, pfd)
IF ISFALSE pf THEN
MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
EXIT FUNCTION
END IF

' // Set the pixel format
IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
EXIT FUNCTION
END IF

' // Create a new OpenGL rendering context
m_hrc = wglCreateContext(m_hdc)
IF m_hrc = 0 THEN
MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
SendMessage m_hDlg, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF

' // Make it current
IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
SendMessage m_hDlg, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF

' // Return success
FUNCTION = %TRUE
END FUNCTION
Petr Schreiber
27-11-2024, 11:38
Hi Frank,

you can get inspired by my approach in TBGL by having a closer look at these two files:
https://github.com/ThinBASIC/thinBasic_TBGL/blob/master/src/tbgl_Window.inc
https://github.com/ThinBASIC/thinBasic_TBGL/blob/master/src/tbgl_Window.Internal.inc

For a true state of the art, you may consider digging deeper into José Roca's examples as well.


Petr