Object Windows

[Larry Charlton]

Here's a minimal object based GUI. To use it you include winobj.inc. This exposes two functions and four interfaces.

Functions

• GetApp - returns an instance of an iAppilcation object. In this case it happens to be a SimpleApplication object.
• NewMessageBridge - returns an instance of an iMessageBridge. This is used to handle the transition from functions to objects.

Interfaces

• iMessageBridge - Bridge from functions to objects
• iMessage - An interface that any "Windowing" object must implement. It has one function, the control proc.
• iSimpleApplication - A sample reference application that allows access to predefined top window and child window classes as well as the message handline procedure.
• iApplication - The interface for any application.

winobj.inc

'Declare Function GetApp() Common As iApplication
'Declare Function NewMessageBridge(bridgeTo As iMessage, ByVal hWnd As Dword ) Common As iMessageBridge
'
'===========================================================================
'External interfaces
'===========================================================================
'Interface iMessageBridge Guid$("{3fa159d7-c691-4d6c-9104-5e034469097b}")
'  Inherit IUnknown
'  Method SetBridge( bridgeTo As iMessage, ByVal hWnd As Dword )
'  Method ClearBridge()
'End Interface
'
'Interface iMessage Guid$("{2e0e23cf-6e19-4a88-a33c-2cca8397778f}")
'  Inherit IUnknown
'  Method Proc( ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long, ByRef ret As Long) As Long
'End Interface
'
'Interface iSimpleApplication Guid$("{f0c50578-fb2d-4115-b615-f01838e22266}")
'  Inherit IUnknown
'  Property Get WindowClassname() As WString
'  Property Get ChildClassname() As WString
'  Property Get BridgeProc() As Dword
'End Interface
'
'Interface iApplication Guid$("{ffc3af54-b156-4137-8582-d4897cb66976}")
'  Inherit IUnknown
'  Property Get ActiveWindow() As Dword
'  Property Set ActiveWindow( value As Dword )
'  Method Run()
'End Interface
 
 
#Include Once "win32api.inc"
 
$$APP_CLASS_NAME = "lcApp"
$$CHILD_CLASS_NAME = "lcAppChild"
 
' Consider replacing this implementation with a dictionary of DWord, iMessage
' it will be slower but it will also be safer
Class cMessages Guid$("{3c255bde-47a5-48d6-bcdb-c18815782418}") Common
  Instance objs_() As iMessage
  Instance cnt_ As Long
 
  Class Method Create()
  End Method
  Class Method Destroy()
    Local i As Long
    For i=0 To cnt_
      objs_(i) = Nothing
    Next
    Erase objs_()
  End Method
 
  Interface iMessages Guid$("{b1078b6f-ee69-4464-bd1f-cdc5dc6c282a}")
    Inherit IUnknown
 
    Method Add( obj As iMessage, ByVal hWnd As Dword )
      Local i As Long
      Local ub As Long
 
      If IsFalse IsInterface( obj, iMessage ) Then Exit Method
      If IsWindow( hWnd ) = 0 Then Exit Method
 
      For i=0 To cnt_-1
        If IsFalse IsObject( objs_(i) ) Then Exit For
      Next
      ub = UBound( objs_() )
      If i = cnt_ And cnt_ >= ub Then
        ReDim Preserve objs_( ub+10 )
      End If
      objs_(i) = obj
      SetWindowLong( hWnd, %GWL_USERDATA, i )
      If i=cnt_ Then Incr cnt_
    End Method
 
    Method Remove( obj As iMessage, ByVal hWnd As Dword )
      Local idx As Long
      If IsFalse IsInterface( obj, iMessage ) Then Exit Method
      If IsFalse IsWindow( hWnd ) Then Exit Method
      idx = GetWindowLong( hWnd, %GWL_USERDATA )
      If idx>=0 And idx<cnt_ Then objs_(idx) = Nothing
      SetWindowLong( hWnd, %GWL_USERDATA, -1 )
    End Method
 
    Property Get Item( ByVal hWnd As Dword ) As iMessage
      Local idx As Long
      idx = GetWindowLong( hWnd, %GWL_USERDATA )
      If idx>=0 And idx<cnt_ Then
        Property = objs_(idx)
      End If
    End Property
  End Interface
End Class
 
Function NewMessageBridge(bridgeTo As iMessage, ByVal hWnd As Dword ) Common Export As iMessageBridge
  Local obj As iMessageBridge
  obj = Class "cMessageBridge"
  obj.SetBridge( bridgeTo, hWnd )
  Function = obj
End Function
 
Global globalBridges_ As iMessages
Global haveGlobalBridges_ As Long
 
Class cMessageBridge Guid$("{4c07094b-1bea-4150-85ce-273934df9e22}") Common
  Instance bridgeTo_ As iMessage
  Instance hWnd_ As Dword
  Instance defProc As Dword
 
  Class Method Create()
    If IsFalse haveGlobalBridges_ Then
      globalBridges_ = Class "cMessages"
      If IsInterface( globalBridges_, iMessages ) Then haveGlobalBridges_ = -1 Else End
    End If
  End Method
 
  Class Method Destroy()
    Dim bridge As iMessageBridge
    bridge = Me
    bridge.ClearBridge()
  End Method
 
  Interface iMessageBridge Guid$("{3fa159d7-c691-4d6c-9104-5e034469097b}")
    Inherit IUnknown
 
    Property Get HWnd() As Long
      Property = hWnd_
    End Property
    Method SetBridge( bridgeTo As iMessage, ByVal hWnd As Dword )
      Local bridge As iMessage
      Local mb As iMessageBridge
 
      mb = Me
 
      Call mb.ClearBridge()
 
      If IsFalse IsInterface( bridgeTo, iMessage ) Then Exit Method
      If IsFalse IsWindow( hWnd ) Then Exit Method
 
      hWnd_ = hWnd
 
      ' Sub-class if window didn't use our control proc
      defproc = GetWindowLong( hWnd, %GWL_WNDPROC)
      If defproc <> CodePtr(Bridge_ControlProc) Then
         SetWindowLong( hWnd, %GWL_WNDPROC, CodePtr(Bridge_ControlProc) )
      End If
 
      bridgeTo_ = bridgeTo
      bridge = Me
      globalBridges_.Add( bridge, hWnd )
    End Method
    Method ClearBridge()
      Local bridge As iMessage
 
      ' Reverse subclassing
      If IsInterface( bridgeTo_, iMessage ) Then
        If defproc And defproc <> CodePtr( Bridge_ControlProc ) Then
           SetWindowLong( hWnd_, %GWL_WNDPROC, defProc )
        End If
 
        bridge = Me
        globalBridges_.Remove( bridge, hWnd_ )
        bridgeTo_ = Nothing
      End If
    End Method
  End Interface
 
  ' Process messages
  Interface iMessage Guid$("{2e0e23cf-6e19-4a88-a33c-2cca8397778f}")
    Inherit IUnknown
 
    Method Proc( ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long, ByRef ret As Long) As Long
      If IsInterface( bridgeTo_, iMessage ) Then
        If IsFalse bridgeTo_.Proc( wMsg, wParam, lParam, ret ) Then
          If defProc And defProc <> CodePtr( Bridge_ControlProc ) Then
            ret = CallWindowProc( defProc, hWnd_, wMsg, wParam, lParam )
          Else
            ret = DefWindowProc( hWnd_, wMsg, wParam, lParam )
          End If
          Method = -1
        End If
      End If
    End Method
  End Interface
End Class
 
'==============================================================
' Bridge to class
'==============================================================
Function Bridge_ControlProc( ByVal hWnd As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long
  Local obj As iMessage
  Local ret As Long
 
  If IsFalse haveGlobalBridges_ Then
    globalBridges_ = Class "cMessages"
    If IsInterface( globalBridges_, iMessages ) Then haveGlobalBridges_ = -1 Else End
  End If
  obj = globalBridges_.Item( hWnd )
  If IsInterface( obj, iMessage ) Then
    If obj.Proc( wMsg, wParam, lParam, ret ) Then
      Function = ret
      Exit Function
    End If
  End If
  Function = DefWindowProc( hWnd, wMsg, wParam, lParam )
End Function
 
'==============================================================
' Base application handling
'==============================================================
' Single instance class
Function GetApp() Common Export As iApplication
  Static app_ As iApplication
  Static haveApp_ As Long
 
  If IsFalse haveApp_ Then
    app_ = Class "cSimpleApplication"
    If Not IsObject( app_ ) Then
      End
    End If
    haveApp_ = -1
  End If
  Function = app_
End Function
 
Class cSimpleApplication Guid$("{17750903-c6c4-45cd-a9f6-19d6cfcca5fd}") Common
  Instance activeWindow_ As Dword
 
  Class Method Create()
    Call Me.RegisterClasses()
  End Method
 
  Interface iSimpleApplication Guid$("{f0c50578-fb2d-4115-b615-f01838e22266}")
    Inherit IUnknown
 
    Property Get WindowClassname() As WString
      Property = $$APP_CLASS_NAME
    End Property
    Property Get ChildClassname() As WString
      Property = $$CHILD_CLASS_NAME
    End Property
    Property Get BridgeProc() As Dword
      Property = CodePtr( Bridge_ControlProc )
    End Property
  End Interface
 
  Interface iApplication Guid$("{ffc3af54-b156-4137-8582-d4897cb66976}")
    Inherit IUnknown
 
    Property Get ActiveWindow() As Dword
      Property = activeWindow_
    End Property
    Property Set ActiveWindow( value As Dword )
      activeWindow_ = value
    End Property
 
    Method Run()
      Local msg As tagMSG
 
      Do While GetMessage( msg, %NULL, 0, 0 )>0
        If activeWindow_=0 Or IsDialogMessage( activeWindow_, msg ) = 0 Then
            TranslateMessage( msg )
            DispatchMessage( msg )
        End If
      Loop
    End Method
  End Interface
 
  Class Method RegisterClasses()
    Dim wc As WNDCLASSEX
    Dim className As WString
    Static gInit As Long
 
    If gInit Then Exit Method: ' Already initialized
    gInit=-1
    If GetClassInfoEx(%NULL, $$APP_CLASS_NAME, wc)=0 Then
      ' Register class for top window
      className = $$APP_CLASS_NAME
      wc.style = %CS_HREDRAW Or %CS_VREDRAW
      wc.cbsize = SizeOf(wc)
      wc.lpfnWndProc = CodePtr( Bridge_ControlProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 0
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_3DFACE+1: '%COLOR_WINDOW
      wc.lpszMenuName =  0
      wc.lpszClassName = StrPtr(className)
      If RegisterClassEx( wc )=0 Then
        MsgBox "Application RegisterClass failed"
        End
      End If
    End If
    If GetClassInfoEx(%NULL, $$CHILD_CLASS_NAME, wc)=0 Then
      ' Register class for top window
      className = $$CHILD_CLASS_NAME
      wc.style = 0
      wc.cbsize = SizeOf(wc)
      wc.lpfnWndProc = CodePtr( Bridge_ControlProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 0
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_WINDOW+1: ' %COLOR_3DFACE
      wc.lpszMenuName =  0
      wc.lpszClassName = StrPtr(className)
      If RegisterClassEx( wc )=0 Then
        MsgBox "Child RegisterClass failed"
        End
      End If
    End If
  End Method
End Class

Here's a sample application using the object windowing:
Test.bas

#Compile Exe
#Dim All
#Compiler PBWin 10
#Register All
 
%UNICODE = 1
#Include Once "win32api.inc"
#Include Once "winobj.inc"
 
#Include Once "MainWindow.inc"
#Include Once "Textbox.inc"
#Include Once "Support.inc"
 
Function PBMain () As Long
  Local app As iApplication
  app = GetApp()
 
  Local win As iMainWindow
  win = NewMainWindow( "Test Classes", %CW_USEDEFAULT, %CW_USEDEFAULT, 320, 200 )
  win.Show()
 
  NewEditNumeric( "1", win.HWnd, 10, 10, 100, 23 )
  NewEditNumeric( "2", win.HWnd, 10, 40, 100, 23 )
  NewEditNumeric( "3", win.HWnd, 10, 70, 100, 23 )
 
  app.Run()
End Function

And here's a couple of sample windows and some support routines.
MainWindow.inc

Function NewMainWindow( title As WString, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long ) Common Export As iMainWindow
  Local obj As iMainWindow
  obj = Class "cMainWindow"
  obj.CreateWindow( title, l, t, w, h )
  Function = obj
End Function
 
Class cMainWindow Guid$("{a319a1ad-11b0-4edb-8166-f5232ae95c1a}") Common
  Instance hWnd_ As Dword:            ' Handle to window
  Instance bridge_ As iMessageBridge: ' Message bridge
 
  Interface iMainWindow Guid$("{69bd9b9a-61f9-4cd2-a803-bd6cc364fd00}")
    Inherit IUnknown
 
    Method Show()
      ShowWindow( hWnd_, %SW_ShowNormal )
      UpdateWindow( hWnd_ )
    End Method
 
    Method CreateWindow( title As WString, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long )
      Local vmsg As iMessage: ' This function belongs in the Create method, but PB doesn't support parameterized constructors
      Local app As iSimpleApplication
      Local className As WString
 
      app = GetSimpleApp()
      className = app.WindowClassname()
 
      hWnd_ = CreateWindowEx( 0, ByVal StrPtr(className), ByVal StrPtr(title), %WS_OverlappedWindow Or %WS_ClipChildren, l, t, w, h, %NULL, %NULL, GetModuleHandle( ByVal 0 ), ByVal 0 )
      If IsWindow( hWnd_ ) = 0 Then End
 
      vmsg = Me
      bridge_ = NewMessageBridge( vmsg, hWnd_ ): ' hWnd needs to be valid before this is called
    End Method
    Property Get HWnd() As Dword
      Property = hWnd_
    End Property
  End Interface
 
  Interface iMessage Guid$("{2e0e23cf-6e19-4a88-a33c-2cca8397778f}")
    Inherit IUnknown
 
    Method Proc( ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long, ByRef ret As Long) As Long
      Method = -1: ' Default to handled, ret is already 0
      Select Case wMsg
        Case %WM_SysColorChange: Call Me.OnSysColorChange()
        Case %WM_EraseBkgnd: Exit Method
        Case %WM_MouseActivate:   Method = Me.OnActivate( Mak(Dword, %WA_ACTIVE, 0 )): Exit Method
        Case %WM_Activate:        Call Me.OnActivate( wParam ): Exit Method
        Case %WM_Destroy:         PostQuitMessage(0): Exit Method
      End Select
      Method = 0: ' If we exit this way, we didn't handle message
    End Method
  End Interface
 
  Class Method OnActivate( ByVal wParam As Long ) As Long
    Local app As iApplication
    app = GetApp()
    app.ActiveWindow = IIf&(wParam, hWnd_, 0 )
    If Lo(Word, wParam) <> %WA_INACTIVE Then SetFocus( hWnd_ )
    Method = %MA_ACTIVATE
  End Method
 
  Class Method OnSysColorChange()
    Call EnumChildWindows( hWnd_,  CodePtr( MainWindow_SysColorChange ), 0 ): ' Ensure child controls know of change
  End Method
End Class
 
Function MainWindow_SysColorChange(ByVal hWnd As Dword, ByVal lParam As Long ) As Long
  SendMessage( hWnd, %WM_SYSCOLORCHANGE, 0, 0 )
  Function = %TRUE
End Function

Textbox.inc

Function NewEditNumeric( title As WString, ByVal hParent As Dword, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long ) Common Export As iMainWindow
  Local obj As iEditNumeric
  obj = Class "cEditNumeric"
  obj.CreateWindow( title, hParent, l, t, w, h )
  Function = obj
End Function
 
Class cEditNumeric Guid$("{30CE371E-4115-4FF2-94CE-E0AA6704252F}") Common
  Instance hWnd_ As Dword:            ' Handle to window
  Instance bridge_ As iMessageBridge: ' Message bridge
 
  Interface iEditNumeric Guid$("{75c4658b-57fb-4979-83a2-2c6cceddc6d6}")
    Inherit IUnknown
    Method CreateWindow( text As WString, hParent As Dword, ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long )
      Dim vmsg As iMessage: ' This function belongs in the Create method, but PB doesn't support parameterized constructors
      Local vStyle As Dword
 
      vStyle = %WS_Child Or %WS_Visible Or %WS_TabStop Or %WS_Border
 
      hWnd_ = CreateWindowEx( 0, "EDIT", ByVal StrPtr(Text), vStyle, l, t, w, h, hParent, %NULL, GetModuleHandle( ByVal 0 ), ByVal 0 )
 
      vmsg = Me
      bridge_ = NewMessageBridge( vmsg, hWnd_): ' hWnd needs to be valid before this is called
    End Method
 
    Property Get Text() As WString
      Local ln As Long
      Local buf As WStringZ*2
      ln = GetWindowText( hWnd_, buf, 1 )
      Local tx As WString
      tx = Space$(ln+1)
      GetWindowText( hWnd_, ByVal StrPtr(tx), ln )
      Property = tx
    End Property
    Property Set Text( value As WString )
      SetWindowText( hWnd_, ByVal StrPtr(value) )
    End Property
 
    Method Move(ByVal l As Long, ByVal t As Long, ByVal w As Long, ByVal h As Long )
      MoveWindow( hWnd_, l, t, w, h, %FALSE )
    End Method
  End Interface
 
  Interface iMessage Guid$("{2e0e23cf-6e19-4a88-a33c-2cca8397778f}")
    Inherit IUnknown
 
    Method Proc( ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long, ByRef ret As Long) As Long
      Method = -1: ' Default to handled, ret is already 0
      Select Case wMsg
        Case %WM_Char: If InStr("0123456789" +$Bs, Chr$(wParam))=0 Then Exit Method
      End Select
      Method = 0: ' If we exit this way, we didn't handle message
    End Method
  End Interface
End Class

Support.inc

Function GetSimpleApp() As iSimpleApplication
Dim app As iApplication
Dim simp As iSimpleApplication
app = GetApp()

simp = app
Function = simp
End Function

Function SystemError() Common Export As WString
Local errorCode As Dword
Static buffer As WStringZ * 512
errorCode = GetLastError()
FormatMessage( %FORMAT_MESSAGE_FROM_SYSTEM, ByVal %NULL, errorCode, %NULL, buffer, SizeOf(buffer), ByVal %NULL )
Function = buffer
End Function

[John Montenigro]

In this case it happens to be a SimpleApplication object

OK, this has got to be the year's dumbest question: what is the source of information that tells me such things as a "SimpleApplication object" exists?

I'm trying to make the transition to Objects, and I don't have a starting point.

Can you direct me to a book or website that reveals where all these object structures live, what they're for, and maybe even how to use them? Like when I left DOS, people pointed me to Win32 books and the SDK.

I appreciate any guidance!

Also, although it may take me a weekend, I will play with your code and learn from it. Thank you!

-John

[Larry Charlton]

Source code . At the top of winobj.inc there comments listing the functions and interfaces that I provided to use externally. Documentation, still a dream, might be a scream...

Depending on your needs you could also just put everything in the iApplication interface. A better organization might have been to put the iApplication / iSimpleApplication interfaces at the top of the source code since they would like change depending on the application needs.

Keep in mind that PB only natively provides a handful of interfaces and objects. The PB objects/interfaces can be found in the PB help. see:
INTERFACE, Built-in Interfaces
Object
Power Collection (Most of the collections available on this page)
POWERARRAY
PowerThread
PowerTime

Might be missing a few. The rest of the interfaces / objects you would be writting.

[Larry Charlton]

Updated winobj to use a PowerCollection to map hWnd to classes. It's slower but safer than using USERDATA. Apparently the common control IPAddress uses USERDATA, so if you try to stuff and address in there, things go BOOM.

winobj.inc

'Declare Function GetApp() Common As iApplication
'Declare Function NewMessageBridge(bridgeTo As iMessage, ByVal hWnd As Dword ) Common As iMessageBridge
'
'===========================================================================
'External interfaces
'===========================================================================
'Interface iMessageBridge Guid$("{3fa159d7-c691-4d6c-9104-5e034469097b}")
'  Inherit IUnknown
'
'  Property Get HWnd() As Long
'  Method SetBridge( bridgeTo As iMessage, ByVal hWnd As Dword )
'  Method ClearBridge()
'End Interface
'
'Interface iMessage Guid$("{2e0e23cf-6e19-4a88-a33c-2cca8397778f}")
'  Inherit IUnknown
'  Method Proc( ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long, ByRef ret As Long) As Long
'End Interface
'
'Interface iSimpleApplication Guid$("{f0c50578-fb2d-4115-b615-f01838e22266}")
'  Inherit IUnknown
'  Property Get WindowClassname() As WString
'  Property Get ChildClassname() As WString
'  Property Get BridgeProc() As Dword
'End Interface
'
'Interface iApplication Guid$("{ffc3af54-b156-4137-8582-d4897cb66976}")
'  Inherit IUnknown
'  Property Get ActiveWindow() As Dword
'  Property Set ActiveWindow( value As Dword )
'  Method Run()
'End Interface
 
 
#Include Once "win32api.inc"
 
$$APP_CLASS_NAME = "lcApp"
$$CHILD_CLASS_NAME = "lcAppChild"
 
' Consider replacing this implementation with a dictionary of DWord, iMessage
' it will be slower but it will also be safer
Global msgMap_ As IPowerCollection
Global haveMsgMap_ As Long
 
Function NewMessageBridge(bridgeTo As iMessage, ByVal hWnd As Dword ) Common Export As iMessageBridge
  Local obj As iMessageBridge
  obj = Class "cMessageBridge"
  obj.SetBridge( bridgeTo, hWnd )
  Function = obj
End Function
 
Class cMessageBridge Guid$("{4c07094b-1bea-4150-85ce-273934df9e22}") Common
  Instance bridgeTo_ As iMessage
  Instance handle_ As Dword
  Instance defProc As Dword
 
  Class Method Create()
    If IsFalse haveMsgMap_ Then
      msgMap_ = Class "PowerCollection"
      If IsInterface( msgMap_, IPowerCollection ) Then haveMsgMap_ = -1 Else End
    End If
  End Method
 
  Class Method Destroy()
    Dim bridge As iMessageBridge
    bridge = Me
    bridge.ClearBridge()
  End Method
 
  Interface iMessageBridge Guid$("{3fa159d7-c691-4d6c-9104-5e034469097b}")
    Inherit IUnknown
 
    Property Get Handle() As Long
      Property = handle_
    End Property
    Method SetBridge( bridgeTo As iMessage, ByVal hWnd As Dword )
      Local bridge As iMessage
      Local mb As iMessageBridge
 
      mb = Me
 
      Call mb.ClearBridge()
 
      If IsFalse IsInterface( bridgeTo, iMessage ) Then Exit Method
      If IsFalse IsWindow( hWnd ) Then Exit Method
 
      handle_ = hWnd
 
      ' Sub-class if window didn't use our control proc
      defproc = GetWindowLong( hWnd, %GWL_WNDPROC)
      SetWindowLong( hWnd, %GWL_WNDPROC, CodePtr(Bridge_ControlProc) )
 
      bridgeTo_ = bridgeTo
      bridge = Me
      Local key As WString
      key = Format$( hWnd, "0")
      msgMap_.Add( key, bridge )
    End Method
    Method ClearBridge()
      Local bridge As iMessage
 
      ' Reverse subclassing
      If IsInterface( bridgeTo_, iMessage ) Then
        SetWindowLong( handle_, %GWL_WNDPROC, defProc )
 
        bridge = Me
        Local key As WString
        key = Format$( handle_, "0")
        msgMap_.Remove( key )
        bridgeTo_ = Nothing
      End If
    End Method
  End Interface
 
  ' Process messages
  Interface iMessage Guid$("{2e0e23cf-6e19-4a88-a33c-2cca8397778f}")
    Inherit IUnknown
 
    Method Proc( ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long, ByRef ret As Long) As Long
      If IsInterface( bridgeTo_, iMessage ) Then
        If IsFalse bridgeTo_.Proc( wMsg, wParam, lParam, ret ) Then
          If defProc And defProc <> CodePtr( Bridge_ControlProc ) Then
            ret = CallWindowProc( defProc, handle_, wMsg, wParam, lParam )
          Else
            ret = DefWindowProc( handle_, wMsg, wParam, lParam )
          End If
          Method = -1
        End If
      End If
    End Method
  End Interface
End Class
 
'==============================================================
' Bridge to class
'==============================================================
Function Bridge_ControlProc( ByVal hWnd As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long
  Local obj As iMessage
  Local ret As Long
  Local v As Variant
 
  Local key As WString
  key = Format$( hWnd, "0")
  v = msgMap_.Item( key )
  obj = v
  If IsInterface( obj, iMessage ) Then
    If obj.Proc( wMsg, wParam, lParam, ret ) Then
      Function = ret
      Exit Function
    End If
  End If
  Function = DefWindowProc( hWnd, wMsg, wParam, lParam )
End Function
 
'==============================================================
' Base application handling
'==============================================================
' Single instance class
Function GetApp() Common Export As iApplication
  Static app_ As iApplication
  Static haveApp_ As Long
 
  If IsFalse haveApp_ Then
    If IsFalse haveMsgMap_ Then
      msgMap_ = Class "PowerCollection"
      If IsInterface( msgMap_, IPowerCollection ) Then haveMsgMap_ = -1 Else End
    End If
 
    app_ = Class "cSimpleApplication"
    If Not IsObject( app_ ) Then
      End
    End If
    haveApp_ = -1
  End If
  Function = app_
End Function
 
Class cSimpleApplication Guid$("{17750903-c6c4-45cd-a9f6-19d6cfcca5fd}") Common
  Instance activeWindow_ As Dword
 
  Class Method Create()
    Call Me.RegisterClasses()
  End Method
 
  Interface iSimpleApplication Guid$("{f0c50578-fb2d-4115-b615-f01838e22266}")
    Inherit IUnknown
 
    Property Get WindowClassname() As WString
      Property = $$APP_CLASS_NAME
    End Property
    Property Get ChildClassname() As WString
      Property = $$CHILD_CLASS_NAME
    End Property
    Property Get BridgeProc() As Dword
      Property = CodePtr( Bridge_ControlProc )
    End Property
  End Interface
 
  Interface iApplication Guid$("{ffc3af54-b156-4137-8582-d4897cb66976}")
    Inherit IUnknown
 
    Property Get ActiveWindow() As Dword
      Property = activeWindow_
    End Property
    Property Set ActiveWindow( value As Dword )
      activeWindow_ = value
    End Property
 
    Method Run()
      Local msg As tagMSG
 
      Do While GetMessage( msg, %NULL, 0, 0 )>0
        If activeWindow_=0 Or IsDialogMessage( activeWindow_, msg ) = 0 Then
            TranslateMessage( msg )
            DispatchMessage( msg )
        End If
      Loop
    End Method
  End Interface
 
  Class Method RegisterClasses()
    Dim wc As WNDCLASSEX
    Dim className As WString
    Static gInit As Long
 
    If gInit Then Exit Method: ' Already initialized
    gInit=-1
    If GetClassInfoEx(%NULL, $$APP_CLASS_NAME, wc)=0 Then
      ' Register class for top window
      className = $$APP_CLASS_NAME
      wc.style = %CS_HREDRAW Or %CS_VREDRAW
      wc.cbsize = SizeOf(wc)
      wc.lpfnWndProc = CodePtr( Bridge_ControlProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 0
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_3DFACE+1: '%COLOR_WINDOW
      wc.lpszMenuName =  0
      wc.lpszClassName = StrPtr(className)
      If RegisterClassEx( wc )=0 Then
        MsgBox "Application RegisterClass failed"
        End
      End If
    End If
    If GetClassInfoEx(%NULL, $$CHILD_CLASS_NAME, wc)=0 Then
      ' Register class for top window
      className = $$CHILD_CLASS_NAME
      wc.style = 0
      wc.cbsize = SizeOf(wc)
      wc.lpfnWndProc = CodePtr( Bridge_ControlProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 0
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_WINDOW+1: ' %COLOR_3DFACE
      wc.lpszMenuName =  0
      wc.lpszClassName = StrPtr(className)
      If RegisterClassEx( wc )=0 Then
        MsgBox "Child RegisterClass failed"
        End
      End If
    End If
  End Method
End Class