LISTBOX HEADERS special characters

[Enrico Maria Giordano]

Updated and fixed version:

Code: Select all  Expand view

#include "Fivewin.ch"


#define MO_NONE 0
#define MO_ASC  1
#define MO_DESC 2


FUNCTION MAIN()

    LOCAL oDlg, oBrw

    USE TEST

    DEFINE DIALOG oDlg SIZE 400, 300

    oBrw = TMyWBrowse():New( 0, 0, , ,;
                             { || { TEST -> last, TEST -> first, "" } },;
                             { "LAST", "FIRST", "" },;
                             { 150, 150, 0 } )

    oBrw:lCellStyle = .T.

    oBrw:abOrd = { { || MO_ASC }, { || MO_DESC }, { || MO_NONE }, { || MO_NONE } }

    ACTIVATE DIALOG oDlg;
             ON INIT oDlg:SetControl( oBrw );
             CENTER

    CLOSE

    RETURN NIL


CLASS TMyWBrowse FROM TWBrowse

    DATA abOrd

    METHOD Paint()

ENDCLASS


#define SM_CYHSCROLL 3


METHOD Paint() CLASS TMyWBrowse

    LOCAL aValues   := ::aHeaders
    LOCAL aColSizes := ::GetColSizes()

    LOCAL nWidth := WNDWIDTH( ::hWnd ) - IF( ::oVScroll != nil .AND. EVAL( ::bLogicLen ) > 1, GETSYSMETRICS( SM_CYHSCROLL ) + 3, 0 )

    LOCAL nColStart := -1

    LOCAL nTop, nLeft, nRight

    LOCAL hGPen, hWPen

    LOCAL i

    Super:Paint()

    hGPen = CREATEPEN( 0, 1, CLR_GRAY )
    hWPen = CREATEPEN( 0, 1, CLR_WHITE )

    nTop = 3

    FOR i = ::nColPos TO LEN( aValues )
        nLeft  = nColStart + 1
        nRight = MIN( nColStart := ( nLeft + aColSizes[ i ] - 1 ), nWidth )

        IF nLeft > nWidth
            EXIT
        ENDIF

        IF i == LEN( aValues )
           nRight = nWidth
        ENDIF

        nRight -= 10

        IF EVAL( ::abOrd[ i ] ) = MO_ASC
            MOVETO( ::hDC, nRight, nTop )

            LINETO( ::hDC, nRight + 6, nTop, hGPen )
            LINETO( ::hDC, nRight + 3, nTop + 6, hWPen )
            LINETO( ::hDC, nRight, nTop, hGPen )
        ENDIF

        IF EVAL( ::abOrd[ i ] ) = MO_DESC
            MOVETO( ::hDC, nRight, nTop + 6 )

            LINETO( ::hDC, nRight + 6, nTop + 6, hGPen )
            LINETO( ::hDC, nRight + 3, nTop, hWPen )
            LINETO( ::hDC, nRight, nTop + 6, hGPen )
        ENDIF
    NEXT

    DELETEOBJECT( hWPen )
    DELETEOBJECT( hGPen )

    RETURN 0

EMG

[James Bott]

Good work, Enrico.

If you look at the way Microsoft does column sorting, contrary to what you might think, they use the up arrow when the column is ascending and the down arrow when it is descending. I presume this is supposed to show what will happen when you click on the header rather than the current state of the sort. I have never be able to get used to this, but it is the standard.

I am thinking about how to make this generic. I suppose we need a flag for each column containing the column status, ascending, descending or none (A, D, or N).

Then I guess we need another instance var to hold an array of index orders. If a user clicks on a column then we check the sort status flag. If A then change to D, if D then change to A, if N then change to A and change all other column flags to N.

We would also have to make allowances for columns that don't have indexes. Either we create a temp index or we don't allow sorting. Perhaps we could use the size of the table to decide whether to build a temp index or not.

It would be really nice to have all this capability built into TWBrowse.

James

[James Bott]

Enrico,

Silly me. After looking at your code again, I see you already have added an array containing the sort status. I am curious as to why you used a codeblock instead of just a value?

James

[Enrico Maria Giordano]

Because that way the condition can be dynamic (ie. calculated during runtime). As an example you can use the status of ORDDESCEND().

EMG

[James Bott]

Here is a working example with the capabilities that I mentioned in my previous message.

Some of this needs to be implemented better such as setting default values in the new() method.

James

Code: Select all  Expand view

/*
Purpose: Test ascending/descending arrows in headers in TWBrowse
Author : Enrico Maria Giordano
Date   : 10/27/2006 7:11AM
Revised: James Bott
*/

#include "Fivewin.ch"


#define MO_NONE 0
#define MO_ASC  1
#define MO_DESC 2


FUNCTION MAIN()

    LOCAL oDlg, oBrw

    USE customer alias test

    DEFINE DIALOG oDlg SIZE 400, 300

    oBrw = TMyWBrowse():New( 0, 0, , ,;
                             { || { TEST -> last, TEST -> first, "" } },;
                             { "LAST", "FIRST", "" },;
                             { 150, 150, 0 } )

    oBrw:lCellStyle = .T.

    oBrw:abOrd = { { || MO_NONE }, { || MO_NONE }, { || MO_NONE } }

    oBrw:aActions := { {|self,nRow,nCol| ::sort(nCol)}, {|self,nRow,nCol| ::sort(nCol)}, {|self,nRow,nCol| ::sort(nCol)} }

    ACTIVATE DIALOG oDlg;
             ON INIT oDlg:SetControl( oBrw );
             CENTER

    CLOSE

    RETURN NIL


CLASS TMyWBrowse FROM TWBrowse

    DATA abOrd

    METHOD Paint()

    METHOD Sort()

ENDCLASS


#define SM_CYHSCROLL 3


METHOD Paint() CLASS TMyWBrowse

    LOCAL aValues   := ::aHeaders
    LOCAL aColSizes := ::GetColSizes()

    LOCAL nWidth := WNDWIDTH( ::hWnd ) - IF( ::oVScroll != nil .AND. EVAL( ::bLogicLen ) > 1, GETSYSMETRICS( SM_CYHSCROLL ) + 3, 0 )

    LOCAL nColStart := -1

    LOCAL nTop, nLeft, nRight

    LOCAL hGPen, hWPen

    LOCAL i

    Super:Paint()

    hGPen = CREATEPEN( 0, 1, CLR_GRAY )
    hWPen = CREATEPEN( 0, 1, CLR_WHITE )

    nTop = 3

    FOR i = ::nColPos TO LEN( aValues )
        nLeft  = nColStart + 1
        nRight = MIN( nColStart := ( nLeft + aColSizes[ i ] - 1 ), nWidth )

        IF nLeft > nWidth
            EXIT
        ENDIF

        IF i == LEN( aValues )
           nRight = nWidth
        ENDIF

        nRight -= 15

        IF EVAL( ::abOrd[ i ] ) = MO_DESC
            MOVETO( ::hDC, nRight, nTop )

            LINETO( ::hDC, nRight + 6, nTop, hGPen )
            LINETO( ::hDC, nRight + 3, nTop + 6, hWPen )
            LINETO( ::hDC, nRight, nTop, hGPen )
        ENDIF

        IF EVAL( ::abOrd[ i ] ) = MO_ASC
            MOVETO( ::hDC, nRight, nTop + 6 )

            LINETO( ::hDC, nRight + 6, nTop + 6, hGPen )
            LINETO( ::hDC, nRight + 3, nTop, hWPen )
            LINETO( ::hDC, nRight, nTop + 6, hGPen )
        ENDIF
    NEXT

    DELETEOBJECT( hWPen )
    DELETEOBJECT( hGPen )

RETURN 0


METHOD SORT( nCol ) CLASS TMyWBrowse
   LOCAL i:=0
   LOCAL nColNo := ::nAtCol(nCol)
   do case
      case eval( ::abOrd[nColNo] ) == MO_ASC
         ::abOrd[nColNo] := {|| MO_DESC }
      case eval( ::abOrd[nColNo] ) == MO_DESC
         ::abOrd[nColNo] := {|| MO_ASC }
      otherwise
         ::abOrd[nColNo] := {|| MO_ASC }
   endcase
   for i:=1 to len( ::aHeaders )
      if i != nColNo
         ::abOrd[i] := {|| MO_NONE }
      endif
   next
   ::PAINT()
RETURN NIL

// eof

[James Bott]

Enrico,

>Because that way the condition can be dynamic (ie. calculated during runtime). As an example you can use the status of ORDDESCEND().

OK. What I was thinking is we need a protected array that cannot be changed by the programmer--it is set by user clicks on the header only. It must contain only one column with an A or D and all other columns must contain N. You wouldn't need to check the RDD status, you would just force it to be ascending, descending or change the order (and set to ascending) depending on the status array.

OK, I just realized that you do need someway for the programmer to set the status array for the initial display of the browse. For example, if the browse is already sorted. Ill have to think about that some more...

James

[James Bott]

Here is an slightly improved version that actually displays the data column sorted in addition to showing the header arrow.

James

Code: Select all  Expand view

/*
Purpose: Test ascending/descending arrows in headers in TWBrowse
Author : Enrico Maria Giordano
Date   : 10/27/2006 7:11AM
*/

#include "Fivewin.ch"


#define MO_NONE 0
#define MO_ASC  1
#define MO_DESC 2

external ordkeyno, ordkeycount, ordKeygoto

FUNCTION MAIN()

   LOCAL oDlg, oBrw
   FIELD FIRST,LAST

   REQUEST DBFCDX
   RddSetDefault( "DBFCDX" )

   USE customer alias test
   index on upper(first) to customer //tag "first"
   index on upper(last) to cutomer //tag "last"

   DEFINE DIALOG oDlg SIZE 400, 300

   oBrw = TMyWBrowse():New( 0, 0, , ,;
                             { || { TEST -> last, TEST -> first, "" } },;
                             { "LAST", "FIRST", "" },;
                             { 150, 150, 0 } )

   oBrw:lCellStyle = .T.

   oBrw:abOrd = { { || MO_NONE }, { || MO_NONE }, { || MO_NONE } }

   oBrw:aOrders := { 2,1,0 }

   oBrw:aActions := { {|self,nRow,nCol| ::sort(nCol)}, {|self,nRow,nCol| ::sort(nCol)}, {|self,nRow,nCol| ::sort(nCol)} }

   ACTIVATE DIALOG oDlg;
             ON INIT oDlg:SetControl( oBrw );
             CENTER

   CLOSE

RETURN NIL


CLASS TMyWBrowse FROM TWBrowse

    DATA abOrd,aOrders

    METHOD Paint()

    METHOD Sort()

ENDCLASS


#define SM_CYHSCROLL 3


METHOD Paint() CLASS TMyWBrowse

    LOCAL aValues   := ::aHeaders
    LOCAL aColSizes := ::GetColSizes()

    LOCAL nWidth := WNDWIDTH( ::hWnd ) - IF( ::oVScroll != nil .AND. EVAL( ::bLogicLen ) > 1, GETSYSMETRICS( SM_CYHSCROLL ) + 3, 0 )

    LOCAL nColStart := -1

    LOCAL nTop, nLeft, nRight

    LOCAL hGPen, hWPen

    LOCAL i

    Super:Paint()

    hGPen = CREATEPEN( 0, 1, CLR_GRAY )
    hWPen = CREATEPEN( 0, 1, CLR_WHITE )

    nTop = 3

    FOR i = ::nColPos TO LEN( aValues )
        nLeft  = nColStart + 1
        nRight = MIN( nColStart := ( nLeft + aColSizes[ i ] - 1 ), nWidth )

        IF nLeft > nWidth
            EXIT
        ENDIF

        IF i == LEN( aValues )
           nRight = nWidth
        ENDIF

        nRight -= 15

        IF EVAL( ::abOrd[ i ] ) = MO_DESC
            MOVETO( ::hDC, nRight, nTop )

            LINETO( ::hDC, nRight + 6, nTop, hGPen )
            LINETO( ::hDC, nRight + 3, nTop + 6, hWPen )
            LINETO( ::hDC, nRight, nTop, hGPen )
        ENDIF

        IF EVAL( ::abOrd[ i ] ) = MO_ASC
            MOVETO( ::hDC, nRight, nTop + 6 )

            LINETO( ::hDC, nRight + 6, nTop + 6, hGPen )
            LINETO( ::hDC, nRight + 3, nTop, hWPen )
            LINETO( ::hDC, nRight, nTop + 6, hGPen )
        ENDIF
    NEXT

    DELETEOBJECT( hWPen )
    DELETEOBJECT( hGPen )

    RETURN 0

// Note: nCol is in pixels--it is not the column number
METHOD SORT( nCol ) CLASS TMyWBrowse
   LOCAL i:=0
   LOCAL nColNo := ::nAtCol(nCol)
   (::cAlias)->(dbsetorder( ::aOrders[nColNo] ))
   do case
      case eval( ::abOrd[nColNo] ) == MO_ASC
         ::abOrd[nColNo] := {|| MO_DESC }
         (::cAlias)->(orddescend(,,.t.)) // set to descending
      case eval( ::abOrd[nColNo] ) == MO_DESC
         ::abOrd[nColNo] := {|| MO_ASC }
         (::cAlias)->(orddescend(,,.f.)) // set to ascending
      otherwise
         ::abOrd[nColNo] := {|| MO_ASC }
   endcase
   for i:=1 to len( ::aHeaders )
      if i != nColNo
         ::abOrd[i] := {|| MO_NONE }
      endif
   next
   (::cAlias)->(dbgotop())
   ::paint()
RETURN NIL

[Enrico Maria Giordano]

Great. But please fix my name

Author : Ericro Maria Giordano

and add your name as

Improved by: James Bott



EMG

[James Bott]

Enrico,

>Great. But please fix my name

Oops! A multi-typo. When I do something I go all out. Sorry.

Fixed.

James

[Rochinha]

Hi,

Take look im my release.

Code: Select all  Expand view

FUNCTION MAIN()

    LOCAL oDlg, oBrw

    USE part
    INDEX ON partno     TAG part01 TO part
    INDEX ON partnAME TAG part02 TO part
    SET INDEX to part // I create the index to test

    DEFINE DIALOG oDlg SIZE 400, 300

    oBrw = TMyWBrowse():New( 0, 0, , ,;
                             { || { part->partno, part->partname } },;
                             { "LAST", "FIRST" },;
                             { 150, 150, 0 } )

     // with double click feature put data in especific order
     oBrw:bLDblClick := { |nRow,nCol | (iif( nRow<12,( iif( oBrw:nAtCol(nCol)=2, OrdSetFocus(2), OrdSetFocus(1)), oBrw:GoTop(), oBrw:Refresh()),.t.) ) }
    oBrw:aOrd       := { { || iif(IndexOrd()=1,MO_ASC,MO_NONE) }, { || iif(IndexOrd()=2,MO_ASC,MO_NONE) }, { || MO_NONE }, { || MO_NONE } }

    oBrw:lCellStyle := .T.

    ACTIVATE DIALOG oDlg;
             ON INIT oDlg:SetControl( oBrw );
             CENTER

    CLOSE

    RETURN NIL


Thanks,