Hey all this is an example of how to do a multi-threaded com component with events for Visual Basic. Everyone knows if you create threads in vb it crashes.

Code:
'---------------------------------------------------------------------
' Author    :  Thomas Tierney
' Purpose   :  The source code is provided to show how to create a
'              multi threaded com component that can be safely be used
'              in VB. We all know that VB doesnt act nicely when it comes
'              to threads so any event that needs to be triggered must
'              be done from the main thread. The only part I do not like
'              is the fact that the "EVENT HANDLER" sub "DOIT" is exposed
'              in the type library. I would prefer it to be invisible.
'              this is very close to the PREFERED way of doing it, as far as
'              I can tell :)
' Date      :
'---------------------------------------------------------------------
    
#COMPILE DLL
#DIM ALL

#COM NAME "VBASICEventLibrary", 1.0
#COM TLIB ON
#COM DOC "Visual Basic Event Test Server"
#COM GUID GUID$("{81587687-D0F2-43FB-8D8C-D163FFD0CFDE}"))

#INCLUDE "Win32API.inc"

GLOBAL ghInstance AS DWORD
GLOBAL hDlg   AS DWORD


%MSG = %WM_USER + 500
FUNCTION LIBMAIN (BYVAL hInstance   AS LONG, _
                  BYVAL fwdReason   AS LONG, _
                  BYVAL lpvReserved AS LONG) AS LONG
    SELECT CASE fwdReason
        CASE %DLL_PROCESS_ATTACH
            ghInstance = hInstance
            FUNCTION = 1   'success!
        CASE %DLL_PROCESS_DETACH
            FUNCTION = 1   'success!
        CASE %DLL_THREAD_ATTACH
            FUNCTION = 1   'success!
        CASE %DLL_THREAD_DETACH
            FUNCTION = 1   'success!
    END SELECT
END FUNCTION

FUNCTION TestThread(BYVAL OBJECTPTR AS DWORD) AS DWORD
    '---------------------------------------------------------------------
    ' Author    :  Thomas Tierney
    ' Purpose   :  Test thread to send messages with the object pointer
    '              To the dialog
    ' Date      :
    '---------------------------------------------------------------------
    LOCAL iCount AS LONG
    LOCAL tObject AS DISPATCH
    LOCAL lObject AS DWORD
    LOCAL vResult AS VARIANT
    LOCAL lReserved AS LONG
    
    lReserved = 0
    
    
    
    FOR iCount = 1 TO 5
        DIALOG SEND hDlg, %MSG, OBJECTPTR, iCount
        SLEEP 1000
    NEXT iCount

END FUNCTION

THREAD FUNCTION DoeventsThread(BYVAL DUMMY AS DWORD) AS DWORD
    '---------------------------------------------------------------------
    ' Author    : Thomas Tierney
    ' Purpose   : Do Events thread to keep the dialog from choking
    ' Date      :
    '---------------------------------------------------------------------
    LOCAL X AS LONG
    DO
        DIALOG DOEVENTS
        DIALOG GET SIZE hDlg TO x, x
    LOOP WHILE x& ' When x& = 0, dialog has ended

END FUNCTION


CALLBACK FUNCTION ConnectProc() AS LONG
    '---------------------------------------------------------------------
    ' Author    : Thomas Tierney
    ' Purpose   : Dialog Procedure to handle object messages and to fire
    '             Events on the main thread
    ' Date      :
    '---------------------------------------------------------------------
    LOCAL tObject AS DISPATCH
    LOCAL dObject AS DWORD
    LOCAL lProgress AS LONG
    


    SELECT CASE AS LONG CBMSG
        CASE %MSG
            dObject = CBWPARAM
            POKE DWORD,VARPTR(tObject),dObject
            OBJECT CALL tObject.Doit(lProgress)
            POKE DWORD,VARPTR(tObject), 0
        CASE ELSE
            'Do nothing
    END SELECT

END FUNCTION


INTERFACE EVENT_TEST GUID$("{39B83F43-1108-48B7-9751-0194B62339F8}") AS EVENT
    '---------------------------------------------------------------------
    ' Author    : Thomas Tierney
    ' Purpose   : Main Event Interface
    ' Date      :
    '---------------------------------------------------------------------
    INHERIT IUNKNOWN
    METHOD Progress(BYVAL Percent AS LONG)
END INTERFACE


CLASS  CAPPLICATION GUID$("{5BE00DB6-9E7B-47D9-8B18-76712765E86F}") AS COM
'---------------------------------------------------------------------
' Author    : Thomas Tierney
' Purpose   : The Application Class
' Date      :
'---------------------------------------------------------------------
    CLASS METHOD CREATE ALIAS "Create"()
    '---------------------------------------------------------------------
    ' Author    : Thomas Tierney
    ' Purpose   : Create Our main dialog to handle object event messages
    ' Date      :
    '---------------------------------------------------------------------
    LOCAL Result AS LONG
    LOCAL lResult AS LONG
    LOCAL lReserved AS LONG
    lReserved = 0
    
    CoinitializeEx lReserved,0
    
    DIALOG NEW 0, "",,, 0, 0 TO hDlg
    DIALOG SHOW MODELESS hDlg CALL ConnectProc TO Result
    DIALOG SHOW STATE %SW_HIDE, hDlg

    'now lets call our doevents thread
    THREAD CREATE doeventsthread(1) TO lResult
    THREAD CLOSE lResult TO lResult

    END METHOD


    CLASS METHOD Destroy ALIAS "Destroy"()
    '---------------------------------------------------------------------
    ' Author    : Thomas Tierney
    ' Purpose   : Close the dialog when the object is destroyed
    ' Date      :
    '---------------------------------------------------------------------
        'Close the dialog
        DIALOG END hDlg,%TRUE
        CoUninitialize
        
    END METHOD


    'CLASS METHOD TriggerEvent(BYVAL i AS LONG)
    '---------------------------------------------------------------------
    ' Author    :
    ' Purpose   :
    ' Date      :
    '---------------------------------------------------------------------
    '     RAISEEVENT EVENT_TEST.Progress(i)
    'END METHOD
    INTERFACE APPLICATION GUID$("{85B6D13D-0E6A-4E9B-9934-F420DFE6C6F4}")

        INHERIT DUAL
        METHOD Doit ALIAS "Doit"(BYVAL lProgress AS LONG)
        '---------------------------------------------------------------------
        ' Author    : Thomas Tierney
        ' Purpose   : Main "EVENT" handler function call.
        ' Date      :
        '---------------------------------------------------------------------
            RAISEEVENT EVENT_TEST.Progress(lProgress)
        END METHOD

        METHOD Submit ALIAS "Submit"() AS LONG
        '---------------------------------------------------------------------
        ' Author    : Thomas Tierney
        ' Purpose   : Sets the object to me, and passes "ME" off to the test thread
        '             This is so we can pass the entire object off in the CBWPARAM
        '             in the send message
        ' Date      :
        '---------------------------------------------------------------------
            LOCAL tResult AS LONG
            LOCAL tObject AS DISPATCH

            LET tObject = ME
            THREAD CREATE TestThread(OBJPTR(tObject)) TO tResult
            THREAD CLOSE tResult TO tResult
        END METHOD
    END INTERFACE
    EVENT SOURCE EVENT_TEST
END CLASS