Sample Code 13

Fortran module f90VBGUIUtils with new function CMainTestEventsHandler. Also note the new module-level variables (new code in the module is indicated in red)

module f90VBGUIUtils

!load f90VB modules

use f90VBDefs

use f90VBBStrings

use f90VBVariants

use f90VBAutomation

implicit none

type(VARIANT):: CInput

integer::UpperValue=10

type(VARIANT)::CMain

logical::QuitApplication

contains

function CMainTestEventsHandler(DispID, nArgs, VarArgList, nNamedArgs, DispIDList)

    !procedure arguments

    integer(HRESULT_KIND)::CMainTestEventsHandler

    integer(LONG_KIND),intent(in)::DispID

    integer(LONG_KIND),intent(in)::nArgs

    type(VARIANT),intent(inout)::VarArgList(nArgs)

    integer(LONG_KIND),intent(in)::nNamedArgs

    integer(LONG_KIND),intent(in)::DispIDList(nNamedArgs)

    select case (DispID)

        case(1) !OnQuit

            print *,'Quitting'

            QuitApplication=.true.

        case(2) !OnLogTableClick event

            print *,'Menu Option Logs Table selected'

        case(3) !OnFactorialTableClick

            print *,'Menu Option Factorials Table selected'

        case(4) !OnAboutBoxClick

            call DisplayAboutBox()

        case(5) !OnExcelChartClick

            print *,'Menu Option Excel Chart selected'

    end select

    CMainTestEventsHandler = S_OK

end function CMainTestEventsHandler

subroutine GetInputValue(CInput, DescText, TopRange, InputValue, OpCanceled)

    !procedure arguments

    type(VARIANT),intent(in)::CInput

    character(len=*),intent(in):: DescText

    integer,intent(in)::TopRange

    integer,intent(inout)::InputValue

    logical,intent(out)::OpCanceled

    type(VARIANT)::VarTmp

    !set the MaxValue property of the object

    call PropertyPut(CInput,'MaxValue',VariantCreate(VT_I4,TopRange))

    !Set the default input value

    call PropertyPut(CInput,'InputValue',VariantCreate(VT_I4, InputValue))

    !Set the description text

    VarTmp = VariantCreate(VT_BSTR, DescText)

    call PropertyPut(CInput,'DescrText',VarTmp)

    !Clear the BString in VarTmp

    call VariantClear(VarTmp)

    !Show the input window and wait for a user answer

    VarTmp = ExecMethod(CInput,'Show')

    OpCanceled = VariantToLogical(PropertyGet(CInput,'OpCanceled'))

    if (.not. OpCanceled) then

        InputValue = VariantToInteger(PropertyGet(CInput,'InputValue'))

    endif

end subroutine GetInputValue

subroutine DisplayAboutBox()

    !internal variables

    type(VARIANT)::CAbout

    type(VARIANT)::VarTmp

    integer(HRESULT_KIND)::iRet

    !Create an instance of the CAbout object

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

    if (iRet.eq.S_OK) then

        !Show the about window

        VarTmp = ExecMethod(CAbout,'Show')

        !clean up

        call Release(CAbout)

        call VariantClear(VarTmp)

    endif

end subroutine DisplayAboutBox

subroutine DisplayError(ErrorMessage)

    !procedure arguments

    character(len=*),intent(in)::ErrorMessage

    !internal variables

    type(VARIANT)::CError, VarErrMsg

    type(VARIANT)::VarTmp

    integer(HRESULT_KIND)::iRet

    !Create an instance of the CError object

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

    if (iRet.eq.S_OK) then

        !Set its ErrorMessage property

        VarErrMsg = VariantCreate(VT_BSTR,ErrorMessage)

        call PropertyPut(CError,'ErrorMessage',VarErrMsg)

        !Show the error window

        VarTmp = ExecMethod(CError,'Show',VariantCreate(VT_BOOL,.true.))

        !clean up

        call Release(CError)

        call VariantClear(VarErrMsg)

        call VariantClear(VarTmp)

    endif

end subroutine DisplayError

end module f90VBGUIUtils

Sample Code 14a