Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Best way to save user's environment
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire d'écran & Écrans
Divers
Thread ID:
00535841
Message ID:
00535919
Vues:
15
Hi Will,

Thanks a lot, I'll study your code. BTW, I added formatting tags for increasing readability.

>Nadya,
>
>There are many ways to do this but here is the way I do it:
>
>I have included the table structure, 4 required procedures and two class definitions (Column and Grid) so you can see how I call GetUserSettings and SaveUserSettings. Some of the code will be of no use to you but it will give you the idea how the call the two procedures. All values are stored as a string and converted by the SaveUserSetting and GettUserSettings.
>
>Sorry for the length.
>
>Good Luck,
>Will
>
>Setting_user.dbf table structure is as follows:
>Field  Field Name      Type                Width    Dec   Index   Collate Nulls
>    1  USERID          Character               6            Asc   Machine    No
>    2  OBJECTID        Character             200                             No
>    3  PROPERTY        Character              50                             No
>    4  CVALUE          Memo                    4                             No
>    5  CTYPE           Character               1                             No
>** Total **                                  262
>
>**********************************
>  PROCEDURE SaveUserSettings
>  LPARAMETER tuObject, tcProperty, tuValue
>
>  LOCAL lcObjectID, lcProperty, lcValue, lcType, lnOldSelect
>
>  lcObjectID = ''
>
>  DO CASE
>    CASE VARTYPE(tuObject) = 'O'
>      lcObjectID = UPPER(ALLTRIM(SYS(1272,tuObject)))
>
>    CASE VARTYPE(tuObject) = 'C'
>      lcObjectID = tuObject
>
>  ENDCASE
>
>  ASSERT VARTYPE(tcProperty)="C" AND NOT EMPTY(tcProperty) MESSAGE 'Property parameter required.'
>
>  lcProperty = UPPER(ALLTRIM(tcProperty))
>
>  lcValue = ''
>  lcType = VARTYPE(tuValue)
>
>  DO CASE
>    CASE lcType = "C"
>      lcValue = ALLTRIM(tuValue)
>
>    CASE lcType = "N"
>      lcValue = THIS.NumberToString(tuValue)
>
>    CASE lcType = "Y"
>      lcValue = "$"+ALLTRIM(STR(tuValue,18,4))
>
>    CASE lcType = "D"
>      lcValue = DTOC(tuValue)
>
>    CASE lcType = "T"
>      lcValue = TTOC(tuValue,1)
>
>    CASE lcType = "L"
>      lcValue = IIF(tuValue,"T","F")
>
>    CASE lcType = "X"
>      lcValue = '.null.'
>
>  ENDCASE
>
>  SET DATASESSION TO THIS.nAppServiceDataSessionID
>
>  IF USED('oUserid_Setting')
>    SELECT oUserid_Setting
>
>    LOCATE FOR USERID = THIS.ccurrentuser AND ObjectID = lcObjectID AND Property = lcProperty
>    IF FOUND()
>      REPLACE oUserid_Setting.cValue WITH lcValue,oUserid_Setting.cType WITH lcType
>    ELSE
>      INSERT INTO oUserid_Setting (USERID,ObjectID,Property,cValue,cType) ;
>        VALUES (THIS.ccurrentuser,lcObjectID,lcProperty,lcValue,lcType)
>    ENDIF
>  ENDIF
>  IF VARTYPE(THIS.oActiveService) = 'O'
>    SET DATASESSION TO THIS.oActiveService.DATASESSIONID
>  ENDIF
>ENDPROC
>
>*************************************
>  PROCEDURE GetUserSettings
>  LPARAMETER tuObject, tcProperty, tuPassByRefParm
>
>  LOCAL luValue,lcObjectID, lcProperty, lnOldSelect, llReturn
>
>  lcObjectID = ''
>  llReturn = .F.
>  luValue = .NULL.
>
>  SET DATASESSION TO THIS.nAppServiceDataSessionID
>
>  IF USED('oUserid_Setting')
>    DO CASE
>      CASE VARTYPE(tuObject) = 'O'
>        lcObjectID = UPPER(ALLTRIM(SYS(1272,tuObject)))
>
>      CASE VARTYPE(tuObject) = 'C'
>        lcObjectID = tuObject
>
>    ENDCASE
>
>    ASSERT VARTYPE(tcProperty)="C" AND NOT EMPTY(tcProperty) MESSAGE 'Property parameter required.'
>
>    lcProperty = UPPER(ALLTRIM(tcProperty))
>
>    SELECT oUserid_Setting
>
>    LOCATE FOR USERID = THIS.ccurrentuser AND ObjectID = lcObjectID AND Property = lcProperty
>
>    IF FOUND()
>      DO CASE
>        CASE oUserid_Setting.cType = "C"
>          luValue = ALLTRIM(oUserid_Setting.cValue)
>
>        CASE oUserid_Setting.cType = "N"
>          luValue = THIS.StringToNumber(oUserid_Setting.cValue)
>
>        CASE oUserid_Setting.cType = "Y"
>          luValue = VAL(oUserid_Setting.cValue)
>
>        CASE oUserid_Setting.cType = "D"
>          luValue = CTOD(oUserid_Setting.cValue)
>
>        CASE oUserid_Setting.cType = "T"
>          luValue = CTOD(oUserid_Setting.cValue)
>
>        CASE oUserid_Setting.cType = "L"
>          luValue = "T" $ oUserid_Setting.cValue
>
>        CASE oUserid_Setting.cType = "X"
>          luValue = .NULL.
>
>      ENDCASE
>      llReturn = .T.
>    ELSE
>** If a default value has been setup by the application administrator
>      LOCATE FOR EMPTY(USERID) AND ObjectID = lcObjectID AND Property = lcProperty
>      IF FOUND()
>        DO CASE
>          CASE oUserid_Setting.cType = "C"
>            luValue = ALLTRIM(oUserid_Setting.cValue)
>
>          CASE oUserid_Setting.cType = "N"
>            luValue = THIS.StringToNumber(oUserid_Setting.cValue)
>
>          CASE oUserid_Setting.cType = "Y"
>            luValue = VAL(oUserid_Setting.cValue)
>
>          CASE oUserid_Setting.cType = "D"
>            luValue = CTOD(oUserid_Setting.cValue)
>
>          CASE oUserid_Setting.cType = "T"
>            luValue = CTOD(oUserid_Setting.cValue)
>
>          CASE oUserid_Setting.cType = "L"
>            luValue = "T" $ oUserid_Setting.cValue
>
>          CASE oUserid_Setting.cType = "X"
>            luValue = .NULL.
>
>        ENDCASE
>        llReturn = .T.
>      ENDIF
>    ENDIF
>  ENDIF
>  IF VARTYPE(THIS.oActiveService) = 'O'
>    SET DATASESSION TO THIS.oActiveService.DATASESSIONID
>  ENDIF
>
>  IF PCOUNT() = 3
>    tuPassByRefParm = luValue
>    RETURN llReturn
>  ELSE
>    RETURN luValue
>  ENDIF
>ENDPROC
>
>**************************************
>  PROCEDURE NumberToString
>  LPARAMETERS tnNumber
>  LOCAL lnLoop
>
>  FOR lnLoop = 0 TO 16
>    IF ROUND(tnNumber,lnLoop) = tnNumber
>      EXIT
>    ENDIF
>  NEXT
>
>  RETURN STR(lnLoop,2)+" "+ALLTRIM(STR(tnNumber,20,lnLoop))
>ENDPROC
>
>***************************************
>  PROCEDURE StringToNumber
>  LPARAMETERS tcString
>  LOCAL lnPrecision,lnDecimals,lnNumber
>
>  lnPrecision = VAL(SUBSTR(tcString,1,2))
>  lnDecimals = SET("DECIMALS")
>  SET DECIMALS TO lnPrecision
>  lnNumber = VAL(SUBSTR(tcString,4))
>  SET DECIMALS TO lnDecimals
>
>  RETURN lnNumber
>
>**************************************************
>* Standard Column class used by all grids
>DEFINE CLASS Business_Column AS App_Column
>  nInterfaceID = 0
>  nElementID   = 0
>
>  PROCEDURE INIT
>  THIS.REMOVEOBJECT('Header1')
>  THIS.REMOVEOBJECT('Text1')
>  THIS.NEWOBJECT('oHeader','Business_Header','Sys_Classes.prg','Interface.exe')
>ENDPROC
>
>  PROCEDURE AddBusinessObject
>  LPARAMETERS tcName, tcClass
>  THIS.NEWOBJECT(tcName,tcClass,'_Grids.vcx','Interface.exe')
>ENDPROC
>
>  PROCEDURE MOUSEMOVE
>  LPARAMETERS nButton, nShift, nXCoord, nYCoord
>  THIS.PARENT.MOUSEPOINTER = 1
>ENDPROC
>
>  PROCEDURE MOVED
>  THIS.PARENT.ColumnMoved(THIS)
>ENDPROC
>
>  PROCEDURE RESIZE
>  THIS.PARENT.ColumnResized(THIS)
>ENDPROC
>
>  PROCEDURE MOUSEDOWN
>  LPARAMETERS nButton, nShift, nXCoord, nYCoord
>
>ENDPROC
>ENDDEFINE
>
>**********************************************************
>** Standard Grid class that saves and restores column order and widths
>DEFINE CLASS agrid AS _grid
>	ColumnCount = 0
>	DeleteMark = .F.
>	MousePointer = 1
>	Partition = 0
>	BackColor = RGB(128,128,128)
>	cviewid = ('')
>	nopeninterfacestyle = 2
>	interfaceid = 0
>	elementid = 0
>	csettingid = ('')
>	Name = "agrid"
>	lsavesettingsforobjectname = .F.
>
>	PROCEDURE load
>		LPARAMETERS tcViewAlias,tiDataObjectID
>		LOCAL lvSettingID,lcGridSettings,lnPartition,llPanelLink,lnRowHeight,lnView,lcDefOrder
>
>		AFIELDS(laFields,tcViewAlias)
>
>		IF NOT VARTYPE(tiDataObjectID)='N' OR EMPTY(tiDataObjectID)
>		  tiDataObjectID = 0
>		ENDIF
>
>		IF THIS.lSaveSettingsforObjectName
>		  THIS.cSettingID = THIS.NAME
>		ELSE
>		  THIS.cSettingID = UPPER(ALLTRIM(SYS(1272,THIS)))
>		ENDIF
>
>		*DoDebug('We are in the load of the grid...')
>
>		IF THISFORM.oPanel.oService.GetUserSettings(THIS.cSettingID,"cGridSettings",@lcGridSettings)
>		  THIS.cGridSettings = lcGridSettings
>		ENDIF
>		IF THISFORM.oPanel.oService.GetUserSettings(THIS.cSettingID,"nPartition",@lnPartition)
>		  THIS.PARTITION = lnPartition
>		ENDIF
>		IF THISFORM.oPanel.oService.GetUserSettings(THIS.cSettingID,"lPanelLink",@llPanelLink)
>		  THIS.PANELLINK = llPanelLink
>		ENDIF
>		IF THISFORM.oPanel.oService.GetUserSettings(THIS.cSettingID,"nRowHeight",@lnRowHeight)
>		  THIS.ROWHEIGHT = lnRowHeight
>		ENDIF
>		IF THISFORM.oPanel.oService.GetUserSettings(THIS.cSettingID,"nView",@lnView)
>		  THIS.VIEW = lnView
>		ENDIF
>
>		IF TYPE('THISFORM.oDE.'+tcViewAlias) = 'O'
>		  lcDefOrder = EVAL('THISFORM.oDE.'+tcViewAlias+'.cDefOrder')
>		ELSE
>		  lcDefOrder = 'None'
>		ENDIF
>		IF NOT EMPTY(COMCLASSINFO(THISFORM.oPanel.oService, 3))
>		  COMARRAY(THISFORM.oPanel.oService,11)
>		ENDIF
>		THISFORM.oPanel.oService.LoadGrid(THIS,tcViewAlias,tiDataObjectID,@laFields,lcDefOrder)
>		THIS.SETALL('visible',.T.)
>	ENDPROC
>
>
>	PROCEDURE getgridsettings
>		LOCAL lcSettings
>		lcSettings = ""
>
>		FOR EACH loColumn IN THIS.COLUMNS
>		  lcSettings = lcSettings + IIF(EMPTY(lcSettings),'',',') + ;
>		    ALLTRIM(LOWER(loColumn.CONTROLSOURCE))+','+;
>		    ALLTRIM(STR(loColumn.COLUMNORDER))+','+ALLTRIM(STR(loColumn.WIDTH))
>		NEXT
>
>		THIS.cGridSettings = lcSettings + ","
>
>		RETURN THIS.cGridSettings
>	ENDPROC
>
>
>	PROCEDURE setgridsettings
>		*-- This restores the current user's settings for the view
>		LOCAL luSavedSetting,lnColumn, lnPosition, lcSettings, lnColumnOrder, lnWidth
>
>		IF NOT EMPTY(THIS.cGridSettings)
>		  FOR lnColumn = 1 TO THIS.COLUMNCOUNT
>		    lnPosition = 0
>		    lcSettings = ""
>		    lnPosition = ATC(THIS.COLUMNS(lnColumn).CONTROLSOURCE, THIS.cGridSettings)
>		    IF lnPosition > 0
>		      lnPosition = lnPosition + LEN(ALLTRIM(THIS.COLUMNS(lnColumn).CONTROLSOURCE))
>		      lcSettings = SUBSTR(THIS.cGridSettings, lnPosition)
>		      lnColumnOrder = VAL(SUBSTR(lcSettings,AT(',',lcSettings,1)+1,AT(',',lcSettings,2) - AT(',',lcSettings,1) - 1))
>		      lnWidth = VAL(SUBSTR(lcSettings,AT(',',lcSettings,2)+1,AT(',',lcSettings,3) - AT(',',lcSettings,2) - 1))
>		      THIS.COLUMNS(lnColumn).COLUMNORDER = lnColumnOrder
>		      THIS.COLUMNS(lnColumn).WIDTH =lnWidth
>		    ENDIF
>		  ENDFOR
>		ENDIF
>	ENDPROC
>
>
>	PROCEDURE addbusinesscolumn
>		LPARAMETERS tcColumnName
>		THIS.NEWOBJECT(tcColumnName,"Business_Column","sys_classes.prg","Interface.exe")
>	ENDPROC
>
>	PROCEDURE requerycomboboxes
>		LPARAMETER tlRequeryData
>
>		* DoDebug('We in the Grid RequeryComboBoxes of : '+THIS.Name)
>
>		FOR EACH loColumn IN THIS.COLUMNS
>		  FOR EACH loControl IN loColumn.CONTROLS
>		    IF UPPER(loControl.BASECLASS) = "COMBOBOX" AND PEMSTATUS(loControl,'RequeryData',5)
>		      loControl.RequeryData(tlRequeryData)
>		    ENDIF
>
>		* If control is a container with the RequeryComboBoxes method we want to call it here.
>		    IF PEMSTATUS(loControl,'RequeryComboBoxes',5)
>		      loControl.RequeryComboBoxes(tlRequeryData)
>		    ENDIF
>		  ENDFOR
>		ENDFOR
>	ENDPROC
>
>	PROCEDURE view_assign
>		LPARAMETERS vNewVal
>		*To do: Modify this routine for the Assign method
>		THIS.View = m.vNewVal
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"nView",THIS.View)
>	ENDPROC
>
>	PROCEDURE partition_assign
>		LPARAMETERS vNewVal
>		*To do: Modify this routine for the Assign method
>		THIS.Partition = m.vNewVal
>		DoDebug('We are in the partion...')
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"nPartition",THIS.Partition)
>	ENDPROC
>
>
>	PROCEDURE panellink_assign
>		LPARAMETERS vNewVal
>		*To do: Modify this routine for the Assign method
>		THIS.PanelLink = m.vNewVal
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"lPanelLink",THIS.PanelLink)
>	ENDPROC
>
>
>	PROCEDURE rowheight_assign
>		LPARAMETERS vNewVal
>		*To do: Modify this routine for the Assign method
>		THIS.RowHeight = m.vNewVal
>		*DoDebug('We are in the RowHeight...')
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"nRowHeight",THIS.RowHeight)
>	ENDPROC
>
>	PROCEDURE columnunload
>		LPARAMETERS tcColumnName
>		THIS.RemoveObject(tcColumnName)
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"cGridSettings",THIS.GetGridSettings())
>	ENDPROC
>
>	PROCEDURE MouseMove
>		LPARAMETERS nButton, nShift, nXCoord, nYCoord
>		THIS.MousePointer = 1
>	ENDPROC
>
>	PROCEDURE columnmoved
>		LPARAMETERS tocolumn
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"cGridSettings",THIS.GetGridSettings())
>	ENDPROC
>
>	PROCEDURE columnresized
>		LPARAMETERS tocolumn
>		THISFORM.oPanel.oService.SaveUserSettings(THIS.cSettingID,"cGridSettings",THIS.GetGridSettings())
>	ENDPROC
>ENDDEFINE
>
>>Hi everybody,
>>
>>I'm thinking about the best way of saving some specific user's adjustments and environment. For instance, a user opens an application with a grid. He (she) makes some changes in grid's appearance. The next time I want to restore these changes. The most important property, however, would be to save and restore the record, on which the user stopped the other day. In other words, user had done some work with the application, opened it on the following day and now he/she starts from the saved position.
>>
>>I want to make some generic way of saving these kind of settings. My colleague has a quite complicated approach of Meta-Files, but I'm not 100% sure, we can port his idea with all its complicated implementation to our existing applications. So, I'm looking for something quite simple, but efficient. This is for multi-user environment. Another little problem: user may start an application with a different table, or he/she may finish with this table, so it might be deleted.
>>
>>Hopefully, you got the idea. I have some own ideas in mind (for instance, Robert Peirce's article gave me some thoughts), but I'd like to hear your advices too.
>>
>>Should it be form's method or our application object method? (We have only one main application object oJC).
>>
>>Thanks a lot in advance for your ideas.
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform