Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Testing for header click in a grid
Message
 
 
To
29/07/2003 08:32:44
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Miscellaneous
Thread ID:
00814471
Message ID:
00814480
Views:
11
This is more than you asked for, but you can now specify in the grid which column class to use. Then in the column class you can specify what header class to use. The column and header class have to be in a PRG, and here is mine:
#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
ENDDEFINE
In 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
ENDIF
The 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
ENDFOR
For 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.
Mark McCasland
Midlothian, TX USA
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform