Marius Mutu
63f3828d5e
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_012P75yL9Fc9EcT33tMbuxcF
8215 lines
242 KiB
Plaintext
8215 lines
242 KiB
Plaintext
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
|
|
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
*< FOXBIN2PRG: Version="1.21" SourceFile="_base.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
|
|
*
|
|
*
|
|
DEFINE CLASS _activedoc AS activedoc && Foundation ActiveDoc class.
|
|
*< CLASSDATA: Baseclass="activedoc" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 68
|
|
Name = "_activedoc"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 68
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _checkbox AS checkbox && Foundation CheckBox class.
|
|
*< CLASSDATA: Baseclass="checkbox" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Check1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 17
|
|
Name = "_checkbox"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 60
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _collection AS collection && Foundation Collection class.
|
|
*< CLASSDATA: Baseclass="collection" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_collection"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _combobox AS combobox && Foundation ComboBox class.
|
|
*< CLASSDATA: Baseclass="combobox" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 24
|
|
Name = "_combobox"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 100
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _commandbutton AS commandbutton && Foundation CommandButton class.
|
|
*< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Command1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 27
|
|
Name = "_commandbutton"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 84
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _commandgroup AS commandgroup && Foundation CommandGroup class.
|
|
*< CLASSDATA: Baseclass="commandgroup" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
ButtonCount = 2
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 66
|
|
Name = "_commandgroup"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
Value = 1
|
|
vresult = .T.
|
|
Width = 94
|
|
Command1.Caption = "Command1"
|
|
Command1.Height = 27
|
|
Command1.Left = 5
|
|
Command1.Name = "Command1"
|
|
Command1.Top = 5
|
|
Command1.Width = 84
|
|
Command2.Caption = "Command2"
|
|
Command2.Height = 27
|
|
Command2.Left = 5
|
|
Command2.Name = "Command2"
|
|
Command2.Top = 34
|
|
Command2.Width = 84
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _container AS container && Foundation Container class.
|
|
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 200
|
|
Name = "_container"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 200
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _control AS control && Foundation Control class.
|
|
*< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 22
|
|
Name = "_control"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 24
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _cursor2 AS cursor && Foundation Cursor class.
|
|
*< CLASSDATA: Baseclass="cursor" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_cursor2"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _cursoradapter AS cursoradapter && Foundation CursorAdapter class.
|
|
*< CLASSDATA: Baseclass="cursoradapter" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 22
|
|
Name = "_cursoradapter"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _custom AS custom && Foundation Custom class.
|
|
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 22
|
|
Name = "_custom"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 24
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _dataenvironment2 AS dataenvironment && Foundation DataEnvironment class.
|
|
*< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
DataSource = .NULL.
|
|
Height = 22
|
|
Name = "_dataenvironment2"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 24
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _editbox AS editbox && Foundation EditBox class.
|
|
*< CLASSDATA: Baseclass="editbox" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 53
|
|
Name = "_editbox"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 100
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _form AS form && Foundation Form class.
|
|
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Form1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
DoCreate = .T.
|
|
Name = "_form"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
ShowWindow = 1
|
|
vresult = .T.
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _formset AS formset && Foundation FormSet class.
|
|
*< CLASSDATA: Baseclass="formset" Timestamp="" Scale="" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="Form1" UniqueID="" Timestamp="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Name = "_formset"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'Form1' AS _form WITH ;
|
|
builder = , ;
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm"), ;
|
|
Caption = "Form1", ;
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg"), ;
|
|
cversion = , ;
|
|
DoCreate = .T., ;
|
|
Name = "Form1", ;
|
|
ninstances = 0, ;
|
|
nobjectrefcount = 0, ;
|
|
ohost = .NULL., ;
|
|
vresult = .T.
|
|
*< END OBJECT: ClassLib="_base.vcx" BaseClass="form" />
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.addtoproject
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.newinstance
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.ninstances_access
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.ninstances_assign
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.nobjectrefcount_access
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.nobjectrefcount_assign
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.release
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.releaseobjrefs
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.sethost
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.setobjectref
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Form1.setobjectrefs
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _grid AS grid && Foundation Grid class.
|
|
*< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 200
|
|
Name = "_grid"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 320
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _hyperlink AS hyperlink && Foundation Hyperlink class.
|
|
*< CLASSDATA: Baseclass="hyperlink" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_hyperlink"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _image AS image && Foundation Image class.
|
|
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 68
|
|
Name = "_image"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 68
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _label AS label && Foundation Label class.
|
|
*< CLASSDATA: Baseclass="label" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Label1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 16
|
|
Name = "_label"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 40
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _line AS line && Foundation Line class.
|
|
*< CLASSDATA: Baseclass="line" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 68
|
|
Name = "_line"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 68
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _listbox AS listbox && Foundation Listbox class.
|
|
*< CLASSDATA: Baseclass="listbox" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 170
|
|
Name = "_listbox"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 100
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _optionbutton2 AS optionbutton && Foundation OptionButton class.
|
|
*< CLASSDATA: Baseclass="optionbutton" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Option1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 17
|
|
Name = "_optionbutton2"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 61
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _optiongroup AS optiongroup && Foundation OptionGroup class.
|
|
*< CLASSDATA: Baseclass="optiongroup" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
ButtonCount = 2
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 46
|
|
Name = "_optiongroup"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
Value = 1
|
|
vresult = .T.
|
|
Width = 71
|
|
Option1.Caption = "Option1"
|
|
Option1.Height = 17
|
|
Option1.Left = 5
|
|
Option1.Name = "Option1"
|
|
Option1.Top = 5
|
|
Option1.Value = 1
|
|
Option1.Width = 61
|
|
Option2.Caption = "Option2"
|
|
Option2.Height = 17
|
|
Option2.Left = 5
|
|
Option2.Name = "Option2"
|
|
Option2.Top = 24
|
|
Option2.Width = 61
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _page2 AS page && Foundation Page class.
|
|
*< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Page1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 16
|
|
Name = "_page2"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 60
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _pageframe AS pageframe && Foundation PageFrame class.
|
|
*< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
ErasePage = .T.
|
|
Height = 169
|
|
Name = "_pageframe"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
PageCount = 2
|
|
vresult = .T.
|
|
Width = 241
|
|
Page1.Caption = "Page1"
|
|
Page1.Name = "Page1"
|
|
Page2.Caption = "Page2"
|
|
Page2.Name = "Page2"
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _projecthook AS projecthook && Foundation ProjectHook class.
|
|
*< CLASSDATA: Baseclass="projecthook" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 68
|
|
Name = "_projecthook"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 68
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _relation2 AS relation && Foundation Relation class.
|
|
*< CLASSDATA: Baseclass="relation" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_relation2"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _separator AS separator && Foundation Separator class.
|
|
*< CLASSDATA: Baseclass="separator" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 0
|
|
Name = "_separator"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 0
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _shape AS shape && Foundation Shape class.
|
|
*< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 68
|
|
Name = "_shape"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 68
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _spinner AS spinner && Foundation Spinner class.
|
|
*< CLASSDATA: Baseclass="spinner" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 24
|
|
Name = "_spinner"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 120
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _textbox AS textbox && Foundation TextBox class.
|
|
*< CLASSDATA: Baseclass="textbox" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_textbox"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 100
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _timer AS timer && Foundation Timer class.
|
|
*< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_timer"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _toolbar AS toolbar && Foundation Toolbar class.
|
|
*< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
Caption = "Toolbar1"
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Name = "_toolbar"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
ShowWindow = 1
|
|
vresult = .T.
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _xmladapter AS xmladapter && Foundation XMLAdapter class.
|
|
*< CLASSDATA: Baseclass="xmladapter" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="Tables" UniqueID="" Timestamp="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 56
|
|
Name = "_xmladapter"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 56
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'Tables' AS collection WITH ;
|
|
Height = 23, ;
|
|
Left = 23, ;
|
|
Name = "Tables", ;
|
|
Top = 23, ;
|
|
Width = 23
|
|
*< END OBJECT: BaseClass="collection" />
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _xmlfield AS xmlfield && Foundation XMLField class.
|
|
*< CLASSDATA: Baseclass="xmlfield" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 23
|
|
Name = "_xmlfield"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 23
|
|
*</PropValue>
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|
|
|
|
DEFINE CLASS _xmltable AS xmltable && Foundation XMLTable class.
|
|
*< CLASSDATA: Baseclass="xmltable" Timestamp="" Scale="Pixels" Uniqueid="" />
|
|
|
|
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
|
*< OBJECTDATA: ObjPath="Fields" UniqueID="" Timestamp="" />
|
|
|
|
*<DefinedPropArrayMethod>
|
|
*m: addtoproject && Dummy code for adding files to project.
|
|
*m: newinstance && Returns new instance of object.
|
|
*m: ninstances_access && Access method for nInstances property.
|
|
*m: ninstances_assign && Assign method for nInstances property.
|
|
*m: nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
*m: nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
*m: release && Releases object from memory.
|
|
*m: releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
*m: sethost && Set oHost property to form reference object.
|
|
*m: setobjectref && Set object reference to specific property.
|
|
*m: setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
*p: builder && Bulder property.
|
|
*p: builderx && BuilderX property.
|
|
*p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method.
|
|
*p: cversion && Version property.
|
|
*p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off.
|
|
*p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method.
|
|
*p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs.
|
|
*p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory.
|
|
*p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM.
|
|
*p: ninstances && Number of instances.
|
|
*p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs.
|
|
*p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T.
|
|
*p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required.
|
|
*a: aobjectrefs[1,3] && Array of object references properties.
|
|
*</DefinedPropArrayMethod>
|
|
|
|
*<PropValue>
|
|
builder =
|
|
builderx = (HOME()+"Wizards\BuilderD,BuilderDForm")
|
|
csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
|
|
cversion =
|
|
Height = 56
|
|
Name = "_xmltable"
|
|
ninstances = 0
|
|
nobjectrefcount = 0
|
|
ohost = .NULL.
|
|
vresult = .T.
|
|
Width = 56
|
|
*</PropValue>
|
|
|
|
ADD OBJECT 'Fields' AS collection WITH ;
|
|
Height = 23, ;
|
|
Left = 23, ;
|
|
Name = "Fields", ;
|
|
Top = 23, ;
|
|
Width = 23
|
|
*< END OBJECT: BaseClass="collection" />
|
|
|
|
PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project.
|
|
*-- Dummy code for adding files to project.
|
|
RETURN
|
|
|
|
DO SetObjRf.prg
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Destroy
|
|
IF this.lRelease
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
this.ReleaseObjRefs
|
|
this.oHost=.NULL.
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Error
|
|
LPARAMETERS nError, cMethod, nLine
|
|
LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
|
|
|
|
IF this.lIgnoreErrors OR _vfp.StartMode>0
|
|
RETURN .F.
|
|
ENDIF
|
|
lcOnError=UPPER(ALLTRIM(ON("ERROR")))
|
|
IF NOT EMPTY(lcOnError)
|
|
lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
|
|
"PROGRAM()","cMethod"),"LINENO()","nLine")
|
|
&lcOnError
|
|
RETURN
|
|
ENDIF
|
|
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
|
|
"Error: "+ALLTRIM(STR(nError))+CHR(13)+ ;
|
|
"Method: "+LOWER(ALLTRIM(cMethod))
|
|
lcCodeLineMsg=MESSAGE(1)
|
|
IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
|
IF NOT EMPTY(lcCodeLineMsg)
|
|
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
|
ENDIF
|
|
ENDIF
|
|
WAIT CLEAR
|
|
MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
|
|
ERROR nError
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE Init
|
|
IF this.lSetHost
|
|
this.SetHost
|
|
ENDIF
|
|
IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
|
|
RETURN .F.
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE newinstance && Returns new instance of object.
|
|
LPARAMETERS tnDataSessionID
|
|
LOCAL oNewObject,lnLastDataSessionID
|
|
|
|
lnLastDataSessionID=SET("DATASESSION")
|
|
IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
|
|
SET DATASESSION TO tnDataSessionID
|
|
ENDIF
|
|
oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
|
|
SET DATASESSION TO (lnLastDataSessionID)
|
|
RETURN oNewObject
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_access && Access method for nInstances property.
|
|
LOCAL laInstances[1]
|
|
|
|
RETURN AINSTANCE(laInstances,this.Class)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE ninstances_assign && Assign method for nInstances property.
|
|
LPARAMETERS vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property.
|
|
LOCAL lnObjectRefCount
|
|
|
|
lnObjectRefCount=ALEN(this.aObjectRefs,1)
|
|
IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
|
|
lnObjectRefCount=0
|
|
ENDIF
|
|
RETURN lnObjectRefCount
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property.
|
|
LPARAMETERS m.vNewVal
|
|
|
|
ERROR 1743
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE release && Releases object from memory.
|
|
LOCAL lcBaseClass
|
|
|
|
IF this.lRelease
|
|
NODEFAULT
|
|
RETURN .F.
|
|
ENDIF
|
|
this.lRelease=.T.
|
|
lcBaseClass=LOWER(this.BaseClass)
|
|
this.oHost=.NULL.
|
|
this.ReleaseObjRefs
|
|
IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ")
|
|
RELEASE this
|
|
ENDIF
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array.
|
|
LOCAL lcName,oObject,lnCount
|
|
|
|
IF this.nObjectRefCount=0
|
|
RETURN
|
|
ENDIF
|
|
FOR lnCount = this.nObjectRefCount TO 1 STEP -1
|
|
lcName=this.aObjectRefs[lnCount,1]
|
|
IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
|
|
LOOP
|
|
ENDIF
|
|
oObject=this.&lcName
|
|
IF ISNULL(oObject)
|
|
LOOP
|
|
ENDIF
|
|
IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
|
|
oObject.Release
|
|
ENDIF
|
|
IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
|
|
oObject.oHost=.NULL.
|
|
ENDIF
|
|
this.&lcName=.NULL.
|
|
oObject=.NULL.
|
|
ENDFOR
|
|
DIMENSION this.aObjectRefs[1,3]
|
|
this.aObjectRefs=""
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE sethost && Set oHost property to form reference object.
|
|
this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectref && Set object reference to specific property.
|
|
LPARAMETERS tcName,tvClass,tvClassLibrary
|
|
LOCAL lvResult
|
|
|
|
this.vResult=.T.
|
|
DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
|
|
lvResult=this.vResult
|
|
this.vResult=.T.
|
|
RETURN lvResult
|
|
|
|
ENDPROC
|
|
|
|
PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls.
|
|
LPARAMETERS toObject
|
|
|
|
RETURN
|
|
|
|
ENDPROC
|
|
|
|
ENDDEFINE
|