#INCLUDE ..\Defaults.h DEFINE CLASS _Column AS COLUMN HEADERCLASS = [_Header] HEADERCLASSLIBRARY = [_GridMembers.prg] * Index Tag Name to "Seek" for the Incremental Search Control cTagName = [] * Name of the Field to "Seek" for the Incremental Search Control cFieldName = [] * Name of Incremental Search Control cSearchControl = [] ENDDEFINE DEFINE CLASS _Header AS HEADER FONTBOLD = .T. FONTNAME = "Arial" FONTSIZE = 9 PROCEDURE CLICK *!* There is a BINDEVENT in the parent grid *!* that calls the grid's OnHeaderClick method *!* every time a header is clicked. The *!* OnHeaderClick method in the grid handles setting the *!* forecolor of all the column headers in the grid. THIS.SetCursorOrder() ENDPROC PROTECTED PROCEDURE SetCursorOrder IF NOT PEMSTATUS(THIS.Parent, 'cTagName', 5) RETURN ENDIF IF EMPTY(THIS.Parent.cTagName) RETURN ENDIF LOCAL llLockScreen, lcTagName, oGrid oGrid = THIS.Parent.Parent lcTagName = UPPER(ALLTRIM(THIS.Parent.cTagName )) llLockScreen = THISFORM.LockScreen IF THIS.DoesTagExist(lcTagName) SET ORDER TO (lcTagName) DO WHILE oGrid.RelativeRow > 1 oGrid.DoScroll(1) ENDDO oGrid.Refresh() ENDIF THISFORM.LockScreen = llLockScreen ENDPROC PROTECTED PROCEDURE DoesTagExist LPARAMETERS tcTagName LOCAL loGrid loGrid = THIS.Parent.Parent IF loGrid.RECORDSOURCETYPE > 1 RETURN .F. ENDIF LOCAL lnRetVal, lcSource, laTags[1] lcSource = loGrid.RECORDSOURCE lnRetVal = ATAGINFO(laTags, '', lcSource) IF lnRetVal = 0 RETURN .F. ENDIF lnRetVal = ASCAN(laTags, tcTagName, -1, -1, 1, 1) RETURN (lnRetVal > 0) ENDPROC PROCEDURE SetHeaderColor LOCAL loColumn, loGrid loColumn = THIS.Parent loGrid = loColumn.Parent IF NOT EMPTY(loColumn.cTagName) IF UPPER(loColumn.cTagName) == UPPER(ORDER(loGrid.RECORDSOURCE)) THIS.FORECOLOR = 255 && Red ELSE THIS.FORECOLOR = 16711680 && Blue ENDIF ENDIF ENDPROC PROCEDURE SetHeaderCaption LOCAL loColumn, loGrid, lcField, lcCaption loColumn = THIS.Parent loGrid = loColumn.Parent lcCaption = [] IF EMPTY(THIS.CAPTION) OR AT([HEADER1], UPPER(THIS.CAPTION)) > 0 IF NOT EMPTY(SET("Database")) IF AT([.], loColumn.ControlSource) = 0 lcField = loGrid.RecordSource + [.] + loColumn.ControlSource ELSE lcField = loColumn.ControlSource ENDIF lcCaption = DBGETPROP(lcField, "FIELD", "Caption") ENDIF IF EMPTY(lcCaption) IF NOT EMPTY(loColumn.CONTROLSOURCE) lcCaption = PROPER(STRTRAN(JUSTEXT(loColumn.CONTROLSOURCE), [_], [ ])) ENDIF ENDIF ENDIF IF NOT EMPTY(lcCaption) THIS.CAPTION = lcCaption ENDIF ENDPROC ENDDEFINEIn my Grid class, I have the following code in the INIT:
*!* The first 2 lines of code are just a reminder of the meaning *!* of the parameter passed to the OnHeaderClick method. LOCAL llCalledFromGridInit llCalledFromGridInit = .T. THIS.OnHeaderClick(llCalledFromGridInit) IF NOT THIS.READONLY AND THIS.lEditPrivRequired IF TYPE('goApp') = 'O' THIS.READONLY = goApp.App_ReadOnly ELSE THIS.READONLY = .T. ENDIF ENDIFThe code in the OnHeaderClick is:
LPARAMETERS tlCalledFromInit IF TYPE('tlCalledFromInit') <> 'L' tlSetCaption = .f. ENDIF LOCAL loColumn, loControl FOR EACH loColumn IN THIS.Columns FOR EACH loControl IN loColumn.Controls IF UPPER(loControl.BaseClass) = [HEADER] loControl.SetHeaderColor() IF tlCalledFromInit loControl.SetHeaderCaption() BINDEVENT(loControl, 'Click', THIS, 'OnHeaderClick', 1) ENDIF ENDIF ENDFOR ENDFORFor the MemberClassLibrary of the grid class, I just specified the PRG file where I defined my Column class. The gotcha to all this is you now have to reference your columns as _Column1, _Column2, _Header1, because of the way I named the Column and Header class. If you want to continue to reference them as Column1, Column2, Header1, I think it will still work if you remove the underscore before the class name in the code above.