Handling arguments by referenceUsing f90VB to access Visual Basic procedures from Fortran
One of the more frequently asked questions posted in Fortran discussion groups is how to call Visual Basic procedures from Fortran. The most common answer you will see is that you can’t. This is not completely true, but the amount of work and knowledge involved in doing this has always been so much that, in most cases, it defeats the reasons for trying to do it; to take advantage of the GUI design tools of Visual Basic that allow easy and fast development. With f90VB, however, accessing Visual Basic procedures from Fortran is a snap. The simple trick you need to know, however; is that you must expose your Visual Basic procedures as methods of an ActiveX object. In this section you will learn how to do this.
Example 6.4
Let’s say you have developed the ultimate Fortran program to compute logarithms. The program accepts an initial value, a final value and a step increment, and then prints a table showing the computed logarithms. This ultimate logarithm program that you have developed may well look like this:
program UltimateLogs
implicit none
real(8)::InitValue, FinalValue, IncStep
real(8)::vLog,Value
print *,'The Ultimate logarithms program'
print *,'Enter Initial Value, Final Value and Step Increment:'
read(*,*) InitValue, FinalValue, IncStep
if ((InitValue.le.0).or.(FinalValue.le.0).or.(IncStep.le.0)) then
print *,'I ain''t falling for this trick'
stop
endif
print *,''
write(*,'(2a15)') 'Value','Log(Value)'
Value=InitValue
do while (Value.le.FinalValue)
write(*,'(2f15.5)') Value,log(value)
Value=Value+IncStep
enddo
stop
end
All you need now to become the next software tycoon is to develop a nice graphic user interface (GUI) for your program. Because your specialty is advanced mathematics and not GUI programming, you decide to contract Canaima Software to create one for you. After an extensive negotiation that finally settles for several million, we provide you with one ActiveX object called UlitmateLogsIO. This object has three properties (InitValue, EndValue and StepIncrement) and two methods (GetInputData and ShowLogTable). The content of the three properties is obvious.
Method GetInputData shows a form on the screen that allows you to modify the properties InitValue, EndValue and StepIncrement (Figure 6.3).
In addition, method GetInputData also accepts three optional arguments. If these arguments are used, then the method uses them to return the values entered by the user [40].
Method ShowLogTable displays the results of the computations performed by your program (Figure 6.4). The method receives one argument, a Safe Array of double precision values, containing two columns and as many lines as necessary.
Now, we are going to show you how to do it. To create the UlitmateLogsIO object you start by opening a new Visual Basic project. Select the ActiveX DLL project type (Figure 6.5).
Visual Basic automatically adds a new class named Class1 to the project. Click on the name of the class, and using the Properties Inspector change the name to UltimateLogsIO (Figure 6.6).
Add the following code to the new class module:
'*******************************************
'******* CLASS UltimateLogsIO **************
'*******************************************
Option Explicit
'local variable(s) to hold property value(s)
Private mvarInitValue As Double 'local copy
Private mvarEndValue As Double 'local copy
Private mvarStepIncrement As Double 'local copy
Private mvarInputForm As frmUltimateLogsInput
Private mvarOutputForm As frmUltimateLogsOutput
Public Sub ShowLogTable(TableArray() As Double)
'Show mvarOutputForm with text control filled out
'with the values passed in TableArray()
Dim i As Long
Dim TmpStr As String
TmpStr = ""
For i = LBound(TableArray, 1) To UBound(TableArray, 1)
TmpStr = TmpStr & TableArray(i, 1) & " " & TableArray(i, 2) & vbCrLf
Next i
mvarOutputForm.Text1 = TmpStr
mvarOutputForm.Show vbModal
End Sub
Public Function GetInputData(Optional InitValue As Double = -1, _
Optional EndValue As Double = -1, _
Optional StepIncrement As Double = -1) _
As Boolean
'Get input data from the user
On Error GoTo ErrHndl
'Set the values in the form
mvarInputForm.Text1 = Me.InitValue
mvarInputForm.Text2 = Me.EndValue
mvarInputForm.Text3 = Me.StepIncrement
'Display the form allowing user to change the values
mvarInputForm.Show vbModal
'Set the object properties from user input
Me.InitValue = mvarInputForm.Text1
Me.EndValue = mvarInputForm.Text2
Me.StepIncrement = mvarInputForm.Text3
'Check that InitValue is lower than EndValue
If InitValue > EndValue Then
Err.Raise (20000 Or vbObjectError)
End If
'Return true to indicate success
GetInputData = True
'If user passed optional arguments, return property values
If (InitValue <> -1) Then InitValue = Me.InitValue
If (EndValue <> -1) Then EndValue = Me.EndValue
If (StepIncrement <> -1) Then StepIncrement = Me.StepIncrement
Exit Function
ErrHndl:
GetInputData = False
If Err.Number = (20000 Or vbObjectError) Then
Err.Raise (20001 Or vbObjectError), _
"UltimateLogsIOServer.UltimateLogsIO", _
"Invalid input value/s"
Else
Err.Raise (20002 Or vbObjectError), _
"UltimateLogsIOServer.UltimateLogsIO", _
"Unexpected error"
End If
End Function
Public Property Let StepIncrement(ByVal vData As Double)
If vData > 0 Then
mvarStepIncrement = vData
Else
Err.Raise (20000 Or vbObjectError), _
"UltimateLogsIOServer.UltimateLogsIO", _
"Invalid property value"
End If
End Property
Public Property Get StepIncrement() As Double
StepIncrement = mvarStepIncrement
End Property
Public Property Let EndValue(ByVal vData As Double)
If vData > 0 Then
mvarEndValue = vData
Else
Err.Raise (20000 Or vbObjectError), _
"UltimateLogsIOServer.UltimateLogsIO", _
"Invalid property value"
End If
End Property
Public Property Get EndValue() As Double
EndValue = mvarEndValue
End Property
Public Property Let InitValue(ByVal vData As Double)
If vData > 0 Then
mvarInitValue = vData
Else
Err.Raise (20000 Or vbObjectError), _
"UltimateLogsIOServer.UltimateLogsIO", _
"Invalid property value"
End If
End Property
Public Property Get InitValue() As Double
InitValue = mvarInitValue
End Property
Private Sub Class_Initialize()
'Set default values for properties
mvarInitValue = 1
mvarEndValue = 10
mvarStepIncrement = 1
Set mvarInputForm = New frmUltimateLogsInput
Set mvarOutputForm = New frmUltimateLogsOutput
End Sub
Private Sub Class_Terminate()
'Remove forms from memory
Set mvarInputForm = Nothing
Set mvarOutputForm = Nothing
End Sub
There is not much to explain in this code. Subroutine Class_Initialize is run when the class is instantiated, it sets the default values for the class properties and creates two forms frmUltimateLogsInput and frmUltimateLogsOutput. These are the forms shown to the user when you call methods GetInputData and ShowLogTable, repectively. Class_Terminate is the procedure called just before the object is unloaded from memory. In this case all it does is to ensure that the two forms used by the object are unloaded (we achieve this by setting the variables that hold the forms to Nothing). The functions to set and get the properties of the object are very standard, they check that you pass acceptable values to set the properties and raise an exception if you don’t..
Now you need to create the two forms used by the object. Add a new form to the project (click on Project/Add Form on the main menu). Rename the form to frmUltimateLogsInput, and add three text controls, one command button and four label controls as shown in Figure 6.7.
Add the following code to the form:
Private Sub Command1_Click()
Me.Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Only unload the form if requested programmatically
If UnloadMode = vbFormControlMenu Then
Me.Visible = False
Cancel = True
End If
End Sub
Command1_Click is the code executed when the user clicks the Command1 button, which will hide the form. Form_QueryUnload uses a little trick. This procedure is executed before the form is unloaded from memory. If argument Cancel is set to True, the unloading is canceled and the form stays in memory. This is done by checking if the user has clicked the Close Window icon (that little X icon on the top right corner of the form), in which case the form becomes invisible rather than unloading. So the only way to unload the form from memory is programmatically or when forced by the operating system.
Add another form and name it frmUltimateLogsOutput. Add two label controls, one text control and one command button control as shown in Figure 6.8.
Open the code window for form frmUltimateLogsOutput and add exactly the same code you used in form frmUltimateLogsInput.
Ok, you are almost there. Open the Project Properties Window (click on Project/Properties in the main menu bar) and set the name of the project to UltimateLogsIOServer (Figure 6.9).
Save everything and compile and link your project (click on File/Make UltimateLogsIOServer dll…). You have now produced an in-process server (UltimateLogsIOServer.dll). You now need to register the server, so programs that use automation can find it. To do this, open a command window in the same directory where UltimateLogsIOServer.dll is located and issue the following command:
Regsvr32 UltimateLogsIOServer.dll
You should see a message indicating that the server was registered successfully. Ok, you are done with the Visual Basic part. Let’s see the new code in your Fortran program now:
Example 6.4A
program UltimateLogsA
use f90VBDefs
use f90VBBStrings
use f90VBSafeArrays
use f90VBVariants
use f90VBAutomation
implicit none
type(VARIANT)::UltLogsIO,TmpVar,TmpLogTable
real(8),pointer::MapArray(:,:)
integer(HRESULT_KIND)::iRet, i
type(EXCEPINFO)::EInfo
character(len=255)::TmpStr
integer(SAFEARRAY_KIND)::LogTable
real(8)::InitValue, FinalValue, IncStep
real(8)::Value
iRet = OleInitialize()
!create an instance of UltimateLogsIO object
UltLogsIO = CreateOleObject('UltimateLogsIOServer.UltimateLogsIO',iRet)
if (iRet.ne.S_OK) goto 1000
!Show input screen and get range for the table
TmpVar = ExecMethod(UltLogsIO,'GetInputData',iRet=iRet,EInfo=EInfo)
if (iRet.ne.S_OK) goto 1000
!Get input values
InitValue = VariantToDouble(PropertyGet(UltLogsIO,'InitValue'))
FinalValue = VariantToDouble(PropertyGet(UltLogsIO,'EndValue'))
IncStep = VariantToDouble(PropertyGet(UltLogsIO,'StepIncrement'))
!Compute size of array and allocate an appropriate Safe Array
call SafeArrayCreate(LogTable,VT_R8, &
1,int((FinalValue - InitValue) / IncStep + 1), &
1,2)
!Map Fortran array to Safe Array for fast access
call SafeArrayAccessData(LogTable,MapArray)
!compute the table of logs
Value = InitValue
do i=1,ubound(MapArray,1)
MapArray(i,1)=Value
MapArray(i,2) =dlog(Value)
Value = Value+IncStep
enddo
!we don't need the mapped array anymore, so unmap it
call SafeArrayUnAccessData(LogTable)
!hand-build a variant containing LogTable + VT_BYREF
TmpLogTable%varVal%vt = VT_BYREF+VT_R8+VT_ARRAY
TmpLogTable%varVal%byref = loc(LogTable)
!show the logarithm table
TmpVar = ExecMethod(UltLogsIO,'ShowLogTable',TmpLogTable,iRet=iRet, &
EInfo=EInfo)
if (iRet.ne.S_OK) goto 1000
goto 2000
1000 continue
!Print error messages
print *, 'The following Errors were detected:'
print *, 'HRESULT:',iRet
call StrCopy(EInfo%bstrDescription,TmpStr)
print *,TmpStr
2000 continue
!release all variants, safe arrays, etc.
call Release(UltLogsIO)
call ExceptionClear(EInfo)
call VariantClear(TmpVar)
call SafeArrayDestroy(LogTable)
call VariantClear(TmpLogTable)
call OleUnInitialize()
stop
end
Ok, this definitely looks much more complicated that the original version of The Ultimate Logarithms Program. So let’s check the details of how it works.
By now, you should be used to the first portion of code. It initializes OLE and creates an instance of the UltimateLogsIO object. If an error occurs, the program goes to label 1000 which prints the error code.
iRet = OleInitialize()
!create an instance of UltimateLogsIO object
UltLogsIO = CreateOleObject('UltimateLogsIOServer.UltimateLogsIO',iRet)
if (iRet.ne.S_OK) goto 1000
Next, we call method GetInputData, which opens the input form on the screen and allows the user to enter the range and increment for the table of logarithms the program will generate:
!Show input screen and get range for the table
TmpVar = ExecMethod(UltLogsIO,'GetInputData',iRet=iRet,EInfo=EInfo)
if (iRet.ne.S_OK) goto 1000
Note that we did not have to pass any of the optional arguments to the method. Again, if an error is reported, the program flows to label 1000, where the error is printed. Method GetInputData automatically updates the properties in the object using the values entered by the user, so we can get those values by querying the object for these properties:
!Get input values
InitValue = VariantToDouble(PropertyGet(UltLogsIO,'InitValue'))
FinalValue = VariantToDouble(PropertyGet(UltLogsIO,'EndValue'))
IncStep = VariantToDouble(PropertyGet(UltLogsIO,'StepIncrement'))
Function VariantToDouble converts the return value of function PropertyGet into a double precision real.
Now the program has all it needs to compute the resulting table. Method ShowLogTable, that shows the results, expects a Safe Array, so we use one to store the results to avoid delays and wasting of resources. The technique used (i.e. mapping a Fortran array into the Safe Array memory) is described and exemplified in Chapter 2 (Safe Array Fundamentals), so we won’t explain it here again. This is the loop that performs the actual logarithm calculations:
!compute the table of logs
Value = InitValue
do i=1,ubound(MapArray,1)
MapArray(i,1)=Value
MapArray(i,2) =dlog(Value)
Value = Value+IncStep
enddo
Now, here is another little trick that improves speed and memory usage. As you already know, all arguments to an object’s method must be passed as Variant values. We really don’t want to create a Variant containing just another copy of the Safe Array we have already computed, so we handcraft a Variant-by-reference. As explained in chapter 3, a Variant with the flag VT_BYREF contains a pointer to the value, rather than the value itself. So we create a Variant containing a pointer to the Safe Array handle. Note how we assign loc(LogTable) rather than the handle itself. f90VB takes care of doing any de-referencing of Variants that needs to be done:
!hand-build a variant containing LogTable + VT_BYREF
TmpLogTable%varVal%vt = VT_BYREF+VT_R8+VT_ARRAY
TmpLogTable%varVal%byref = loc(LogTable)
Finally, the program executes the method, which presents the results on the screen:
!show the logarithm table
TmpVar = ExecMethod(UltLogsIO,'ShowLogTable',TmpLogTable,iRet=iRet, &
EInfo=EInfo)
if (iRet.ne.S_OK) goto 1000
The rest of the program just performs the necessary clean up, releasing references to objects, destroying safe arrays, etc.
Handling arguments by reference