Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Active Cell colors and grid row colors
Message
General information
Forum:
Visual FoxPro
Category:
Classes - VCX
Environment versions
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01047803
Message ID:
01048061
Views:
24
This message has been marked as the solution to the initial question of the thread.
This code works also, BUT I changed this class to based on GRID not on CGRID. Also I comment
loSelect = createobject('CSelect', this.recordsource) in createtag because I don't know wnat object is this.
PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.Show
RETURN

DEFINE CLASS form1 AS form


    Top = 0
    Left = 0
    Height = 459
    Width = 598
    DoCreate = .T.
    Caption = "Form1"
    Name = "Form1"


    ADD OBJECT grid1 AS grdsorting WITH ;
        Height = 335, ;
        Left = 12, ;
        Top = 72, ;
        Width = 447, ;
        Name = "Grid1"



    PROCEDURE Load
        CREATE CURSOR cTest (C1 C(10), c2 N(1), c3 I)
        FOR asd = 1 TO 10
            INSERT INTO cTest VALUES (TRANSFORM(asd),asd-1,asd%2)
        NEXT
        GO TOP
    ENDPROC




ENDDEFINE
*


**************************************************
*-- Class:        grdsorting (c:\mmviscollect\libs\acustomcontrols.vcx)
*-- ParentClass:  cgrid (c:\mmortals\common30\libs\ccontrls.vcx)
*-- BaseClass:    grid
*-- Time Stamp:   09/09/05 08:58:01 AM
*-- Subclass of cGrid class which delegates Header click event to HeaderClick custom method (this method sorts by column's controlsource) and also delegates column's textboxes' DblClick to grid's DblClick
*
DEFINE CLASS grdsorting AS grid


    HighlightBackColor    = RGB(0,0,255)
    SelectedItemBackColor = RGB(0,0,255)
    HighlightStyle = 2
    nRecNo         = 0
    *-- This property tells, if we want to add visual representation of the sorting
    
    lshowsortingarrows = .T.
    *-- This property tells, if the grid's recordsource should be at the top after sorting
    lgotopaftersorting = .T.
    *-- This property tells wheither we need to update toolbar buttons or not
    lupdatetoolbar = .T.
    *-- If this property is set to true (default), then the indexes are created for every column in the grid
    lcreateindexes = .T.
    Name = "grdsorting"

    *-- This property saves the header of the last sorted column
    olastsorted = .F.

    *-- If this property is set, use DynamicBackColor to set highlight
    lmanualhighlight = .F.

    *-- Holds grid's column controlsources and sizes
    cgridscript = .F.

    *-- If this property is set to true, then grid's properties are saved
    lsavegridproperties = .F.


    *-- This method is invoked when any grid's column header is clicked
    PROCEDURE headerclick
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         GrdSorting
        *   Method:     HeaderClick()
        *----------------------- Usage Section --------------------------
        *)  Description: Custom method which fires when Header is clicked (idea from Barbara Peisch)
        *)
        *   Scope:      Public
        *   Parameters:
        *$  Usage:
        *$
        *   Returns:
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     01/06/2005 - NN
        *        MODIFIED
        *----------------------------------------------------------------
        *SET COVERAGE TO Cover.log additive
        local loCalledBy && as Object

        aevents[aCurEvent,0]
        loCalledBy = aCurEvent[1] && should be a Header object

        if vartype(m.loCalledBy)= "O" and not empty(m.loCalledBy.parent.cOriginalControlSource)
            local lcOrder, lcRecSource, llDirection
            lcRecSource = this.recordsource
            llDirection = this.lAscending

            lcOrder = order(m.lcRecSource) && Saves current tag
            this.SetOrder(m.loCalledBy.parent.cOriginalControlSource, m.loCalledBy.CurrentTag)
            if this.lShowSortingArrows
        * Check, if we changed the order
                if not order(m.lcRecSource)== m.lcOrder or m.llDirection <> this.lAscending
        ** Clear the picture of the previously sorted column
                    m.loCalledBy.CurrentTag = this.cTagName
                    this.ClearHeaderPictures()
                    this.SetHeaderPicture(m.loCalledBy)
                endif
            endif
        endif
        this.mousepointer = 0
    ENDPROC


    *-- This method removes pictures from all the headers
    PROCEDURE clearheaderpictures
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     ClearHeaderPictures() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     01/24/2005 - NN 
        *        MODIFIED
        *----------------------------------------------------------------
        *!*    LOCAL liColumn
        *!*    FOR liColumn=1 to m.this.ColumnCount
        *!*       this.Columns[m.liColumn].Controls[1].ResetToDefault('picture')
        *!*    NEXT  
        IF VARTYPE(m.this.oLastSorted) = "O"
           this.oLastSorted.ResetToDefault('picture')
        ENDIF   
    ENDPROC


    *-- This method sets picture for the Header object which is passed by reference
    PROCEDURE setheaderpicture
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     Setheaderpicture() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     01/25/2005 - NN 
        *        MODIFIED
        *----------------------------------------------------------------
        LPARAMETERS toHeader, tcPicture

        IF VARTYPE(m.toHeader) <> "O"
           RETURN .f.
        ENDIF
        IF toHeader.Alignment = 0 && Default
            toHeader.caption = PADR(ALLTRIM(m.toHeader.caption),100) && we want to show picture at the right
        endif
        toHeader.picture = IIF(not EMPTY(m.tcPicture), m.tcPicture, ;
                           IIF(this.lAscending, "UpArrow.bmp","DownArrow.bmp"))
        this.oLastSorted = m.toHeader
    ENDPROC


    *-- Indexes a column on the fly
    PROCEDURE createtag
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting
        *   Method:     Createtag()
        *----------------------- Usage Section --------------------------
        *)  Description: Creates index for the passed header's column's controlsource on the fly
        *)               The code is taken from Vlad Grynchyshyn (with NN's minor modifications)

        *   Scope:      Public
        *   Parameters:
        *$  Usage:
        *$
        *   Returns:
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     02/07/2005 - NN
        *        MODIFIED
        *----------------------------------------------------------------
        * assuming alias for sorting is in current workarea
        * assuming this method is called from the Sorting Manager code only from this class.
        lparameters toHeader
        local lc__SortExpr, lnLimitation, llNonStructural, loSelect, lcOrder

*        loSelect = createobject('CSelect', this.recordsource)
        lcOrder = order()

        with m.toHeader

        * calculate the expression for sorting

            lnLimitation = iif(set("Collate")=="MACHINE",240,120)
            lc__SortExpr = .parent.cOriginalControlSource
        * make basic checking for control source type
            local lcType, lnValLen, llIsField, lcTag, lcField, lcCursor
            lcType = type(m.lc__SortExpr)
            llIsField = '.' $ m.lc__SortExpr and ;
                used(left(m.lc__SortExpr,at('.',m.lc__SortExpr)-1)) and ;
                fsize(substr(m.lc__SortExpr,at('.',m.lc__SortExpr)+1),left(m.lc__SortExpr,at('.',m.lc__SortExpr)-1)) > 0

            lcTag = ""

            if m.llIsField
                lcField = justext("." + m.lc__SortExpr)
                lcCursor = juststem(m.lc__SortExpr)
                lcTag = this.GetTagName (m.lcCursor, m.lcField)
            endif

            if empty(m.lcTag)
                do case
                case m.lcType $ "GOPUS"
                    lc__SortExpr = ""

                case m.lcType == "C"
                    if m.llIsField
                        lnValLen = min(fsize(substr(m.lc__SortExpr,at('.',m.lc__SortExpr)+1),left(m.lc__SortExpr,at('.',m.lc__SortExpr)-1)),m.lnLimitation)
                    else
                        lnValLen = m.lnLimitation
                    endif
                    lc__SortExpr = "PADR(NVL(" + m.lc__SortExpr + ",'')," + allt(str(m.lnValLen))+")"

                case m.lcType == "M"
                    lc__SortExpr = "PADR(" + m.lc__SortExpr + "," + allt(str(m.lnLimitation))+")"

                otherwise
                    do case
                    case m.lcType $ "DT"
                        lc__SortExpr = "NVL(" + m.lc__SortExpr + ",{})"
                    case m.lcType == "L"
                        lc__SortExpr = "NVL(" + m.lc__SortExpr + ",.F.)"
                    case m.lcType == "Y"
                        lc__SortExpr = "NVL(" + m.lc__SortExpr + ",$0)"
                    otherwise
                        lc__SortExpr = "NVL(" + m.lc__SortExpr + ",0)"
                    endcase
                endcase

        && create index tag
                if !empty(m.lc__SortExpr)
                    .CurrentTag = "T" + substr(alltrim(sys(2015)), 4, 10) && generate unique tag name

                    local lnRestoreBuffering
                    lnRestoreBuffering = cursorgetprop('Buffering')
                    if m.lnRestoreBuffering >= 4
        && OOPS - cannot index cursors in 5 buffering mode.
        && check that it does not contain modified records
                        if getnextmodified(0) = 0
                            cursorsetprop('Buffering',iif(m.lnRestoreBuffering=5,3,2))
                        else
        && OOPS - we will not be able to index it...
                            .CurrentTag = ""
                        endif
                    endif

        && check how we should create index - structural or non-structural
                    llNonStructural = cursorgetprop('SourceType')=3 and (! isexclusive() or ;
                        !(cursorgetprop('Database')=="") or !(sys(2023) == justpath(dbf())) )
        * it is a table for which either database is specified or file path is not in temporary folder
        * or just alias is not opened in exclusive mode (file in temporary folder, but it is shared)

                    if !empty(.CurrentTag)
        && disable errors
                        local lc___OldError
                        private m.ll__Error
                        ll__Error = .f.
                        lc___OldError = on("ERROR")
                        on error m.ll__Error = .t.

                        local llShowHere, lnOldRecNo
                        lnOldRecNo = iif(eof(),0,recno())
                        llShowHere = .f.
                        if reccount() > 1000
                            llShowHere = .t.
        *    .DispSortingMessage(.t.)
                        endif

                        if m.llNonStructural
                            index on ;
                                &lc__SortExpr ;
                                tag (.CurrentTag) of (sys(2023) + "\" + .CurrentTag) additive
                        else
                            index on ;
                                &lc__SortExpr ;
                                tag (.CurrentTag) additive
                        endif

                        if m.llShowHere
        *    .DispSortingMessage(.f.)
                        endif

                        if m.ll__Error && error occurred during indexing
                            .CurrentTag = "" && indicate no tag is created
                        endif

        * restore record number
                        if m.lnOldRecNo = 0
                            go bottom
                            if !eof()
                                skip
                            endif
                        else
                            go (m.lnOldRecNo)
                        endif

                        on error &lc___OldError

                        if m.lnRestoreBuffering >= 4
                            cursorsetprop('Buffering',m.lnRestoreBuffering)
                        endif
                    endif
                else
                    .CurrentTag = ""
                endif

            else
                .CurrentTag = m.lcTag
            endif
        endwith
        if not empty(m.lcOrder)
            set order to (m.lcOrder)
        else
            set order to
        endif
    ENDPROC


    *-- Returns the tag name (if exists) for the passed field name
    PROCEDURE gettagname
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting
        *   Method:     Gettagname()
        *----------------------- Usage Section --------------------------
        *)  Description:
        *)

        *   Scope:      Public
        *   Parameters:
        *$  Usage:
        *$
        *   Returns:
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     02/10/2005 - NN
        *        MODIFIED
        *----------------------------------------------------------------
        Lparameters tcCursor, tcField
        *----------------------------------------------
        *--- A tag name was not passed. Try to find a
        *--- tag for the current column's ControlSource
        *--- Get the number of indexes for the cursor.
        *----------------------------------------------
        LOCAL lnCount, lcIndexExpr, lnIndexes, lcTagName
        LOCAL ARRAY laIndex[1]

        lnIndexes = AIndexes(@laIndex, m.tcCursor)
        lcTagName = ""
        *----------------------------------------------------------------
        *-- See if the field name is in the leftmost part of an index
        *-- expression OR simply within an UPPER() statement.
        *-- If so, SET ORDER TO the index.
        *----------------------------------------------------------------
        For lnCount = 1 To m.lnIndexes
            lcIndexExpr = Upper(Sys(14, m.lnCount, m.tcCursor))

        *--------------------------------------------------
        *--- Allow for character indexes that are simply
        *--- surrounded by "UPPER()". Remove "UPPER()".
        *--------------------------------------------------
            If Left(m.lcIndexExpr,6) = 'UPPER('
                lcIndexExpr = Substr(m.lcIndexExpr,7)
                lcIndexExpr = Substr(m.lcIndexExpr,1,Len(m.lcIndexExpr)-1)
            Endif

            If m.lcIndexExpr = Upper(m.tcField)
                lcTagName = Tag(m.lnCount, m.tcCursor)
        *--- Index found...exit ---*
                lnCount = m.lnIndexes + 1
            Endif
        Endfor

        Return m.lcTagName
    ENDPROC


    *-- This method saves column's properties as a script
    PROCEDURE savegridproperties
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     Savegridproperties() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     03/30/2005 - WGB
        *        CHANGED - NN - March 31, 2005 - 09:53:29
        *----------------------------------------------------------------
        LOCAL lcGridScript, lcReference, loColumn

        lcReference = SYS(1272, this)

        lcReference = "_screen.ActiveForm." + SUBSTR(m.lcReference,AT(".",m.lcReference)+1)

        SET TEXTMERGE ON
        SET TEXTMERGE TO MEMVAR lcGridScript NOSHOW && TEXTMERGE begins on the next line.

        \With <<m.lcReference>>
             FOR EACH loColumn IN this.Columns

                \.<<loColumn.name>>.ControlSource = "<<loColumn.ControlSource>>"
                \.<<loColumn.name>>.width = <<loColumn.width>>
             NEXT
        \endwith
        SET TEXTMERGE TO
        SET TEXTMERGE OFF

        this.cGridScript = m.lcGridScript


    ENDPROC


*!*        *-- This method sets columns' properties
    PROCEDURE resetgridproperties
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     ResetGridProperties() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     03/30/2005 - WGB
        *        MODIFIED    05/03/2005 - NN
        *----------------------------------------------------------------
        *!*    IF !EMPTY( this.cGridscript )
        *!*        EXECSCRIPT(this.cGridscript )
        *!*    ENDIF FOR EACH loColumn IN .COLUMNS
        LOCAL loColumn
        FOR EACH loColumn IN this.Columns
            m.loColumn.CONTROLSOURCE = m.loColumn.cOriginalControlSource 
        NEXT
    ENDPROC


    *-- This method re-creates indexes used for sorting. It should be called explicitly after re-creating grid's recorsource
    PROCEDURE recreateindexes
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     Recreateindexes() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     04/01/2005 - NN 
        *        MODIFIED
        *----------------------------------------------------------------
        LOCAL loColumn, loControl
        FOR EACH loColumn IN THIS.COLUMNS
            FOR EACH loControl IN loColumn.CONTROLS
                IF UPPER(loControl.BASECLASS) = "HEADER"
                   this.CreateTag (m.loControl)
                ENDIF
            ENDFOR
        ENDFOR
    ENDPROC


    *-- This method refreshes navigation buttons on the toolbar
    PROCEDURE refreshtoolbars
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting
        *   Method:     Refreshtoolbars()
        *----------------------- Usage Section --------------------------
        *)  Description:
        *)

        *   Scope:      Public
        *   Parameters:
        *$  Usage:
        *$
        *   Returns:
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     07/06/2005 - NN
        *        MODIFIED
        *----------------------------------------------------------------
        Local lcRecordSource, lcCondition
        With This
            lcRecordSource = .RecordSource
            If Vartype(Thisform.oToolbar) = "O" And ;
                    lower(Thisform.cToolbar)='anavtoolbar' And ;
                    type('thisform.oToolBar.cntNavButtons')='O' And ;
                    thisform.oToolbar.cntNavButtons.Visible = .T.
                Thisform.lBOF = Bof(m.lcRecordSource) or RECCOUNT(m.lcRecordSource) = 0
                Thisform.lEOF = Eof(m.lcRecordSource)

                lcCondition = ""
                Go Bottom In (m.lcRecordSource)
                If .nRecno = Recno(m.lcRecordSource)
                    lcCondition = "EOF"
                Else
                    Go Top In (m.lcRecordSource)
                    If .nRecno = Recno(m.lcRecordSource)
                        lcCondition = "BOF"
                    Endif
                Endif
                If Between(.nRecno,1,Reccount(m.lcRecordSource))
                    Goto .nRecno In (m.lcRecordSource)
                Endif
                Thisform.oToolbar.cntNavButtons.Refresh(m.lcCondition, m.lcRecordSource)
            Endif
        Endwith
    ENDPROC


    PROCEDURE BeforeRowColChange
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     Beforerowcolchange() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     03/11/2005 - NN 
        *        MODIFIED
        *----------------------------------------------------------------
        LPARAMETERS nColIndex

        IF this.lManualHighlight
              thisform.LockScreen = .t.
        ENDIF

        DODEFAULT(m.nColIndex)  
    ENDPROC


    PROCEDURE setorder
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting
        *   Method:  SetOrder()
        *----------------------- Usage Section --------------------------
        *)  Description:
        *)        This method checks if there is a tag for the current
        *)        column's RowSource (specified in tcControlSource),
        *)        and if so, sets the order to it AND sets cGrid.cTagName
        *)        to the tag name of the index. If the optional second
        *)        parameter is passed, it simply issues a SET ORDER
        *)        on the tag.
        *
        *   Scope:      Public
        *   Parameters:
        *        1. tcControlSource - Name of the ControlSource
        *        2. tcTagName -         (optional)Name of an index tag to
        *                               be used to SET ORDER
        *
        *$  Usage:      Typically called from the Click() method of
        *                     a grid header.
        *
        *   Returns:  Logical .T. by default
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *        MODIFIED 10/27/97 - KJM
        *            Moved this method up the hierarchy from CSetOrderGrid
        *            to CGrid so that SetOrder functionality is available
        *            to all grids in the framework. CSetOrderGrid, although
        *            no longer necessary is left in the framework for
        *            backward compatibility.
        *            Also enhanced the code to allow for index expressions
        *            that are simply surrounded by an UPPER() statement.
        *        MODIFIED 04/16/98 - KJM
        *            Added a second tcTagName parameter. If a value has
        *            been passed ignore the tcControlSource parameter for
        *            now (may be used in the future) and set the ORDER
        *            to the specified tag.
        *        MODIFIED    07/10/99 - KJM
        *            Enhanced this method so that clicking on a column
        *            header toggles the ascending/descending order of
        *            the currently selected column.
        *        MODIFIED    11/01/99 - KJM
        *            Check if RECCOUNT() > 0 before issuing GOTO lnRecNo
        *        MODIFIED    10/05/00 - KJM
        *            Added a call to ThisForm.SetFilePos() so the
        *            navigation toolbar gets properly refreshed.
        *        MODIFIED    06/25/02 - KJM
        *            Changed "IF NOT tcTagName == UPPER(This.cTagName)"
        *            to "IF NOT UPPER(tcTagName) == UPPER(This.cTagName)"
        *-----------------------------------------------------------------
        *        MODIFIED  01/25/2005 - NN -
        *                 Added two new grid properties to not refresh toolbars and to go top after sorting
        *                 Also do not sort if empty grid
        *----------------------------------------------------------------
        LPARAMETERS tcControlSource, tcTagName
        LOCAL lcField, lcCursor, lcAscDesc, lnRecNo, loSelect, lnDirection, lnRelativeRow, lnI, lnJ

        *----------------------------------------------------------
        *-- Get the field and cursor name for the ControlSource
        *----------------------------------------------------------
        lcField = JUSTEXT("." + m.tcControlSource)
        lcCursor = JUSTSTEM(m.tcControlSource)

        * Change by NN
        IF RECCOUNT(m.lcCursor) = 0 && empty cursor, why bother?
            RETURN
        ENDIF

        THISFORM.LOCKSCREEN = .T.

        lnRecNo = RECNO(m.lcCursor)

        loSelect = CREATEOBJECT('CSelect', m.lcCursor)

        WITH THIS
            IF PCOUNT() < 2 OR EMPTY(m.tcTagName) OR TAGNO(m.tcTagName) = 0
                tcTagName = .GetTagName(m.lcCursor, m.lcField)
            ENDIF

        ** Save current relative row
            lnRelativeRow = .RELATIVEROW

        *----------------------------------
        *--- Determine ASCENDING/DESCENDING
        *----------------------------------
            IF NOT EMPTY(m.tcTagName)
                IF NOT UPPER(m.tcTagName) == UPPER(.cTagName)
        *--- Default to ascending ---*
                    .lAscending = .T.
                ELSE
        *--- Toggle ascending/descending ---*
                    .lAscending = NOT .lAscending
                ENDIF

        *------------------------
        *--- SET ORDER to the tag
        *------------------------
                .cTagName = m.tcTagName
                lcAscDesc = IIF(.lAscending, 'ASCENDING', 'DESCENDING')
                SET ORDER TO TAG (m.tcTagName) IN (m.lcCursor) &lcAscDesc

        *---------------------------------------------------
        *--- Refresh the grid and restore the record pointer
        *--- If done in the reverse order (GOTO, Refresh),
        *--- the grid is visually on the wrong record.
        *---------------------------------------------------
                .REFRESH()
        *-- CHANGE - NN - January 25, 2005 - 09:37:53
                IF .lGoTopAfterSorting
                    GO TOP IN (m.lcCursor)

                ELSE
                    IF RECCOUNT(m.lcCursor) > 0
                        GOTO m.lnRecNo IN (m.lcCursor)
                    ENDIF
                ENDIF
                .REFRESH() && again
        *-- CHANGE - NN - January 25, 2005 - 09:38:59 - added a new property
                IF .lUpdateToolbar
        *THISFORM.SetFilePos() && Note, that this code assumes existance of the SetFilePos method
                    .RefreshToolbars()
                ENDIF
        ** Code from David Frankenbah
                IF ( m.lnRelativeRow != .RELATIVEROW )
        * the record didn't wind up at the same grid row, so we scroll the grid

                    lnDirection = IIF(m.lnRelativeRow > .RELATIVEROW, 0, 1 )
                    lnJ = ABS(m.lnRelativeRow - .RELATIVEROW )
                    FOR lnI = 1 TO lnJ
                        .DOSCROLL( lnDirection )
                    ENDFOR

                *    .REFRESH() && YAR
                ENDIF

            ENDIF
        ENDWITH

        THISFORM.LOCKSCREEN = .F.
    ENDPROC


    PROCEDURE Init
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting
        *   Method:     Init()
        *----------------------- Usage Section --------------------------
        *)  Description: (ideas from message #<A HREF="/wconnect/wc.dll?LevelExtreme~2,15,946490">946490</A> by Barbara Peisch)
        *)

        *   Scope:      Public
        *   Parameters:
        *$  Usage:
        *$
        *   Returns:
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     01/06/2005 - NN
        *        MODIFIED    01/10/05 - JMW Changed the variable names to 
        *                    Hungarian notation.
        *      MODIFIED     03/11/2005 - NN
        *----------------------------------------------------------------
        IF NOT DODEFAULT()
           RETURN .f.
        ENDIF

        LOCAL loColumn, loControl

        * Delegate header's click to grid's HeaderClick custom method 
        * and column's textbox DblClick to grid's DblClick

        FOR EACH loColumn IN THIS.COLUMNS
           m.loColumn.AddProperty("cOriginalControlSource",m.loColumn.ControlSource)
            FOR EACH loControl IN loColumn.CONTROLS
                IF UPPER(loControl.BASECLASS) = "HEADER"
                    BINDEVENT(loControl,"Click",THIS,"HeaderClick")
                    m.loControl.AddProperty("CurrentTag","") && Adds CurrentTag property
                    IF this.lCreateIndexes && Adds indexes on the fly
                       this.CreateTag (m.loControl)
                    endif
                ELSE
                    IF UPPER(loControl.BASECLASS) = "TEXTBOX"
                        BINDEVENT(loControl,"DblClick",THIS,"DblClick")
                    ENDIF
                ENDIF
            ENDFOR
        ENDFOR

        IF this.lManualHighlight 
           this.SetAll("DynamicBackColor","iif(recno(this.RecordSource)=this.nRecno,this.HighlightBackColor,this.BackColor)", "Column") 
           this.SetAll("DynamicForeColor","iif(recno(this.RecordSource)=this.nRecno,this.HighlightForeColor,this.ForeColor)", "Column") 
           this.HighlightStyle = 0   
        ENDIF

        IF this.lSaveGridProperties 
            this.SaveGridProperties()
        ENDIF

    ENDPROC


    PROCEDURE Destroy
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting  
        *   Method:     Destroy() 
        *----------------------- Usage Section --------------------------
        *)  Description: 
        *)

        *   Scope:      Public
        *   Parameters: 
        *$  Usage:      
        *$              
        *   Returns:  
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     02/03/2005 - NN 
        *        MODIFIED
        *----------------------------------------------------------------
        this.oLastSorted = null
        RETURN DODEFAULT()
    ENDPROC


    PROCEDURE AfterRowColChange
        *---------------------- Location Section ------------------------
        *   Library:     Acustomcontrols.vcx
        *   Class:         Grdsorting
        *   Method:     Afterrowcolchange()
        *----------------------- Usage Section --------------------------
        *)  Description:
        *)

        *   Scope:      Public
        *   Parameters:
        *$  Usage:      Sets highlight by using DynamicBackColor
        *$
        *   Returns:
        *--------------------- Maintenance Section ----------------------
        *   Change Log:
        *       CREATED     03/11/2005 - NN
        *        MODIFIED
        *----------------------------------------------------------------
        LPARAMETERS nColIndex
        LOCAL lcRecordSource, lcCondition
        WITH THIS
            lcRecordSource = .RECORDSOURCE
            .nRecno = RECNO(m.lcRecordSource)

            IF .lManualHighlight
                IF INLIST(.ROWCOLCHANGE, 1, 3) && Row change
                    .REFRESH()
                ENDIF
            ENDIF
            .RefreshToolbars()
        ENDWITH
        DODEFAULT(m.nColIndex)
        THISFORM.LOCKSCREEN = .F.
    ENDPROC


ENDDEFINE
*
*-- EndDefine: grdsorting
**************************************************

FUNCTION AIndexes(laIndex, tcCursor)

RETURN 0
Against Stupidity the Gods themselves Contend in Vain - Johann Christoph Friedrich von Schiller
The only thing normal about database guys is their tables.
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform