Tweet
Hey,
Like most of you I've been getting my head around the features in the new compilers. My latest project has me scratching my head a little and I was wonder if we could kick the idea around...
What do you all think of having a message pump inside an object?
In my test program everything works but I'm just wondering if there is something I'm not seeing that could be a problem down the road.
Like most of you I've been getting my head around the features in the new compilers. My latest project has me scratching my head a little and I was wonder if we could kick the idea around...
What do you all think of having a message pump inside an object?
In my test program everything works but I'm just wondering if there is something I'm not seeing that could be a problem down the road.
Code:
#compiler pbwin
#compile exe
#dim all
#include once "Win32api.inc"
'==============================================================================
' Constants
'------------------------------------------------------------------------------
$APP_CLASS_NAME = "AppObjectTest32"
'==============================================================================
' Application Class
'------------------------------------------------------------------------------
class CApplication
instance m_hInstance as long
instance m_hWnd as long
interface IApplication
inherit iunknown
'----------------------------------------------------------------------
' Get main window handle
'----------------------------------------------------------------------
property get hWnd() as long
property = m_hWnd
end property
'----------------------------------------------------------------------
' Register application window class
'----------------------------------------------------------------------
method RegisterWindowClass() as long
dim pWindow as WNDCLASSEX
dim szClass as asciiz * 256
'Setup class name
szClass = $APP_CLASS_NAME
'Setup window class structure
pWindow.cbSize = len(WNDCLASSEX)
pWindow.style = 0
pWindow.lpfnWndProc = codeptr(MainProc)
pWindow.cbClsExtra = 0
pWindow.cbWndExtra = 0
pWindow.hInstance = m_hInstance
pWindow.hIcon = LoadImage(%NULL, byval %IDI_APPLICATION, %IMAGE_ICON, 32, 32, %LR_DEFAULTCOLOR)
pWindow.hIconSm = LoadImage(%NULL, byval %IDI_APPLICATION, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
pWindow.hCursor = LoadCursor(%NULL, byval %IDC_CROSS)
pWindow.hbrBackground = GetStockObject(%DKGRAY_BRUSH)
pWindow.lpszClassName = varptr(szClass)
pWindow.lpszMenuName = %NULL
'Register window class
if RegisterClassEx(pWindow) = %NULL then
MessageBox(%HWND_DESKTOP, "Unable to register windows class: " & szClass, "Error", %mb_iconerror or %mb_ok)
method = %FALSE
exit method
end if
'Success
method = %TRUE
end method
'----------------------------------------------------------------------
' Create main application window
'----------------------------------------------------------------------
method CreateWindow(byval szCaption as string, optional byval lWidth as long, optional byval lHeight as long) as long
dim szClass as asciiz * 256
dim szTitle as asciiz * 256
dim dwStyle as dword
'Setup window style, class and title
dwStyle = %ws_overlappedwindow or %ws_clipchildren
szClass = $APP_CLASS_NAME
szTitle = szCaption
'Check width and height
if (lWidth = 0) then lWidth = %CW_USEDEFAULT
if (lHeight = 0) then lHeight = %CW_USEDEFAULT
'Create main window
m_hWnd = CreateWindowEx(%NULL, szClass, szTitle, dwStyle, %CW_USEDEFAULT, %CW_USEDEFAULT, lWidth, lHeight, %NULL, %NULL, m_hInstance, byval %NULL)
if (m_hWnd = %NULL) then
method = %FALSE
exit method
end if
'Success
method = %TRUE
end method
'----------------------------------------------------------------------
' Initialize StrataGraphics
'----------------------------------------------------------------------
method Startup(byval hInstance as long, byval lCmdShow as long) as long
dim msg as TAGMSG
'Save instance handle
m_hInstance = hInstance
'Register window class and check result
if isfalse me.RegisterWindowClass() then
method = %FALSE
exit method
end if
'Create main window and check result
if isfalse me.CreateWindow("Main Window", 640, 480) then
method = %FALSE
exit method
end if
'Show main window
ShowWindow(m_hWnd, lCmdShow)
method = %TRUE
end method
'----------------------------------------------------------------------
' Run application (begin message loop)
'----------------------------------------------------------------------
method Run() as long
dim msg as TAGMSG
'Begin message loop
do until (msg.message = %wm_quit)
if istrue PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE) then
TranslateMessage(msg)
DispatchMessage(msg)
else
me.RunBackgroundTask()
end if
loop
'Return wParam
method = msg.wParam
end method
'----------------------------------------------------------------------
' Background task processing
'----------------------------------------------------------------------
method RunBackgroundTask()
dim dwLast as static dword
dim dwTime as dword
'Get current ticks
dwTime = GetTickCount()
if (abs(dwTime - dwLast) >= 1000) then
SetWindowText(m_hWnd, time$)
dwLast = dwTime
end if
sleep 1
end method
'----------------------------------------------------------------------
' Cleanup any allocated resources
'----------------------------------------------------------------------
method Shutdown() as long
end method
end interface
end class
'==============================================================================
' Main window handler
'------------------------------------------------------------------------------
function MainProc(byval hWnd as long, byval uMsg as long, byval wParam as long, byval lParam as long) as long
dim lWidth as static long
dim lHeight as static long
select case uMsg
case %wm_destroy
PostQuitMessage(0)
case %wm_size
lWidth = lo(word, lParam)
lHeight = hi(word, lParam)
case else
function = DefWindowProc(hWnd, uMsg, wParam, lParam)
end select
end function
'==============================================================================
' Application entry point
'------------------------------------------------------------------------------
function winmain(byval hInstance as long, byval hPrevInst as long, byval pszCmdLine as asciiz ptr, byval lCmdShow as long) as long
dim App as IApplication
'Create application object
App = class "CApplication"
if isobject(App) then
'Initialize application
if App.Startup(hInstance, lCmdShow) then
'Run application
function = App.Run()
App.Shutdown()
end if
end if
end function
- I get the address of the MainProc in the program body and pass it as a variable to the class. It makes me feel a little less uncomfortable about breaking through the encapsulation. 
Comment