' 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
Reply With Quote
Bookmarks