>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>