************************************************** *-- 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