From afbce2ebe1261cc7180a7cc980fedd49a7e2ff5a Mon Sep 17 00:00:00 2001
From: Andreas Bregas <ab@openoffice.org>
Date: Wed, 5 Jan 2011 13:52:34 +0100
Subject: ab79: #i116184# Improved type support

---
 basic/source/classes/sbunoobj.cxx | 94 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)

(limited to 'basic/source/classes/sbunoobj.cxx')

diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx
index 79f55faf37b6..ac089dd2ce6d 100755
--- a/basic/source/classes/sbunoobj.cxx
+++ b/basic/source/classes/sbunoobj.cxx
@@ -1228,6 +1228,30 @@ Any sbxToUnoValue( SbxVariable* pVar )
     return sbxToUnoValueImpl( pVar );
 }
 
+
+// Funktion, um einen globalen Bezeichner im
+// UnoScope zu suchen und fuer Sbx zu wrappen
+static bool implGetTypeByName( const String& rName, Type& rRetType )
+{
+    bool bSuccess = false;
+
+    Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl();
+    if( xTypeAccess->hasByHierarchicalName( rName ) )
+    {
+        Any aRet = xTypeAccess->getByHierarchicalName( rName );
+        Reference< XTypeDescription > xTypeDesc;
+        aRet >>= xTypeDesc;
+
+        if( xTypeDesc.is() )
+        {
+            rRetType = Type( xTypeDesc->getTypeClass(), xTypeDesc->getName() );
+            bSuccess = true;
+        }
+    }
+    return bSuccess;
+}
+
+
 // Konvertierung von Sbx nach Uno mit bekannter Zielklasse
 Any sbxToUnoValue( SbxVariable* pVar, const Type& rType, Property* pUnoProperty )
 {
@@ -1318,6 +1342,39 @@ Any sbxToUnoValue( SbxVariable* pVar, const Type& rType, Property* pUnoProperty
         }
         break;
 
+        case TypeClass_TYPE:
+        {
+            if( eBaseType == SbxOBJECT )
+            {
+                // XIdlClass?
+                Reference< XIdlClass > xIdlClass;
+
+                SbxBaseRef pObj = (SbxBase*)pVar->GetObject();
+                if( pObj && pObj->ISA(SbUnoObject) )
+                {
+                    Any aUnoAny = ((SbUnoObject*)(SbxBase*)pObj)->getUnoAny();
+                    aUnoAny >>= xIdlClass;
+                }
+
+                if( xIdlClass.is() )
+                {
+                    ::rtl::OUString aClassName = xIdlClass->getName();
+                    Type aType( xIdlClass->getTypeClass(), aClassName.getStr() );
+                    aRetVal <<= aType;
+                }
+            }
+            else if( eBaseType == SbxSTRING )
+            {
+                // String representing type?
+                String aTypeName = pVar->GetString();
+                Type aType;
+                bool bSuccess = implGetTypeByName( aTypeName, aType );
+                if( bSuccess )
+                    aRetVal <<= aType;
+            }
+        }
+        break;
+
         /* folgende Typen lassen wir erstmal weg
         case TypeClass_SERVICE:         break;
         case TypeClass_CLASS:           break;
@@ -4104,6 +4161,8 @@ void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
     (void)pBasic;
     (void)bWrite;
 
+    static String aTypeTypeString( RTL_CONSTASCII_USTRINGPARAM("type") );
+
     // 2 parameters needed
     if ( rPar.Count() != 3 )
     {
@@ -4115,6 +4174,41 @@ void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
     String aTypeName = rPar.Get(1)->GetString();
     SbxVariable* pVal = rPar.Get(2);
 
+    if( aTypeName == aTypeTypeString )
+    {
+        SbxDataType eBaseType = pVal->SbxValue::GetType();
+        String aTypeName;
+        if( eBaseType == SbxSTRING )
+        {
+            aTypeName = pVal->GetString();
+        }
+        else if( eBaseType == SbxOBJECT )
+        {
+            // XIdlClass?
+            Reference< XIdlClass > xIdlClass;
+
+            SbxBaseRef pObj = (SbxBase*)pVal->GetObject();
+            if( pObj && pObj->ISA(SbUnoObject) )
+            {
+                Any aUnoAny = ((SbUnoObject*)(SbxBase*)pObj)->getUnoAny();
+                aUnoAny >>= xIdlClass;
+            }
+
+            if( xIdlClass.is() )
+                aTypeName = xIdlClass->getName();
+        }
+        Type aType;
+        bool bSuccess = implGetTypeByName( aTypeName, aType );
+        if( bSuccess )
+        {
+            Any aTypeAny( aType );
+            SbxVariableRef refVar = rPar.Get(0);
+            SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aTypeAny );
+            refVar->PutObject( xUnoAnyObject );
+        }
+        return;
+    }
+
     // Check the type
     Reference< XHierarchicalNameAccess > xTypeAccess = getTypeProvider_Impl();
     Any aRet;
-- 
cgit 


From d1242e6c5c7884a68fcc6f84594c8a93fcde56b6 Mon Sep 17 00:00:00 2001
From: Andreas Bregas <ab@openoffice.org>
Date: Wed, 5 Jan 2011 16:30:02 +0100
Subject: ab79: #i116184# Fixed warning

---
 basic/source/classes/sbunoobj.cxx | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

(limited to 'basic/source/classes/sbunoobj.cxx')

diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx
index ac089dd2ce6d..870a6ea994b1 100755
--- a/basic/source/classes/sbunoobj.cxx
+++ b/basic/source/classes/sbunoobj.cxx
@@ -4177,10 +4177,10 @@ void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
     if( aTypeName == aTypeTypeString )
     {
         SbxDataType eBaseType = pVal->SbxValue::GetType();
-        String aTypeName;
+        String aValTypeName;
         if( eBaseType == SbxSTRING )
         {
-            aTypeName = pVal->GetString();
+            aValTypeName = pVal->GetString();
         }
         else if( eBaseType == SbxOBJECT )
         {
@@ -4195,10 +4195,10 @@ void RTL_Impl_CreateUnoValue( StarBASIC* pBasic, SbxArray& rPar, BOOL bWrite )
             }
 
             if( xIdlClass.is() )
-                aTypeName = xIdlClass->getName();
+                aValTypeName = xIdlClass->getName();
         }
         Type aType;
-        bool bSuccess = implGetTypeByName( aTypeName, aType );
+        bool bSuccess = implGetTypeByName( aValTypeName, aType );
         if( bSuccess )
         {
             Any aTypeAny( aType );
-- 
cgit