Passing Variants

Variant arguments can be passed by value or reference. When a Visual Basic program calls a procedure declared to receive a Variant by reference, the calling program passes a pointer to the Variant variable. If the procedure is declared to receive a Variant argument by value, then the calling program passes the complete Variant structure (sixteen bytes) in the stack. This is an important consideration, because not all Fortran compilers are able to handle arguments passed by value.

Example 4.5

In this example, you will 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 [23]:

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

!cast, SineX will return an empty variant

!Note: This function cannot handle Safe Arrays

use f90VBDefs

use f90VBVariants

implicit none

!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

!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 (see Chapter 5 for details on how to do this with the compiler you are using).

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 (Figure 4.7).

The Visual Basic code associated to the form in Figure 4.7 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.

Creating Fortran Subroutines Callable From Visual Basic