* This routine effectively searchs a "registry" of all singletons, by looking through
* the public objects in the _vfp.Objects[] collection that are derived from the Singleton
* class and have desired domainname.

* This function is required because when the DDE message comes to this application we 
* don't know where the singleton object is.

function SingletonLookup( pcDomainName )
local loObject, loRetVal

loRetVal = .null.

for each loObject in _vfp.Objects

   * Look through all the objects in the _VFP objects collection for instances of Singleton class based objects

   if ( DerivedFrom( loObject, "Singleton" ) )

      * A Singleton object, now check for the correct mcDomainName

      if ( upper( loObject.mcDomainName ) == upper( pcDomainName ) )

         * The Singleton we want to talk to

         loRetVal = loObject
         exit
      endif
   endif
endfor

return loRetVal

* DerivedFrom.PRG 02-Jul-97

* This function will return .T. if an roObject is derived from pcClass anywhere along it's inheritance tree

* Since ACLASS() doesn't work for _vfp.Objects[] we use ClassTree

lparameter roObject, pcClass

assert( pcount() = 2 )
assert( type( "m.roObject" ) == "O" )
assert( ! isnull( m.roObject ) )
assert( type( "m.pcClass" ) == "C" )

local llRetVal

llRetVal = .f.

if ( ( type( "m.roObject" ) == 'O' ) and ! isnull( m.roObject ) )
   llRetVal = ( at( "," + upper( pcClass ) + ",", ;
                    "," + upper( ClassTree( roObject ) )  + "," ) > 0 )
endif

return llRetVal

* ClassTree.prg 02-Jul-97

* Returns a comma seperated string of the class tree of an object

* NOTE: required because ACLASS( laX, _vfp.objects[] ) doesn't work

* NOTE: it is this complicated because getpem( cClass, "ParentClass" ) returns GrandParentClass!

* NOTE: attempting to GETPEM( VFP_BaseClass, "ParentClass" ) yields a page fault

lparameters roObject

local lcRetVal, lcGrandParentClass, lcParentClass, lcSave

if ( ( type( "roObject" ) == 'O' ) and ! isnull( m.roObject ) )
   lcRetVal = roObject.Class
   if ( ! empty( roObject.ParentClass ) )
      lcRetVal = roObject.ParentClass + "," + lcRetVal
      lcGrandParentClass = getpem( roObject.Class, "ParentClass" )
      lcParentClass = roObject.ParentClass
      do while ( ! empty( lcGrandParentClass ) )
         lcRetVal = lcGrandParentClass + "," + lcRetVal
         lcSave = lcGrandParentClass
         lcGrandParentClass = getpem( lcParentClass, "ParentClass" )
         lcParentClass = lcSave
      enddo
   endif
   return lcRetVal
else
   return ""
endif