************************************************** *-- Class: persist (p:\pos\persistclass.vcx) *-- ParentClass: custom *-- BaseClass: custom *-- Time Stamp: 09/10/02 10:57:05 AM * DEFINE CLASS persist AS custom PROTECTED savetofile savetofile = "" PROTECTED savetofiledir savetofiledir = (ADDBS(GETENV('TEMP'))) PROTECTED savetofileext savetofileext = .FPW savetofileprefix = "_RB" version = "" restoreversion = "" Name = "persist" DIMENSION properties[1] DIMENSION settings[1,2] *-- Register the names of any controls that shouldn't be persisted. DIMENSION exceptions[1] PROCEDURE save LPARAMETERS toObject *!* Save the Version THIS.SaveVersion() *!* Save all the member objects LOCAL lnMembers, laMembers[1], lcMember, lni lnMembers = AMEMBERS(laMembers, toObject, 2) FOR lni = 1 TO lnMembers IF ASCAN( THIS.Exceptions, laMembers[lni] ) > 0 LOOP ENDIF lcMember = "toObject." + laMembers[lni] THIS.SAVE(&lcMember) NEXT lni *!* Then save the object's properties. THIS.SaveProperties(toObject) ENDPROC PROCEDURE restore LPARAMETERS toObject LOCAL lnMembers, laMembers[1], lcMember, lni *!* Loop thru any member objects to save their properties. lnMembers = AMEMBERS(laMembers, toObject, 2) FOR lni = 1 TO lnMembers IF ASCAN( THIS.Exceptions, laMembers[lni] ) > 0 LOOP ENDIF lcMember = "toObject." + laMembers[lni] THIS.RESTORE(&lcMember) NEXT lni *!* Then save the object's properties. THIS.RestoreProperties(toObject) ENDPROC PROTECTED PROCEDURE saveproperties LPARAMETERS toObject *!* Save the properties that are likely to change for objects. *!* Most obviously are layout and value. This could be abstracted. LOCAL lcObject, lni, lcProperty lcObject = toObject.NAME FOR lni = 1 TO ALEN(THIS.Properties) lcProperty = THIS.Properties[lni] STRTOFILE( SYS(1272,toObject) + "." + lcProperty + CHR(9) + ; TRANSFORM(EVALUATE("toObject." + lcProperty ) ) + CHR(13), ; THIS.SaveToFile, .T. ) NEXT lni ENDPROC PROCEDURE restoreproperties LPARAMETERS toObject LOCAL lcObject, lni, lcProperty, lnj, lcSetExact, lcSetting, lcValue lcSetExact = SET('EXACT') lcObject = toObject.NAME SET EXACT OFF FOR lni = 1 TO ALEN(THIS.Properties) lcProperty = THIS.Properties[lni] lnj = ASCAN( THIS.Settings, SYS(1272,toObject) + "." + lcProperty + CHR(9) ) IF lnj > 0 lcSetting = THIS.Settings[lnj] lcValue = RTRIM( SUBSTR( lcSetting, AT(CHR(9), lcSetting)+1 ) ) IF TYPE(lcValue) = "U" lcValue = "[" + lcValue + "]" ENDIF STORE EVALUATE(lcValue) TO toObject.&lcProperty ENDIF NEXT lni SET EXACT &lcSetExact ENDPROC *-- 2002.09.07 Added to clear previous version's settings since layout may change. PROCEDURE reset IF FILE(THIS.SaveToFile) DELETE FILE (THIS.SaveToFile) RECYCLE ENDIF ENDPROC PROCEDURE saveversion STRTOFILE( "Version" + CHR(9) + ; THIS.VERSION + CHR(13), ; THIS.SaveToFile, .T. ) ENDPROC PROCEDURE version_access LOCAL lcVersion, lcProgram, laVersion[1] lcProgram = SYS(16,0) IF AGETFILEVERSION(laVersion, lcProgram) > 0 lcVersion = laVersion[4] ELSE lcVersion = "0" ENDIF RETURN lcVersion ENDPROC PROCEDURE loadsettings *!* First find the persistent file, if it exists IF !FILE(THIS.SaveToFile) RETURN .F. ENDIF RETURN ALINES(THIS.Settings,FILETOSTR(THIS.SaveToFile)) > 0 ENDPROC PROCEDURE restoreversion_access LOCAL lcExact, lcVersion, lni lcExact = SET('EXACT') SET EXACT OFF lni = ASCAN( this.Settings, "Version" ) lcVersion = STRTRAN( THIS.SETTINGS[lni], 'Version' + CHR(9)) SET EXACT &lcExact RETURN lcVersion ENDPROC PROCEDURE Init THIS.Exceptions[1] = "" THIS.SaveToFile = ; THIS.SaveToFileDir + ; THIS.SaveToFilePrefix + ; THIS.PARENT.NAME + ; THIS.SaveToFileExt DIMENSION THIS.Properties[11] THIS.Properties[1] = "Caption" THIS.Properties[2] = "BackColor" THIS.Properties[3] = "ForeColor" THIS.Properties[4] = "FontSize" THIS.Properties[5] = "Enabled" THIS.Properties[6] = "Value" THIS.Properties[7] = "Height" THIS.Properties[8] = "Left" THIS.Properties[9] = "Top" THIS.Properties[10] = "ToolTipText" THIS.Properties[11] = "Width" #IF VERSION(2) = 2 _CLIPTEXT = THIS.SaveToFile #ENDIF IF THIS.loadSettings() IF THIS.RestoreVersion = THIS.VERSION THIS.RESTORE(THIS.PARENT) ENDIF ENDIF ENDPROC PROCEDURE Destroy IF TYPE( "this.parent" ) = "O" .AND. !ISNULL( THIS.PARENT ) *!* 09/07/02 11:41:05 NF 5: Added Reset to clear old settings so it can be called *!* from anywhere. *!* *!* IF FILE(THIS.SaveToFile) *!* DELETE FILE (THIS.SaveToFile) RECYCLE *!* ENDIF THIS.RESET() THIS.SAVE(THIS.PARENT) ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine IF INLIST(nError, 1732, 1743, 1757, 1734, 1559) *!* 1734 Property "name" is not found. *!* 1757 Property "name" is protected. *!* 1743 Property "name" is read-only. *!* 1559 Property is not found. *!* 1732 Data type is invalid for this property. *!* Ignore RETURN ELSE SET ASSERTS ON ASSERT .F. MESSAGE MESSAGE() IF .F. RETRY RETURN ENDIF ENDIF ENDPROC ENDDEFINE * *-- EndDefine: persist **************************************************