************************************************** *-- Class: grdbase *-- ParentClass: grid *-- BaseClass: grid Define Class grdbase As grid DeleteMark = .F. Height = 200 HighlightRow = .F. ScrollBars = 2 Width = 371 HighlightStyle = 2 AllowCellSelection = .F. Optimize = .T. *-- Set when the grid is instantiated if a configuration was found for it in the grid_preference table lpreferencesexist = .T. Name = "grdbase" *-- An array to store the grid's default configuration Dimension aprops[1,3] *-- Do anything special that must be done to setup the grid Procedure setgrid Local lnFgColor, lnBgColor, loColumn, loControl, lnCol, lnAlignment *** Set up for highlighting current row Declare Integer GetSysColor In "user32" Integer nIndex lnBgColor = GetSysColor( 13 ) lnFgColor = GetSysColor( 14 ) *** Setup grid highlighing. We do not want a 50% gradient With This .HighlightBackColor = lnBgColor .HighlightForeColor = lnFgColor *** Get the grid preferences for this grid *** and restore the grid configuration If .ColumnCount > 0 *** Save settings at grid instantiation .SaveDefaultSettings() *** Now go get any previous settings that were saved .RestoreGridSettings() Endif Endwith Endproc *-- Save the grid properties when it is instantiated Procedure SaveDefaultSettings Local lnCol With This Dimension .aprops[ .ColumnCount, 3 ] For lnCol = 1 To .ColumnCount .aprops[ lnCol, 1 ] = .Columns[ lnCol ].Name .aprops[ lnCol, 2 ] = .Columns[ lnCol ].ColumnOrder .aprops[ lnCol, 3 ] = .Columns[ lnCol ].Width Endfor Endwith Endproc *-- Configure the grid using the information saved in the Grd_Prefrence table Procedure RestoreGridSettings Local lcSQL, loCol, lnHandle lcSQL = [SELECT column_name, column_order, column_width FROM grid_preference WHERE path_name = '] lcSQL = lcSQL + Sys( 1272, This ) + [' AND user_id = ] + ; IIF( Vartype( oApp ) = [O], Transform( oApp.sys_user_id ), [-1] ) + [ ORDER BY column_order INTO CURSOR qTmp] &lcSQL *** See if we got comething - if we didn't, this is the first time *** that this form has been run - we have no preferences to restore If Reccount( [qTmp] ) > 0 *********************************************************************** *** Changed By.: Marcia G. Akins on 09 June 2006 *** Reason.....: Looks like we gotta restore in column order or else this is flaky *********************************************************************** Select qTmp Scan If Pemstatus( This, Alltrim( column_name ), 5 ) loCol = Evaluate( [This.] + Alltrim( column_name ) ) loCol.ColumnOrder = qTmp.column_order loCol.Width = qTmp.column_width Endif Endscan Else This.lpreferencesexist = .F. Endif Endproc *-- Called when the grid is destroyed to write the current configuration to the grid preference table Procedure savegridsettings Local lcSQL, loCol, lnHandle If This.ColumnCount > 0 *** if we do not yet have preferences saved for this grid and this user *** we need to insert a record, otherwise, we update For Each loCol In This.Columns If This.lpreferencesexist lcSQL = [UPDATE grid_preference SET column_order = ] + Transform( loCol.ColumnOrder ) lcSQL = lcSQL + [, column_width = ] + Transform( loCol.Width ) lcSQL = lcSQL + [ WHERE path_name = '] + Sys( 1272, This ) + [' AND column_name = '] lcSQL = lcSQL + loCol.Name + [' AND user_id = ] + Iif( Vartype( oApp ) = [O], Transform( oApp.sys_user_id ), [-1] ) Else lcSQL = [INSERT INTO grid_preference ( user_id, path_name, column_name, column_order, column_width ) VALUES (] lcSQL = lcSQL + Iif( Vartype( oApp ) = [O], Transform( oApp.sys_user_id ), [-1] ) + [, '] lcSQL = lcSQL + Sys( 1272, This ) + [', '] + loCol.Name + [', ] + Transform( loCol.ColumnOrder ) + [, ] + Transform( loCol.Width ) + [ )] Endif &lcSQL Endfor Endif Endproc *-- Called from the right-click of the grid to restore the grid configuration to its default Procedure showmenu Local lnChoice *** If we do not have any columns, do nothing If This.ColumnCount > 0 *** Define the pop-up menu for resetting the grid to the default Store 0 To lnChoice Define Popup Reset2Default SHORTCUT Relative From Mrow(),Mcol() Define Bar 1 Of Reset2Default Prompt "Reset Grid Columns" On Selection Bar 1 Of Reset2Default lnChoice = 1 *** Activate the menu and process the result Activate Popup Reset2Default If lnChoice = 1 *** We want to delete the preferences and reinitialize the grid This.ResetToDefault() Endif Endif Endproc Procedure Init This.setgrid() Endproc Procedure RightClick This.showmenu() Endproc Procedure ResetToDefault Lparameters cProperty *********************************************************************** *** Changed By.: Marcia G. Akins on 27 August 2005 *** Reason.....: Shanghai the native method to reset the grid columns *** ...........: to what they were when the form was instantiated *********************************************************************** Local lnCol With This For lnCol = 1 To .ColumnCount .Columns[ lnCol ].ColumnOrder = .aprops[ lnCol, 2 ] .Columns[ lnCol ].Width = .aprops[ lnCol, 3 ] Endfor Endwith Nodefault Endproc Procedure Destroy This.savegridsettings() Endproc Enddefine