Using function VariantCreate (VariantCreateExample)

This is a simple example illustrating ways to create different kind of Variants using f90VB.

Among other things, you should notice that function VariantCreate is able to cast an initialization value into the type of the created Variant. For example, the statement below creates a Variant containing a date, event though the value for the date is passed as a string of characters:

vVar = VariantCreate(VT_DATE,'01/01/1950 20:00')

program VariantCreateExample

!Demonstrates the use of VariantCreate
!Copyright 1999-2000, Canaima Software
!All rights reserved

use f90VBDefs
use f90VBSafeArrays
use f90VBBStrings
use f90VBVariants
implicit none

type(VARIANT)::VarVect(20)
integer(BSTRHNDL_KIND)::BStrSrc, BStrDest
integer(SAFEARRAY_KIND)::SAHndlSrc
integer(OLECHAR_KIND),dimension(50)::FxOLEStrSrc
type(OLEString)::OLEStrSrc
character(len=50)::FStrSrc, FStrDest
logical::LogicSrc
integer(SHORT_KIND)::ShortSrc
integer(LONG_KIND)::LongSrc, Ptr
real(FLOAT_KIND)::RealSrc, RealDest
real(DATE_KIND)::DateSrc

integer(HRESULT_KIND)::iRet,i

!Initialize some of the source values
BStrSrc = BStrAlloc('Example BString')
call StrCopy('Example Fixed OLE string', FxOLEStrSrc)
call StrCopy('Example Fortran OLE string', OLEStrSrc)
FStrSrc= 'Example Fortran string'
LogicSrc = .true.
ShortSrc = -10
LongSrc = -20
RealSrc = 20.5

!Create some variants containing BStrings

!from a f90VB Fixed Ole string
VarVect(1)=VariantCreate(VT_BSTR, FxOLEStrSrc,iRet)
!from a f90VB OLE string
VarVect(2)=VariantCreate(VT_BSTR, OLEStrSrc, iRet)
!from a Fortran string
VarVect(3)=VariantCreate(VT_BSTR, FStrSrc, iRet)
!from a Fortran Logical
VarVect(4)=VariantCreate(VT_BSTR, LogicSrc, iRet)
!from a short integer interpreted as an unsigned value
VarVect(5)=VariantCreate(VT_BSTR, ShortSrc, iRet, VT_UI2)
!from a signed short integer
VarVect(6)=VariantCreate(VT_BSTR, ShortSrc, iRet, VT_I2)
!from a long integer
VarVect(7)=VariantCreate(VT_BSTR, LongSrc, iRet)
!for a long integer interpreted as an unsigned value
VarVect(8)=VariantCreate(VT_BSTR, LongSrc, iRet, VT_UI4)
!from a BString
VarVect(9)=VariantCreate(VT_BSTR, BStrSrc, iRet, VT_BSTR)
!from a real passed as a pointer
VarVect(10)=VariantCreate(VT_BSTR, loc(LongSrc), iRet, &
                          VT_I4+VT_BYREF)
!from a real
VarVect(11)=VariantCreate(VT_BSTR, RealSrc, iRet)

!Print the content of these variants
do i=1,11
    call StrCopy(VarVect(i)%varVal%bstrVal,FStrDest)
    write(*,'(a9,i2.2,a2,a50)') 'VarVect(',i,'):', &
                                trim(FStrDest)
    !clear the variant for later use
    call VariantClear(VarVect(i))
enddo

!Clear dynamic strings used as source values
call StrFree(BstrSrc)
call StrFree(OLEStrSrc)

!Create variants containing real values

!from a fortran logical
VarVect(1)=VariantCreate(VT_R4, .false., iRet)
!from a short integer interpreted as an unsigned value
VarVect(2)=VariantCreate(VT_R4, ShortSrc, iRet, VT_UI2)
!from a signed short integer
VarVect(3)=VariantCreate(VT_R4, ShortSrc, iRet, VT_I2)
!from a long integer
VarVect(4)=VariantCreate(VT_R4, LongSrc, iRet)
!for a long integer interpreted as an unsigned value
VarVect(5)=VariantCreate(VT_R4, LongSrc, iRet, VT_UI4)
!from a real passed as a pointer
VarVect(6)=VariantCreate(VT_R4, loc(RealSrc), iRet, &
                         VT_R4+VT_BYREF)
!from a fortran string
VarVect(7)=VariantCreate(VT_R4, '101.05', iRet)

!Print the content of these variants
print *,''
do i=1,7
    write(*,'(a9,i2.2,a2,f15.2)') 'VarVect(',i,'):', &
                                  VarVect(i)%VarVal%fltVal
    !clear the variant for later use
    call VariantClear(VarVect(i))
enddo

!Create a date value from a fortran string
VarVect(1) = VariantCreate(VT_DATE,'01/01/1999 10:00 AM',iRet)

!Retrieve the date as a BString for printing
BStrDest = VariantToBString(VarVect(1),iRet)
call StrCopy(BStrDest,FStrDest,iRet)
print *,''
print *,'Date: ', FStrDest
print *,'Numeric representation of date above:', &
         VarVect(1)%VarVal%dateVal
!Free the temporal BString
call StrFree(BStrDest)

!Create a temporal safe array
call SafeArrayCreate(SAHndlSrc, VT_R4, 1,5)
!Add some data to the safe array
do i=SafeArrayLowerBound(SAHndlSrc,1), &
     SafeArrayUpperBound(SAHndlSrc,1)
    call SafeArrayPutElement(SAHndlSrc,real(i,4),i,iRet)
enddo

!Create a variant containing a copy of the safe arra
VarVect(2) = VariantCreate(VT_ARRAY,SAHndlSrc,iRet,VT_ARRAY,iRet)

!print the elements of the safe array
print *,''
print *,'Elements of a variant with a Safe Array:'
do i=SafeArrayLowerBound(VarVect(2)%varVal%parray,1), &
     SafeArrayUpperBound(VarVect(2)%varVal%parray,1)
    call SafeArrayGetElement(SAHndlSrc,RealDest,i,iRet)
    print *,RealDest
enddo
!Destroy the temporal safe array
call SafeArrayDestroy(SAHndlSrc,iRet)

!Clear variants
do i=1,2
    call VariantClear(VarVect(i))
enddo

stop
end