Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
SAVE...RESTORE an Object?
Message
From
10/10/2002 12:02:51
 
General information
Forum:
Visual FoxPro
Category:
Object Oriented Programming
Miscellaneous
Thread ID:
00709863
Message ID:
00709890
Views:
14
Randy-
>
>I'm splashing around in the shallow end of the OOP pool, and trying to figure out how to do the OOP equivalent of SAVE TO and RESTORE FROM with an object. In the FPD world, I declared an array, and used various elements to represent and save user preferences and defaults. At shutdown, SAVE TO, and RESTORE FROM at startup.

I just did something like this. It's a custom class that I can drop on any container and it will save information that I'm interested in about the object. This is was specifically for an application that needs to "remember" what values were last entered, but it also remembers layout. It is also designed to work with a right-click menu that lets users change the caption of labels.

For an object to _not_ be saved, I register it in an exclusion list. I store the settings in the user temp directory. I check the version so that if it's updated since the last settings, it resets them. At this point I haven't done anything about allowing the user to reset the settings. Nor is it flexible in what properties are saved (I didn't want to save them all).
**************************************************
*-- 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
**************************************************
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform