Sample Code 18b

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

program Main

use f90VBDefs

use f90VBautomation

use f90VBGUIUtils

use dfwinty, only: T_MSG 

use user32, only: GetMessage, DispatchMessage

implicit none

integer(HRESULT_KIND)::iRet

type(VARIANT)::VarTmp

integer(POINTER_KIND)::EventSinkHndl

type(T_MSG)::mesg

!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=GetMessage (mesg, 0, 0, 0)

        iRet=DispatchMessage( 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 18c