A Fortran function that can compute the Sine of almost anything :-) and how to use it from Visual Basic (Example 4.5)

In this example, we create a Fortran function that computes the trigonometric sine of the provided argument. The argument can be of any type (i.e. an integer, a BString, etc.), except a Safe Array. The result of the function is also returned as a Variant containing a double precision value. Below is the listing of function SineX.

As in other examples, the listing of this function does not include the additional compiler-dependent code necessary to indicate calling convention, modify name-mangling or to create a DLL. These topics are covered in detail in the User Manual.

function SineX(Value)

    !Compute the Sine of the argument in Variant VarVal

    !if Value contains a base type (VT_I4, VT_R8, etc.)
    !SineX returns the computed value in a variant of type
    !double precision. If an error occurs, the return
    !value of SineX is an empty variant

    !Note: Value can be a reference to a string,
    !in which case SineX attempts to cast the variant
    !into a numeric value. If the Value cannot be
    !casted, SineX will return an empty variant

    !Note: This function cannot handle Safe Arrays

    use f90VBDefs
    use f90VBVariants
    implicit none

    !DEC$ATTRIBUTES DLLEXPORT::  SineX
    

    !DEC$ATTRIBUTES STDCALL:: SineX
    !DEC$ATTRIBUTES ALIAS: 'SineX'::SineX
    !DEC$ ATTRIBUTES reference :: Value
    

    !Function arguments
    type(VARIANT)::SineX
    type(VARIANT),intent(in)::Value

    !Internal variables
    type(VARIANT)::varTmp
    integer(HRESULT_KIND)::iRet

    !Initialize varTmp to an empty variant
    varTmp = VariantCreate(iRet)

    !Check that Value is not a Safe Array
    if (iand(Value%varVal%vt,VT_ARRAY).eq.0) then

        !cast the variant into a double precision real
        call VariantChangeType(Value, varTmp, VT_R8, iRet)
        !check for errors in the casting operation
        if (iRet.eq.0) then
            !compute the sine
            varTmp%varVal%dblVal = sin(varTmp%varVal%dblVal)
        endif

    endif

    !Set return values for the function
    SineX = varTmp

end function SineX

As you can see in the code above, function SineX returns a Variant of type VT_R8. The function also receives a single Variant argument, containing the value for which the sine function is to be computed. The first step of the function is to create an empty temporal variant (varTmp):

!Initialize varTmp to an empty variant
varTmp = VariantCreate(iRet)

The function then tests that the passed Variant argument (Value) does not contain a Safe Array, in which case it proceeds to cast the argument into a Variant containing a double precision real:

!cast the variant into a double precision real
call VariantChangeType(Value, varTmp, VT_R8, iRet)

 

If the casting is successful, then the function computes the sine of the cast Variant, which is later returned as the result of the function.

Using your Fortran compiler, you can export function SineX into Example45.dll. You may have to add some compiler-dependent directives to the function.

To call function SineX from Visual Basic or Visual Basic for Applications, you need to declare the function as an external procedure, and provide the location of the DLL file that contains the procedure. Start by creating a new Visual Basic project, and add a module file with the following declaration:

Declare Function SineX Lib "Example45.dll" _
(ByRef Value As Variant) As Variant

As in previous examples, we assume that Example45.dll and the Visual Basic executable reside in the same directory. You can now build a simple form that requests a value from the user and shows the result of the function:

The Visual Basic code associated to the form in is shown below:

Option Explicit

Private Sub cmdGo_Click()
     Text2.Text = SineX(Text1.Text)
End Sub

As you can see, the code is extremely simple. When you click the button cmdGo, the program calls SineX, passing as argument the contents of the text control Text1. The return value of SineX is placed directly into the text control Text2.