Sample Code 18c

Program Main. This is the main application program to test the event handler in function CMainEventsHandler and the ActiveX Object CMain. Version for Lahey Fortran 95.

program TestMain

use f90VBDefs

use f90VBautomation

use f90VBGUIUtils

use win32mod, only: MSG, GetMessageA,DispatchMessageA, NULL

implicit none

integer(HRESULT_KIND)::iRet

type(VARIANT)::VarTmp

integer(POINTER_KIND)::EventSinkHndl

type(MSG)::mesg

DLL_IMPORT GetMessageA, DispatchMessageA

!Initialize Ole

iRet = OleInitialize()

!Create an instance of the CMain object

CMain = CreateOleObject('f90VBGUI.CMain',iRet)

!Create an instance of the CInput object

CInput = CreateOleObject('f90VBGUI.CInput',iRet)

if (iRet.eq.S_OK) then

    !Create a f90VBAutomation Event Sink

    EventSinkHndl = EventSinkCreate(iRet)

    !Connect the Event Sink CInput events interface

    call EventSinkConnect(EventSinkHndl, CMain, NullGUID() ,iRet)

    !Register Fortran function for the events we want to handle

    call EventSinkRegEvnt(EventSinkHndl, 'OnLogTableClick', &

                          loc(CMainEventsHandler), iRet)

    call EventSinkRegEvnt(EventSinkHndl, 'OnFactorialTableClick', &

                          loc(CMainEventsHandler), iRet)

    call EventSinkRegEvnt(EventSinkHndl, 'OnAboutBoxClick', &

                          loc(CMainEventsHandler), iRet)

    call EventSinkRegEvnt(EventSinkHndl, 'OnExcelChartClick', &

                          loc(CMainEventsHandler), iRet)

    call EventSinkRegEvnt(EventSinkHndl, 'OnQuit', &

                          loc(CMainEventsHandler), iRet)

    !Display the CMain object

    VarTmp = ExecMethod(CMain,'Show',iRet=iRet)

    !enter a fake message loop, so application can process events

    do while(.not. QuitApplication) 

        iRet=GetMessageA(carg(offset(mesg)), carg(NULL), &

                         carg(0), carg(0))

        iRet=DispatchMessageA(carg(offset(mesg)))

    enddo

    call EventSinkUnregEvnt(EventSinkHndl, 'OnLogTableClick', iRet)

    call EventSinkUnregEvnt(EventSinkHndl, 'OnFactorialTableClick', iRet)

    call EventSinkUnregEvnt(EventSinkHndl, 'OnAboutBoxClick', iRet)

    call EventSinkUnregEvnt(EventSinkHndl, 'OnExcelChartClick', iRet)

    call EventSinkUnregEvnt(EventSinkHndl, 'OnQuit', iRet)

    call EventSinkDisconnect(EventSinkHndl)

    !Destroy the Event Sink object and release its memory

    call EventSinkDestroy(EventSinkHndl)

    !Release the instances of objects and clean up

    call Release(CInput)

    call Release(CMain)

    call VariantClear(VarTmp)

endif

!Uninitialize Ole

call OLEUninitialize()

stop

end

Sample Code 19a