Announcement

Collapse
No announcement yet.

Message Pump inside Object

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Message Pump inside Object

    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.


    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
    Start as you mean to go on.

  • #2
    Looks a bit familiar.
    See last post: http://www.powerbasic.com/support/pb...ad.php?t=38317

    I'm still working on the library.

    James

    Comment


    • #3
      Yup

      Hi James,

      I'm sure subconsciously I nicked some things from your example. I remember seeing it a little while ago.

      Have you run into any problems having the actual message pump code inside the object?

      I mean for the life of the program the main thread will be running inside the objects method. I know code is code but you have to wonder if there is some hidden issues with it.

      Thanks
      Start as you mean to go on.

      Comment


      • #4
        Nothing is out in the wild yet as I'm still in a development stage, but I don't foresee any problems.

        James

        Comment


        • #5
          Mark,
          It appears, from some of the posts in the PBWin section, that this method would not be the best choice in a multi-threaded App.

          James

          Comment


          • #6
            Nice work, Mark. I'm working on a similar idea. A suggestion from a purist's (read: really anal type) point of view - 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.
            [SIZE="1"]Reprinted with correections.[/SIZE]

            Comment


            • #7
              Originally posted by Ian Webling View Post
              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.
              This sounds like a good idea but not for the reason you listed.
              Now I process all messages in the Main Program Callback but there are some (%WM_CTLCOLORSTATIC,%WM_CTLCOLORBTN, %WM_CTLCOLOREDIT, %WM_CTLCOLORLISTBOX) that could ( and probably should) be processed in a generic callback then call the Main Callback.

              James

              Comment


              • #8
                What now?

                Ok you guys lost me :laugh:

                What is the "Main Program" and "Program Body" ?

                Are you talking about WinMain?
                Start as you mean to go on.

                Comment


                • #9
                  Instead of using a codeptr(MainProc) in the class use it in the "Program Body" *

                  *The {Program Body} being defined as: Not ({Everything in a Class})
                  [SIZE="1"]Reprinted with correections.[/SIZE]

                  Comment


                  • #10
                    >What do you all think of having a message pump inside an object?
                    Code:
                     [  ] Aye     [X] Nay
                    Michael Mattias
                    Tal Systems (retired)
                    Port Washington WI USA
                    [email protected]
                    http://www.talsystems.com

                    Comment

                    Working...
                    X