Sample Code 19a

Program MainWin. This is the final Windows application program of this tutorial. It uses the event handler in function CMainEventsHandler and the ActiveX Object CMain. Version for Absoft Pro Fortran.

stdcall function WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)

use f90VBDefs

use f90VBautomation

use f90VBGUIUtils

use windows, only: MSG, GetMessage,DispatchMessage, NULL

implicit none

!WinMain function arguments

integer(4) WinMain

integer(4) hInstance

integer(4) hPrevInstance

integer(4) lpszCmdLine

integer(4) nCmdShow

integer(HRESULT_KIND)::iRet

type(VARIANT)::VarTmp

integer(POINTER_KIND)::EventSinkHndl

type(EXCEPINFO)::EInfo

type(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 an 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, EInfo=EInfo)

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

    do while(.not. QuitApplication) 

        iRet=GetMessage(loc(mesg), NULL, NULL, NULL)

        iRet=DispatchMessage(loc(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 instance of IE

    call Release(CInput)

    call Release(CMain)

    call VariantClear(VarTmp)

endif

!Uninitialize Ole

call OLEUninitialize()

! The return value is the wParam of the Quit message

WinMain = mesg.wParam

end function WinMain

Sample Code 19b