Sample Code 6

Fortran module f90VBGUIUtils with new subroutine DisplayAboutBox (new code in the module is indicated in red)

module f90VBGUIUtils

!load f90VB modules

use f90VBDefs

use f90VBBStrings

use f90VBVariants

use f90VBAutomation

implicit none

contains

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 7