Using multi_array/matrix to wrap a SAFEARRAY

From: Nick Toze (geeky_nick_at_[hidden])
Date: 2002-11-14 09:32:05

Hello,

I haven't really used C++ much (more Java and Eiffel), but now I am
helping develop a C++ dll that will use matrices alot and will
probably need to use SAFEARRAY to interface with Visual Basic (either
directly or via COM). Also the group I'm in need to standardize on a
matrix representation and it needs to be compatible with NAG.

I've been trying to wrap a SAFEARRAY using a multi_array and I've got
something that seems to work (see attached), but :-) I'm not sure how
to go about passing these (i.e. multi_array, multi_array_ref,
const_multi_array_ref) around as function arguments since they don't
have any inheritance relationship. Do you have any suggestions on
that? Maybe template functions could be used, but I'd like to keep my
code fairly simple since I'm no expert. As an alternative the uBLAS
container classes look very appropriate since I'll only be passing
numbers and some of the algorithms could be useful (although I'll
mostly be using NAG), but I couldn't quite see whether it is possible
to use a uBLAS matrix as a view onto the data in a SAFEARRAY. Is it
possible to attach a pointer to an array to a uBLAS matrix?

This is the code I've got as an example for wrapping a SAFEARRAY:

typedef boost::multi_array_ref<double, 2> dbl_matrix_ref;
typedef boost::multi_array<double, 2> dbl_matrix;

__declspec(dllexport) HRESULT __stdcall
        mmultiply(SAFEARRAY** sa1, SAFEARRAY** sa2, SAFEARRAY** result)
{
        HRESULT hr;

        if ( result == NULL ) return E_INVALIDARG;
        if ( (*sa1)->cDims != 2 ) return E_INVALIDARG;
        if ( (*sa1)->cbElements != 8 )  return E_INVALIDARG;
        if ( (*sa2)->cDims != 2 ) return E_INVALIDARG;
        if ( (*sa2)->cbElements != 8 )  return E_INVALIDARG;

        long m1_dim0_sz, m1_dim1_sz, m2_dim0_sz, m2_dim1_sz;
        m1_dim0_sz = (*sa1)->rgsabound[0].cElements;
        m1_dim1_sz = (*sa1)->rgsabound[1].cElements;
        m2_dim0_sz = (*sa2)->rgsabound[0].cElements;
        m2_dim1_sz = (*sa2)->rgsabound[1].cElements;

        hr = SafeArrayLock( *sa1 );
        if ( FAILED(hr) ) return hr;
        hr = SafeArrayLock( *sa2 );
        if ( FAILED(hr) ) return hr;

        dbl_matrix_ref matrix1(
                (double*)(*sa1)->pvData,
                boost::extents[m1_dim1_sz][m1_dim0_sz],
                boost::fortran_storage_order() );
        dbl_matrix_ref matrix2(
                (double*)(*sa2)->pvData,
                boost::extents[m2_dim1_sz][m2_dim0_sz],
                boost::fortran_storage_order() );
        dbl_matrix matrix_result(
                boost::extents[matrix1.shape()[0]][matrix2.shape()[1]],
                boost::fortran_storage_order() );

        for (dbl_matrix_ref::index i = 0; i != matrix1.shape()[0]; ++i) {
                for (dbl_matrix_ref::index j = 0; j != matrix2.shape()[1]; ++j) {
                        double s = 0;
                        for (dbl_matrix_ref::index k = 0; k != matrix1.shape()[1]; ++k) {
                                s = s + matrix1[i][k] * matrix2[k][j];
                        }
                        matrix_result[i][j] = s;
                }
        }
        
        SAFEARRAYBOUND rgsabound[2];
        rgsabound[0].lLbound = 0;
        rgsabound[0].cElements = matrix_result.shape()[0];
        rgsabound[1].lLbound = 0;
        rgsabound[1].cElements = matrix_result.shape()[1];
        SAFEARRAY* lresult = SafeArrayCreate(VT_R8, 2, rgsabound);
        lresult->pvData = matrix_result.data();

        hr = SafeArrayCopy( lresult, result );
        if ( FAILED(hr) ) return hr;

        hr = SafeArrayDestroy( lresult );
        if ( FAILED(hr) ) return hr;

        hr = SafeArrayUnlock( *sa1 );
        if ( FAILED(hr) ) return hr;
        hr = SafeArrayUnlock( *sa2 );
        if ( FAILED(hr) ) return hr;
        return S_OK;
}

Then I declare this in VBA with:

Declare Function mmultiply Lib _
        "D:\multiarray_test\Debug\multiarray_test" _
        (a() As Double, b() As Double, c() As Double) As Long