Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Printing object property values
Message
De
19/04/2000 14:49:35
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Divers
Thread ID:
00361451
Message ID:
00361468
Vues:
14
>Hi,
>
>Are there any utilities out there that will enable one to print the properties of an
>object and their values ?
>
>
>Thanks.
>Michel.

Hope helps.
**************************************************
*-- Class:        udfobjcollector (c:\ddrive\vfpclasses\global.vcx)
*-- ParentClass:  custom
*-- BaseClass:    custom
*-- Time Stamp:   01/04/00 09:44:05 AM
*
Define CLASS udfobjcollector AS custom


    Height = 18
    Width = 26
*-- Object ref to a container for which object refs are placed into collection array (this.aCollection[])
    containerref = "thisform"
    Name = "udfobjcollector"

*-- Array containing all object refs for this.containerref [Object ref to a container].   ie: this.containerref = "thisform" - all thisform objects are in colection
    Dimension acollection[1]


*-- Method to fill collection array aCollection with members of all contained objects
    Procedure fillcollection
    Lparameters oContainerObject
    Local ix, nMembers, lnExpand, oObjectRef, aContainerObjects[1]
    nMembers = amembers(aContainerObjects, oContainerObject,2)
    For ix = 1 to nMembers   && Start collecting
        lnExpand = iif(type("this.aCollection[1]")= "L",0,1)
        Dimension this.acollection[alen(this.aCollection,1)+lnExpand]
        oObjectRef = eval("oContainerObject."+aContainerObjects[ix])
        This.acollection[alen(this.aCollection,1)] = oObjectRef
        This.fillcollection(oObjectRef)  && Recurse
    Endfor
* Handle _screen and _vfp to also collect their objects
    Do case
    Case compobj(oContainerObject,_screen) && Handle _screen specially
        For each oForm in _screen.Forms
            This.fillcollection(oForm)  && Recurse
        Endfor
    Case compobj(oContainerObject,_vfp) && Handle _vfp specially
        For each oFrmObject in _vfp.Objects
            This.fillcollection(oFrmObject)  && Recurse
        Endfor
* _screen.forms # _vfp.objects
* So also handle _screen.forms too
        This.fillcollection(_screen)
    Endcase
Endproc


    Procedure listcollection
    Lparameters pcProperty, oContainerObject
*!* Just handy at development time
    If parameters() > 1
        This.fillcollection(oContainerObject)
    Else
        This.fillcollection(thisform)
    Endif
    If type("this.aCollection[1]") = "L"
        Wait window nowait "No members"
        Return
    Endif
    lcOldSafety = set("safety")
    Set safety off
    Set textmerge on
    Set textmerge to ("cobjects.txt") noshow overwrite
    Set textmerge on

    For each oObjectName in this.acollection
			\--------------------------------------------------------------------------------------------------------------
			\	SCX file  : <<sys(1271,oObjectName)>>
			\	Hierarchy : <<sys(1272,oObjectName)>>
* ie: pcProperty = "controlsource" - check controlsource
        If pemstatus(oObjectName, pcProperty, 5) ;
                and !pemstatus(oObjectName, pcProperty, 2)
				\	<<pcProperty>> : <<getpem(oObjectName,pcProperty)>>
        Endif
			\--------------------------------------------------------------------------------------------------------------
    Endfor

    Set textmerge to
    Set textmerge off
    Set safety &lcOldSafety
    This.acollection=.f.	&& Release Object References
    Dimension this.acollection[1]
    Modi comm ("cobjects.txt")

*!*	ObjectSCXFile = sys(1271,oObject)
*!*	ObjectHierarchy = sys(1272, oObjectName)

*!*	lPEMExists			= pemstatus(oObject, cProperty, 5)
*!*	lPEMProtected		= pemstatus(oObject, cProperty, 2)
*!*	cPEMType			= pemstatus(oObject, cProperty, 3)
*!*	lPEMUDF				= pemstatus(oObject, cProperty, 4)
*!*	* Properties only
*!*	lPropertyChanged	= pemstatus(oObject, cProperty, 0)
*!*	lPropertyRW			= !pemstatus(oObject, cProperty, 1)
*!*	* IsReadonlyProperty = sys(1269,oObject,cProperty,1)
*!*	* IsPropertyChanged = sys(1269,oObject,cProperty,0)
*!*	* Properties only

*!*	uPropertyValue = getpem(oObject,cProperty)
Endproc


*-- Execute method for all objects in container with a specific property value
    Procedure execall
    Lparameters poContainerObject, pcProperty, pcExpr, pcExecMethodName

*!*		Sample call for a grid.afterrowcallchange to refresh controls with same recordsource
*!* 	This is handy when there are relations and you don't want the call thisform.refresh
*!*		thisform.objectcollector1.ExecAll(thisform, ;
*!*					"controlsource", ;
*!*					"upper(%_%getvalue%_%) = ["+upper(this.recordsource)+".]", ;
*!*					"refresh()")

*!*	 Example : Refresh all controls where controlsource = "CUSTOMER"
*!*		ExecAll(thisform, "controlsource", "upper(%_%getvalue%_%) = [CUSTOMER.]", "refresh()")
*!*		poContainerObject = thisform
*!*		pcProperty = "controlsource"
*!*		pcExpr = "upper(%_%getvalue%_%) = [CUSTOMER.]"
*!*		pcExecMethodName = "refresh()"

*!*	 Example : Refresh all controls where inlist(controlsource,[CUSTOMER.],[EMPLOYEE.])
*!*		ExecAll(thisform, "controlsource", "inlist(upper(%_%getvalue%_%), [CUSTOMER.],[EMPLOYEE.])", "refresh()")
*!*		poContainerObject = thisform
*!*		pcProperty = "controlsource"
*!*		pcExpr = "inlist(upper(%_%getvalue%_%), [CUSTOMER.],[EMPLOYEE.])"
*!*		pcExecMethodName = "refresh()"

*!*	 Notice how %_%getvalue%_% is used as a placeholder for propertyname in expression

    This.fillcollection(poContainerObject)							&& Collect all objects of object
    If type("this.aCollection[1]") = "L"							&& No member objects
        Return
    Endif
    pcExecMethodName = pcExecMethodName + ;
        iif(at("(",pcExecMethodName)=0, "()","")	&& Eval() needs () for EM
    lcExecMethodName = substr(pcExecMethodName,1,;
        at("(",pcExecMethodName)-1)					&& Pure EM name
    lcExpr = stuff(pcExpr, ;
        at("%_%getvalue%_%",pcExpr),;
        len("%_%getvalue%_%"),;
        "loObjectName."+pcProperty)									&& Prepare expression
    For each loObjectName in this.acollection						&& Loop through member objects
&& Property exists and !protected and object is one we're looking for and EM exists
        If pemstatus(loObjectName, pcProperty, 5) ;
                and !pemstatus(loObjectName, pcProperty, 2) ;
                and eval(lcExpr) ;
                and pemstatus(loObjectName, lcExecMethodName, 5)
            Eval("loObjectName."+pcExecMethodName)					&& Execute its own method -pcExecMethodName-
        Endif
    Endfor
    This.acollection=.f.	&& Release Object References
    Dimension this.acollection[1]
Endproc


*-- List all PEM of a container (typically thisform)
    Procedure listall
    Lparameters oContainerObject
* Just handy at development time
    If parameters() = 1
        This.fillcollection(oContainerObject)
    Else
        This.fillcollection(thisform)
    Endif
    If type("this.aCollection[1]") = "L"
        Wait window nowait "No members"
        Return
    Endif
    lcOldSafety = set("safety")
    Set safety off
    Set textmerge on
    Set textmerge to ("cobjects.txt") noshow overwrite
    Set textmerge on

    For each oObjectName in this.acollection
			\***************************************************************************************************************************
			\* Object : <<sys(1272,oObjectName)>> ( <<sys(1271,oObjectName)>> )
			\*--------------------------------------------------------------------------------------------------------------------------
        nMembers = amembers(aPEM,oObjectName,1)
			\*	Properties :
			\*--------------------------------------------------------------------------------------------------------------------------
        For ix = 1 to nMembers
            If aPEM[ix,2]="Property"
                If aPEM[ix,1] = "VALUE"  ;
                        and pemstatus(oObjectName, "controlsource", 5) ;
                        and type(getpem(oObjectName,"controlsource")) = "G" && Handle general specially
                    If pemstatus(oObjectName, aPEM[ix,1], 5) ;
                            and !pemstatus(oObjectName, aPEM[ix,1], 2) ;
                            and pemstatus(oObjectName, aPEM[ix,1], 0)
						\*	<<padr(aPEM[ix,1],20," ")>>(General)
                    Endif
                Else
                    If pemstatus(oObjectName, aPEM[ix,1], 5) ;
                            and !pemstatus(oObjectName, aPEM[ix,1], 2) ;
                            and pemstatus(oObjectName, aPEM[ix,1], 0)
						\*	<<padr(aPEM[ix,1],20," ")>>
						\\ <<getpem(oObjectName,aPEM[ix,1])>>
*				\\ <<this.typeconvert(getpem(oObjectName,aPEM[ix,1]))>>
                        If pemstatus(oObjectName,"ReadExpression",5)
                            cExpr = oObjectName.readexpression(aPEM[ix,1])
                            If !empty(cExpr)
								\\ ( <<cExpr>> )
                            Endif
                        Endif
                    Endif
                Endif
            Endif
        Endfor
			\*
			\*--------------------------------------------------------------------------------------------------------------------------
			\*	Events and methods :
			\*--------------------------------------------------------------------------------------------------------------------------
        For ix = 1 to nMembers
            If inlist(aPEM[ix,2],"Event","Method") ;
                    and aPEM[ix,1] # "OLE" ;
                    and !pemstatus(oObjectName, aPEM[ix,1], 2)
                lcEMCode = getpem(oObjectName,aPEM[ix,1])
                If !empty(lcEMCode)
						\*
						\*	<<aPEM[ix,1]>>
						\<<lcEMCode>>
						\*
                Endif
            Endif
        Endfor
			\***************************************************************************************************************************
			\
			\
    Endfor

    Set textmerge to
    Set textmerge off
    Set safety &lcOldSafety
    This.acollection=.f.	&& Release Object References
    Dimension this.acollection[1]
    Modi comm ("cobjects.txt")

*!*	ObjectSCXFile = sys(1271,oObject)
*!*	ObjectHierarchy = sys(1272, oObjectName)

*!*	lPEMExists			= pemstatus(oObject, cProperty, 5)
*!*	lPEMProtected		= pemstatus(oObject, cProperty, 2)
*!*	cPEMType			= pemstatus(oObject, cProperty, 3)
*!*	lPEMUDF				= pemstatus(oObject, cProperty, 4)
*!*	* Properties only
*!*	lPropertyChanged	= pemstatus(oObject, cProperty, 0)
*!*	lPropertyRW			= !pemstatus(oObject, cProperty, 1)
*!*	* IsReadonlyProperty = sys(1269,oObject,cProperty,1)
*!*	* IsPropertyChanged = sys(1269,oObject,cProperty,0)
*!*	* Properties only

*!*	uPropertyValue = getpem(oObject,cProperty)
Endproc


    Procedure typeconvert
    Lparameters anyType
    Do case
    Case type("anyType") $ "NY"
        Return ltrim(str(anyType))
    Case type("anyType") = "L"
        Return iif(anyType, ".T.",".F.")
    Case type("anyType")  = "D"
        Return dtoc(anyType)
    Case type("anyType") = "T"
        Return ttoc(anyType)
    Case type("anyType") = "G"
        Return "(General)"
    Case type("anyType") = "O"
        Return "(Object)"
    Otherwise
        Return anyType
    Endcase
Endproc


Enddefine
*
*-- EndDefine: udfobjcollector
**************************************************
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform