Mini Kabibi Habibi

Current Path : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/ffc/
Upload File :
Current File : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/ffc/_setallx.vct

�VERSION =   3.00_setallxBlerrorflag
lerrorwait
cevalexpr
cexpr
cproperty
cobjectname
PixelsESetAll eXtended to support expressions, methods, and other additions.Class1_custom_setallx	_base.vcxcustom
��� �
�
kP%?	+
_m	�U����������������	���
���
������������%�C�t���w�B�-���%%�C�toParentb�O�C������%�C�this.parentb�O����B�-���T�������%�C�����b����B�-���T������T������T������T������T������T���-��T��C��f��T�	�CC�����C��6��T��-��T�
�C��R�)��=T��C�tcExprb�C�C��=�(	�C��R�)	��}%��
��

	��
	�C�	�	�C��	AddObject��h	�C��	AddObject��h
	� C��	AddObject��h�Method	����B�C������������(�C�����%�������!��T��C����T������%��
����<��8IF AMEMBERS(laChild2,toParent.&lcObjectName,2)>0���uCREATEOBJECT(this.Class,toParent.&lcObjectName,  tcProperty,tcExpr,lcBaseClassList,tlNoContainerMode,tlErrorWait)
��%�C�	�
��&�T�
���
.BaseClass��+lcBaseClass=UPPER(toParent.&lcCodeLine)
 %�C��,�	�,����"�.���T�
���.���T��a��
%������
T�����"%�C�this.parent.�������,T��CC�@�this.parent.�	toParent.����%�C�this.������.T��CC�@�this.�	toParent.��.����T������
%��
��R�1T�
�C�
C�
>�=�EVALUATE(lcEvalExpr))�����&T�
��
�=EVALUATE(lcEvalExpr)������%��

����T�
��
�=tcExpr����toParent.&lcCodeLine
��B�����
	��UTOPARENT
TCPROPERTYTCEXPRTCBASECLASSLISTTLNOCONTAINERMODETLERRORWAITLCOBJECTNAMELNCOUNTLCBASECLASSLCBASECLASSLISTLLMETHODMODE
LLEVALMODE
LCEVALEXPR
LCCODELINELLUPDATEFLAGLACHILDLACHILD2THISPARENT
LERRORWAITCOBJECTNAME	CPROPERTYCEXPR	CEVALEXPR
LERRORFLAG	BASECLASSSETALLX\��������%�C�t���0�B��%B�C����������UTOPARENT
TCPROPERTYTCEXPRTCBASECLASSLISTTLNOCONTAINERMODETLERRORWAITTHISSETALLX���������%���
��+�B��R�T���a��+T��CEC�
 C�
 ���.����%�C��	�
���� T���C�
 C�
 ��	�����C���SetAllX�x��U
NERRORCMETHODNLINE	LCMESSAGETHIS
LERRORWAIT
LERRORFLAGCOBJECTNAME	CPROPERTY	CEVALEXPRsetallx,��InitY��Error��1���qqqAQ�qAA�qA�!�����QA�AA!�q�RAA��AAAa���!�A��A��aA���AA�AQ3�AAQ3�qAAQ��1A�2t	L�	e
SR�
�\)�
�PROCEDURE setallx
LPARAMETERS toParent,tcProperty,tcExpr,tcBaseClassList,tlNoContainerMode,tlErrorWait
LOCAL lcObjectName,lnCount
LOCAL lcBaseClass,lcBaseClassList
LOCAL llMethodMode,llEvalMode,lcEvalExpr,lcCodeLine,llUpdateFlag
LOCAL laChild[1],laChild2[1]

IF PCOUNT()<=1
	RETURN .F.
ENDIF
IF TYPE("toParent")#"O" OR ISNULL(toParent)
	IF TYPE("this.parent")#"O"
		RETURN .F.
	ENDIF
	toParent=this.parent
ENDIF
IF AMEMBERS(laChild,toParent,2)=0
	RETURN .F.
ENDIF
this.lErrorWait=tlErrorWait
this.cObjectName=""
this.cProperty=tcProperty
this.cExpr=tcExpr
this.cEvalExpr=""
this.lErrorFlag=.F.
lcBaseClass=UPPER(toParent.BaseClass)
lcBaseClassList=IIF(EMPTY(tcBaseClassList),"",ALLTRIM(tcBaseClassList))
llUpdateFlag=.F.
llMethodMode=(RIGHT(tcProperty,1)==")")
llEvalMode=(TYPE("tcExpr")=="C" AND LEFT(tcExpr,1)=="(" AND RIGHT(tcExpr,1)==")")
IF NOT tlNoContainerMode AND NOT llMethodMode AND NOT llEvalMode AND ;
		EMPTY(lcBaseClassList) AND PEMSTATUS(lcBaseClass,"AddObject",5) AND ;
		NOT PEMSTATUS(lcBaseClass,"AddObject",4) AND ;
		PEMSTATUS(lcBaseClass,"AddObject",3)=="Method"
	RETURN toParent.SetAllX(tcProperty,tcExpr)
ENDIF
FOR lnCount = 1 to ALEN(laChild)
	IF this.lErrorFlag
		EXIT
	ENDIF
	lcObjectName=laChild[lnCount]
	this.cObjectName=lcObjectName
	IF NOT tlNoContainerMode
		RELEASE laChild2
		IF AMEMBERS(laChild2,toParent.&lcObjectName,2)>0
			CREATEOBJECT(this.Class,toParent.&lcObjectName, ;
					tcProperty,tcExpr,lcBaseClassList,tlNoContainerMode,tlErrorWait)
		ENDIF
	ENDIF
	IF NOT EMPTY(lcBaseClassList)
		lcCodeLine=lcObjectName+".BaseClass"
		lcBaseClass=UPPER(toParent.&lcCodeLine)
		IF ATC(lcBaseClass+",",lcBaseClassList+",")=0
			LOOP
		ENDIF
	ENDIF
	lcCodeLine=lcObjectName+"."+tcProperty
	llUpdateFlag=.T.
	IF llEvalMode
		lcEvalExpr=tcExpr
		IF ATC("this.parent.",lcEvalExpr)>0
			lcEvalExpr=STRTRAN(LOWER(lcEvalExpr),"this.parent.","toParent.")
		ENDIF
		IF ATC("this.",lcEvalExpr)>0
			lcEvalExpr=STRTRAN(LOWER(lcEvalExpr),"this.","toParent."+lcObjectName+".")
		ENDIF
		this.cEvalExpr=lcEvalExpr
		IF llMethodMode
			lcCodeLine=LEFT(lcCodeLine,LEN(lcCodeLine)-1)+"EVALUATE(lcEvalExpr))"
		ELSE
			lcCodeLine=lcCodeLine+"=EVALUATE(lcEvalExpr)"
		ENDIF
	ELSE
		IF NOT llMethodMode
			lcCodeLine=lcCodeLine+"=tcExpr"
		ENDIF
	ENDIF
	toParent.&lcCodeLine
ENDFOR
RETURN (llUpdateFlag AND NOT this.lErrorFlag)

ENDPROC
PROCEDURE Init
LPARAMETERS toParent,tcProperty,tcExpr,tcBaseClassList,tlNoContainerMode,tlErrorWait

IF PCOUNT()=0
	RETURN
ENDIF
RETURN this.SetAllX(toParent,tcProperty,tcExpr,tcBaseClassList,tlNoContainerMode,tlErrorWait)

ENDPROC
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
LOCAL lcMessage

IF NOT this.lErrorWait
	RETURN
ENDIF
WAIT CLEAR
this.lErrorFlag=.T.
lcMessage=MESSAGE()+CHR(13)+CHR(13)+this.cObjectName+"."+this.cProperty
IF NOT EMPTY(this.cEvalExpr)
	lcMessage=lcMessage+CHR(13)+CHR(13)+this.cEvalExpr
ENDIF
MESSAGEBOX(lcMessage,16,"SetAllX")

ENDPROC
Icevalexpr = 
cexpr = 
cproperty = 
cobjectname = 
Name = "_setallx"
�lerrorflag
lerrorwait
cevalexpr
cexpr
cproperty
cobjectname
*setallx Extends functionality of Visual FoxPro's SetAll() method.