Article ID: 131027
Article Last Modified on 7/1/2004
* SET PROCEDURE to file containing class definition
IF !"DATAENC"$ SET("PROCEDURE")
SET PROCEDURE TO dataenc ADDITIVE
ENDIF
* Declare public variables to hold instantiations of custom classes
PUBLIC oMyData, oCustomer
* Instantiate each class
oMyData = CREATEOBJECT("clMyData")
oCustomer = CREATEOBJECT("clCustomer")
******* Begin code example
************************************************************************
* Class Name : clMyData
* Parent Class : Custom
* Subclasses :
************************************************************************
Define Class clMyData as Custom
************************************************************************
* Properties
************************************************************************
lIsFormSet = .t. && logical - is this a formset?
nNumberofForms=1 && number of forms
flag = .f.
************************************************************************
PROCEDURE OpenTables
Parameters pDBC, pTable
* Called from each subclass to open needed dbcs and dbfs
* Set buffering
SET MULTILOCKS ON
* Open tables
IF !DBUSED(pDBC)
OPEN DATA (pDBC)
ENDIF
IF !USED(pTable)
USE (pTable) IN 0
ELSE
SELECT (pTable)
ENDIF
=CURSORSETPROP("Buffering",5,(pTable))
* Populate first object
THIS.GETINFO(pTable, @pArray)
************************************************************************
* This is called once in each subclass to create a unique array name
PROCEDURE DIFFERS
PARAMETERS pTable
aDiffers=SYS(2015)
PUBLIC &adiffers(1,2)
RETURN aDiffers
* Place control source property for form in first column
* Place fields which make this field in second column
*********************************************************************
* The following procedure is called by the subclass one time for each
* field in the data table
PROCEDURE POPDIFFERS
PARAMETERS pArrayName, pControlSource, pInputExpr
iCurrentRow = ALEN((pArrayName),1)
cArrayName = pArrayName + "(iCurrentRow,"
&cArrayName.1) = pControlSource
&cArrayName.2) = pInputType
nNewSize = iCurrentRow + 1
DIMENSION &pArrayName.(nNewsize, 2)
************************************************************************
PROCEDURE INIT
* Figure out if part of a formset by trying to generate
* an error number 1938 and setting HighestClass appropriately
temp = thisformset.name
* Cycle through all of the controls on the current form and find the
* current control source where needed.
* Then, the init of each subclass will refer to this cursor later on
* to update the control source properties
CREATE CURSOR curMyProps (cName c(75), source c(75))
CREATE CURSOR curContainers (cName c(75))
IF lIsFormset
nNumberofForms = _screen.FORMCOUNT
FOR i = 1 to nNumberofForms
HighestClass = "_SCREEN.FORMS(" + alltrim(str(i)) +")"
this.allforms(highestclass)
NEXT i
ELSE
HIGHESTClass = "THISFORM"
THIS.AllForms(HighestClass)
ENDIF
ENDPROC
************************************************************************
* The following procedure is executed 1 time for each form
* by the class init method
PROCEDURE AllForms
PARAMETERS HighestClass
iNumControls = &highestclass..controlcount
this.enumerate(HighestClass, iNumControls)
DO WHILE .T.
SELECT * from curContainers into CURSOR TEMP
IF _tally = 0
EXIT
ENDIF
SET SAFETY OFF
CREATE CURSOR curContainers (cName c(75))
SELECT TEMP
SCAN
HighestClass = alltrim(cName)
iNumControls = &HighestClass..ControlCount
this.enumerate(HighestClass, iNumControls)
ENDSCAN
ENDDO
ENDPROC
************************************************************************
* The following procedure figures out which controls exist on the
* container
PROCEDURE enumerate
Parameters HighestClass, iNumControls
FOR i = 1 TO iNumControls
IF &highestclass..baseclass != "Commandgroup"
cCurControlBase = &highestclass..controls(i).baseclass
cCurControl = UPPER(highestclass + "." + ;
&highestclass..controls(i).name)
cCurControlSource = ;
UPPER(&highestclass..controls(i).controlsource)
ELSE
cCurControlBase = &highestclass..buttons(i).baseclass
cCurControl = UPPER(highestclass + "." + ;
&highestclass..buttons(i).name)
cCurControlSource = ;
UPPER(&highestclass..buttons(i).controlsource)
ENDIF
IF cCurControlBase = "Textbox" ;
OR cCurControlBase = "Check box" ;
OR cCurControlBase = "Commandbutton" ;
OR cCurControlBase = "Optionbutton" ;
OR cCurControlBase = "Spinner" ;
OR cCurControlBase = "Column" ;
OR cCurControlBase = "EditBox"
SELECT CurMyProps
APPEND BLANK
REPLACE cName WITH cCurControl
REPLACE source WITH cCurControlSource
ELSE
IF cCurControlBase = "Page" ;
OR cCurControlBase = "PageFrame";
OR cCurControlBase = "Form" ;
OR cCurControlBase = "Grid" ;
OR cCurControlBase = "Toolbar"
SELECT curContainers
APPEND BLANK
REPLACE cName with cCurControl
ENDIF
ENDIF
NEXT i
ENDPROC
************************************************************************
* This procedure changes the rowsource in the cursor
PROCEDURE UpdateCursor
Parameters pArray, cTableName
SELECT curMyProps
=cursorsetprop("Buffering",1,(cTableName))
FOR i = 1 TO ALEN((pArray),1)
cNewSource = &pArray.(i,2)
cOldSource = &pArray.(i,1)
REPLACE source WITH cNewSource ;
FOR ALLTRIM(source) = UPPER(cOldSource)
ENDFOR
SCAN
cNewName = alltrim(cName)
&cNewName..controlsource = alltrim(source)
ENDSCAN
************************************************************************
PROCEDURE error
Parameters pErrorNum, p3, p4
IF pErrorNum = 1938
lIsFormSet = .F.
ENDIF
************************************************************************
PROCEDURE destroy
PARAMETERS pArrayName
RELEASE (pArrayName)
************************************************************************
ENDDEFINE && End Definition of clMyData
************************************************************************
* END CLASS DEFINITION
************************************************************************
************************************************************************
* Class Name : clCUSTOMER
* Parent Class : clMyData
* Subclasses :
************************************************************************
Define Class clCUSTOMER as clMyData
************************************************************************
* Properties
************************************************************************
cTableName = "CUSTOMER" &&Name of the .dbf file
cDBCName = "POES" &&Name of the .DBC file
cMyArray = ""
************************************************************************
PROCEDURE INIT
clMyData::OpenTables(THIS.cDBCName, THIS.cTableName)
cMyArray = clMyData::Differs()
clMyData::PopDifferS(cMyArray,"FullName","customer.c_Name")
clMyData::PopDifferS(cMyArray,"SSN","customer.c_SSN")
clMyData::PopDifferS(cMyArray,"STREET","customer.c_STREET")
clMyData::PopDifferS(cMyArray,"CITY","customer.c_CITY")
clMyData::PopDifferS(cMyArray,"STATE","customer.C_STATE")
clMyData::PopDifferS(cMyArray,"ZIP","customer.c_ZIP")
clMyData::PopDifferS(cMyArray,"PHONE","customer.c_PHONE")
clMyData::PopDifferS(cMyArray,"CCN","customer.c_CCN")
this.parentPopDifferS(cMyArray,"CCEXP","customer.c_CCEXP")
clMyData::UpdateCursor(cMyArray, this.cTableName)
PUBLIC aCustomer(1,2)
SELECT c_ssn, c_name FROM CUSTOMER INTO ARRAY aCustomer
************************************************************************
ENDDEFINE && End Definition of clCustomer
************************************************************************
* END CLASS DEFINITION
************************************************************************
Keywords: kboop kbcode KB131027