Page 1 of 1

xBrowse : Arraysort and arrayseek (again)

Posted: Sun Mar 20, 2011 11:49 am
by Frank Demont
Browsing a array make it possible to have each column as seek column , a dbf only the columns with a index.

A index can be very complicated, see in the example column3 , numbers are omitted from the ordering (and seek)

In many cases i try to use a array instead from a dbf. To have the same results from the dbf ordering and seek must be the same as in the dbf.

In this example i use CUSTUMER.DBF as example. In the arrayseek i have as ordering (and seek) for the columns

FIRST (1) : FIRST + LAST (secundary key)
LAST (2) : LAST + FIRST
STREET (3) : Numbers and spaces are omitted

These columns have also an index , dbfseek must give the same results

To show the possibility's from the arrayseek (and sort) i added :

CITY (4) : CITY + STREET(numbers and spaces omitted)
STATE(5) : STATE + CITY

NOTES (11) : Only numbers are concidered. Ordering (and seek) on recordnumber !!!

Only few changes are needed in xbrowse , the example is complete

Code: Select all

#include "FiveWin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
# include "common.ch"
# define bORDER1       {|a|IIF(pCount()==0 , a := {FIELD->First,FIELD->Last},) , PAD(UPPER(TRIM(a[1])+TRIM(a[2])),20)}
# define bORDER2       {|a|IIF(pCount()==0 , a := {FIELD->Last,FIELD->First},) , PAD(UPPER(TRIM(a[2])+TRIM(a[1])),20)}
# define bORDER3       {|a|PAD(CharOnly("ABCDEFGHIJKLMNOPQRSTUVWXYZ",UPPER(TRIM(IIF(PCOUNT()==0,FIELD->Street,a[3])))),20)}
static oWnd
//----------------------------------------------------------------------------//
function Main()
***************
    SET _3DLOOK ON
    SET(_SET_AUTOPEN, .F. )                            // Auto open cdx-file
   REQUEST DBFCDX
   rddsetdefault( "DBFCDX" )
     IF File("Cust.cdx")
        fErase("Cust.cdx")
     end
     USE CUSTOMER NEW SHARED
     SET INDEX TO
     INDEX ON EVAL(bORDER1) TAG First TO Cust     // EVAL(bORDER1) is executed without parameter
     //INDEX ON PAD(UPPER(TRIM(First))+UPPER(TRIM(Last)),20) TAG First TO Cust
     INDEX ON EVAL(bORDER2) TAG Last TO Cust      // EVAL(bORDER2) is executed without parameter
     //INDEX ON PAD(UPPER(TRIM(Last))+UPPER(TRIM(First)),20) TAG Last TO Cust
     INDEX ON EVAL(bORDER3) TAG STREET TO Cust    // EVAL(bORDER3) is executed without parameter
     //INDEX ON PAD(CharOnly("ABCDEFGHIJKLMNOPQRSTUVWXYZ",UPPER(TRIM(Street))),20) TAG STREET TO Cust
     SET INDEX TO CUST
   DEFINE WINDOW oWnd FROM 2, 2 TO 20, 70 ;
      TITLE "Autosort and seek in Array with Secondary key(s)" ;
      MENU BuildMenu()
   ACTIVATE WINDOW oWnd MAXIMIZED
     CLOSE ALL
return nil
//----------------------------------------------------------------------------//
function BuildMenu(oWnd)
   local oMenu, oItem
MENU oMenu
    MENUITEM "Autorder and seek in Array";
    ACTION  ArraySortSeek()
    MENUITEM "Autorder and seek in DBF (Index)";
    ACTION  DbfSortSeek()
ENDMENU
return oMenu
//----------------------------------------------------------------------------//
STATIC FUNCTION ArraySortSeek()
*******************************
   local oBrw, oCol
     local Arr[0] , i , oSay
     DEFINE DIALOG oDlg TITLE "Autosort and seek in Array" SIZE 1200,800 PIXEL//MDICHILD OF oWnd
     DBEVAL({||AADD(Arr,ReadRec())})
     GO BOTTOM
     @ 0, 0 XBROWSE oBrw OF oDlg ARRAY Arr AUTOCOLS AUTOSORT SIZE 600,350 PIXEL
   oBrw:CreateFromCode()
     FOR EACH oCol IN oBrw:aCols
        i := Hb_EnumIndex()
        oCol:cHeader := FieldName(i)
     NEXT
     oBrw:aCols[1]:bOrder := bORDER1 // EVAL(bORDER1) will be executed with parameter array oBrw:aRow
     //oBrw:aCols[1]:bOrder := {|x|UPPER(TRIM(x[1])+TRIM(x[2]))}
     oBrw:aCols[2]:bOrder := bORDER2 // EVAL(bORDER2) will be executed with parameter array oBrw:aRow
     //oBrw:aCols[2]:bOrder := {|x|UPPER(TRIM(x[2])+TRIM(x[1]))}
     oBrw:aCols[3]:bOrder := bORDER3 // EVAL(bORDER3) will be executed with parameter array oBrw:aRow
     oBrw:aCols[4]:bOrder := {|x|UPPER(TRIM(x[4]))+EVAL(bORDER3,x)}   // In DBF no Index , here on CITY + STREET (Alfabetic , no numbers or space)
     oBrw:aCols[5]:bOrder := {|x|UPPER(TRIM(x[5])+TRIM(x[4]))}        // In DBF no Index , here on STATE + CITY
     oBrw:aCols[11]:bOrder := {|x|VAL(CharOnly("1234567890",TRIM(x[11])))}        // In DBF no Index , here on NOTES , only numbers , record number !
     @ 360 , 100 SAY oBrw:oSeek PROMPT oBrw:cSeek OF oDlg PIXEL BORDER SIZE 100,12//SHADED
   oBrw:bSeek := { | c | MySeekOnArray( oBrw, oBrw:aArrayData, c ) }
     ACTIVATE DIALOG oDlg ON INIT (oBrw:aCols[1]:cOrder:="D",oBrw:aCols[1]:SortArrayData() , oBrw:SetFocus())
RETURN NIL
********************************************************************************************
STATIC FUNCTION DbfSortSeek()
******************************
   local oBrw, oCol
     local Arr[0] , i , oSay
     OrdSetFocus("First")
     DEFINE DIALOG oDlg TITLE "Auto Sort and seek in DBF" SIZE 1200,800 PIXEL//MDICHILD OF oWnd
     GO BOTTOM
     @ 0, 0 XBROWSE oBrw OF oDlg ALIAS "Customer" AUTOCOLS AUTOSORT SIZE 600,350 PIXEL
   oBrw:CreateFromCode()
     @ 360 , 100 SAY oBrw:oSeek PROMPT oBrw:cSeek OF oDlg PIXEL BORDER SIZE 100,12  // SIZE MUST BE SPECIFIED , LEN(oBrw:cSeek) = 0 , oSay isn't showed without size
   oBrw:bSeek := { | c | DbSeek(UPPER(c)) }   // needed to upperseek (FWH 8.10) !
     ACTIVATE DIALOG oDlg ON INIT ( oBrw:SetFocus())

RETURN NIL
*********************************************************************************************
FUNCTION READREC()
******************
LOCAL aField[fCount()]
LOCAL i
FOR i := 1 TO fCount()
    aField[i] := FieldGet(i)
NEXT
RETURN aField
***********************************************************************************************
INIT PROC InitXbrow()
     OVERRIDE METHOD SortArrayData IN CLASS TXBrwColumn WITH MySortArray // ClasTSCom7
     EXTEND CLASS TXBrwColumn WITH DATA bOrder
RETURN
*****************************************************************
FUNCTION MySortArray()//  CLASS TXBrwColumn
**********************
 LOCAL Self := HB_QSelf()
  local aCols
   local cOrder
   local nAt, nFor, nLen
   local uSave, cType
     # ifdef FRANKDEMONT
     local bOrder
     # endif
   aCols  := ::oBrw:aCols
   cOrder := ::cOrder
   nLen   := Len( aCols )
   nAt    := If( ValType( ::cSortOrder ) == 'N', ::cSortOrder, ::nArrayCol )
   if Len( ::oBrw:aArrayData ) > 0
      cType       := ValType( ::oBrw:aArrayData[ 1 ] )
      if cType == 'A'
         if ValType( nAt ) == 'N' .and. nAt > 0 .and. nAt <= nLen
            for nFor := 1 to nLen
               if aCols[ nFor ]:nArrayCol != ::nArrayCol
                  aCols[ nFor ]:cOrder := ""
               endif
            next
            uSave    := ::oBrw:aArrayData[ ::oBrw:nArrayAt ][ ::nArrayCol ]
                        # ifdef FRANKDEMONT
                        uSave := IIF(Isnil(::bOrder) , ::oBrw:aArrayData[ ::oBrw:nArrayAt ][ ::nArrayCol ] , ;
                                                EVAL(::bOrder, ::oBrw:aArrayData[::oBrw:nArrayAt] ) )
if cOrder == 'A'
                            IF ::bOrder = nil
                                bOrder := {|x,y| x[ nAt ] > y[ nAt ] }
                            ELSE
                                bOrder := {|x,y| EVAL(::bOrder,x) > EVAL(::bOrder,y) }
                            ENDIF
               ::cOrder     := 'D'
            else
                            IF ::bOrder = nil
                                bOrder := {|x,y| x[ nAt ] < y[ nAt ] }
                            ELSE
                                bOrder := {|x,y| EVAL(::bOrder,x) < EVAL(::bOrder,y) }
                            ENDIF
               ::cOrder     := 'A'
            endif
                        ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, bOrder  )
                        IF ::bOrder = nil
                           ::oBrw:nArrayAt   := AScan( ::oBrw:aArrayData, { |a| a[ ::nArrayCol ] == uSave } )
                       ELSE
                            ::oBrw:nArrayAt   := AScan( ::oBrw:aArrayData, { |a| EVAL(::bOrder,a) == uSave } )
    END
# else
                        if cOrder == 'A'
               ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, {|x,y| x[ nAt ] > y[ nAt ] } )
               ::cOrder     := 'D'
            else
               ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, {|x,y| x[ nAt ] < y[ nAt ] } )
               ::cOrder     := 'A'
            endif
            ::oBrw:nArrayAt   := AScan( ::oBrw:aArrayData, { |a| a[ ::nArrayCol ] == uSave } )
                        # endif
              ::oBrw:Refresh()
             endif
      elseif cType $ 'CDLN'
         if ! Empty( cOrder )
            uSave    := ::oBrw:aArrayData[ ::oBrw:nArrayAt ]
            if cOrder == 'A'
               ::oBrw:aArrayData := ASort( ::oBrw:aArrayData,,,{|x,y| cValToChar( x ) > cValToChar( y ) } )
               ::cOrder := 'D'
            else
               ::oBrw:aArrayData := ASort( ::oBrw:aArrayData,,,{|x,y| cValToChar( x ) < cValToChar( y ) } )
               ::cOrder := 'A'
            endif
            ::oBrw:nArrayAt      := AScan( ::oBrw:aArrayData, uSave )
            ::oBrw:Refresh()
         endif
      endif
   endif
return self
//----------------------------------------------------------------------------//
FUNCTION MySeekOnArray( Self, aData, cSeek )
*******************************************
   local aCols
   local nAt, nFor, nLen
   local lExact
   aCols  := ::aCols
   nLen   := len( aCols )
   cSeek  := Upper( cSeek )
   for nFor := 1 to nLen
      if !( aCols[ nFor ]:cOrder == "" )
         lExact := Set( _SET_EXACT, .f. )
                 # ifdef FRANKDEMONT
                 IF IsBlock(aCols[ nFor ]:bOrder )
            nAt    := Ascan( aData, {|v| cValToChar(EVAL( aCols[ nFor ]:bOrder  , v  ))  = cSeek } )
                 ELSE
            nAt    := Ascan( aData, {|v| Upper( cValToChar( v[ aCols[ nFor ]:nCreationOrder  ] ) ) = cSeek } )
                 END
                 # else
         nAt    := Ascan( aData, {|v| Upper( cValToChar( v[ nFor ] ) ) = cSeek } )
         # endif
                 Set( _SET_EXACT, lExact )
         if nAt > 0
            ::nArrayAt := nAt
            return .t.
         endif
      endif
   next
return .f.

 

Example with column recno

Posted: Sun Mar 27, 2011 8:49 am
by Frank Demont
Column 2 and column 8 are made unique .

Clicking column 8 or 2 (several times) may NOT change the record !!!!

Code: Select all

#include "FiveWin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
# include "common.ch"
# define bORDER1             {|a|IIF(pCount()==0 , a := {FIELD->First,FIELD->Last},) , PAD(UPPER(TRIM(a[1])+TRIM(a[2])),20)}
# define bORDER2             {|a|IIF(pCount()==0 , a := {FIELD->Last,FIELD->First,RECNO()},) , PAD(UPPER(TRIM(a[2])+TRIM(a[1])),20)+STR(ATAIL(a))}
# define bORDER3             {|a|PAD(CharOnly("ABCDEFGHIJKLMNOPQRSTUVWXYZ",UPPER(TRIM(IIF(PCOUNT()==0,FIELD->Street,a[3])))),20)}
# define FRANKDEMONT

static oWnd
//----------------------------------------------------------------------------//
function Main()
***************
    SET _3DLOOK ON
    SET(_SET_AUTOPEN, .F. )                                                      // Auto open cdx-file
     REQUEST DBFCDX
     rddsetdefault( "DBFCDX" )
     IF File("Cust.cdx")
        fErase("Cust.cdx")
     end
     USE CUSTOMER NEW SHARED
     SET INDEX TO
     INDEX ON EVAL(bORDER1) TAG First TO Cust           // EVAL(bORDER1) is executed without parameter
     //INDEX ON PAD(UPPER(TRIM(First))+UPPER(TRIM(Last)),20) TAG First TO Cust
     INDEX ON EVAL(bORDER2) TAG Last TO Cust            // EVAL(bORDER2) is executed without parameter
     //INDEX ON PAD(UPPER(TRIM(Last))+UPPER(TRIM(First)),20) TAG Last TO Cust
     INDEX ON EVAL(bORDER3) TAG STREET TO Cust      // EVAL(bORDER3) is executed without parameter
     //INDEX ON PAD(CharOnly("ABCDEFGHIJKLMNOPQRSTUVWXYZ",UPPER(TRIM(Street))),20) TAG STREET TO Cust
     SET INDEX TO CUST
     DEFINE WINDOW oWnd FROM 2, 2 TO 20, 70 ;
            TITLE "Autosort and seek in Array with Secondary key(s)" ;
            MENU BuildMenu()
     ACTIVATE WINDOW oWnd MAXIMIZED
     CLOSE ALL
return nil
//----------------------------------------------------------------------------//
function BuildMenu(oWnd)
     local oMenu, oItem
MENU oMenu
    MENUITEM "Autorder and seek in Array";
    ACTION  ArraySortSeek()
    MENUITEM "Autorder and seek in DBF (Index)";
    ACTION  DbfSortSeek()
ENDMENU
return oMenu
//----------------------------------------------------------------------------//
STATIC FUNCTION ArraySortSeek()
*******************************
     local oBrw, oCol
     local Arr[0] , i , oSay
     DEFINE DIALOG oDlg TITLE "Autosort and seek in Array" SIZE 1200,800 PIXEL//MDICHILD OF oWnd
     DBEVAL({||AADD(Arr,ReadRec())})
     GO BOTTOM
     @ 0, 0 XBROWSE oBrw OF oDlg ARRAY Arr AUTOCOLS AUTOSORT SIZE 600,350 PIXEL
     oBrw:CreateFromCode()
     FOR EACH oCol IN oBrw:aCols
        i := Hb_EnumIndex()
        oCol:cHeader := FieldName(i)
     NEXT
     oBrw:aCols[1]:bOrder := bORDER1 // EVAL(bORDER1) will be executed with parameter array oBrw:aRow
     //oBrw:aCols[1]:bOrder := {|x|UPPER(TRIM(x[1])+TRIM(x[2]))}
     oBrw:aCols[2]:bOrder := bORDER2 // EVAL(bORDER2) will be executed with parameter array oBrw:aRow
     //oBrw:aCols[2]:bOrder := {|x|UPPER(TRIM(x[2])+TRIM(x[1]))}
     oBrw:aCols[3]:bOrder := bORDER3 // EVAL(bORDER3) will be executed with parameter array oBrw:aRow
     oBrw:aCols[4]:bOrder := {|x|UPPER(TRIM(x[4]))+EVAL(bORDER3,x)}     // In DBF no Index , here on CITY + STREET (Alfabetic , no numbers or space)
     oBrw:aCols[5]:bOrder := {|x|UPPER(TRIM(x[5])+TRIM(x[4]))}              // In DBF no Index , here on STATE + CITY
     oBrw:aCols[8]:bOrder := {|x|cValToChar( x[8]) +STR(ATAIL(x)) }     // Recno added to make unique
     oBrw:aCols[11]:bOrder := {|x|VAL(CharOnly("1234567890",TRIM(x[11])))}              // In DBF no Index , here on NOTES , only numbers , record number !
     @ 360 , 100 SAY oBrw:oSeek PROMPT oBrw:cSeek OF oDlg PIXEL BORDER SIZE 100,12//SHADED
     oBrw:bSeek := { | c | MySeekOnArray( oBrw, oBrw:aArrayData, c ) }
     ACTIVATE DIALOG oDlg ON INIT (oBrw:aCols[1]:cOrder:="D",oBrw:aCols[1]:SortArrayData() , oBrw:SetFocus())
RETURN NIL
********************************************************************************************
STATIC FUNCTION DbfSortSeek()
******************************
     local oBrw, oCol
     local Arr[0] , i , oSay
     OrdSetFocus("First")
     DEFINE DIALOG oDlg TITLE "Auto Sort and seek in DBF" SIZE 1200,800 PIXEL//MDICHILD OF oWnd
     GO BOTTOM
     @ 0, 0 XBROWSE oBrw OF oDlg ALIAS "Customer" AUTOCOLS AUTOSORT SIZE 600,350 PIXEL
     oBrw:CreateFromCode()
     @ 360 , 100 SAY oBrw:oSeek PROMPT oBrw:cSeek OF oDlg PIXEL BORDER SIZE 100,12  // SIZE MUST BE SPECIFIED , LEN(oBrw:cSeek) = 0 , oSay isn't showed without size
     oBrw:bSeek := { | c | DbSeek(UPPER(c)) }       // needed to upperseek (FWH 8.10) !
     ACTIVATE DIALOG oDlg ON INIT ( oBrw:SetFocus())

RETURN NIL
*********************************************************************************************
FUNCTION READREC()
******************
LOCAL aField[fCount()]
LOCAL i
FOR i := 1 TO fCount()
    aField[i] := FieldGet(i)
NEXT
AADD(aField,Recno())
RETURN aField
***********************************************************************************************
INIT PROC InitXbrow()
     OVERRIDE METHOD SortArrayData IN CLASS TXBrwColumn WITH MySortArray // ClasTSCom7
     EXTEND CLASS TXBrwColumn WITH DATA bOrder
RETURN
*****************************************************************
FUNCTION MySortArray()//    CLASS TXBrwColumn
**********************
 LOCAL Self := HB_QSelf()
    local aCols
     local cOrder
     local nAt, nFor, nLen
     local uSave, cType
     # ifdef FRANKDEMONT
     local bOrder
     # endif
     aCols  := ::oBrw:aCols
     cOrder := ::cOrder
     nLen       := Len( aCols )
     nAt        := If( ValType( ::cSortOrder ) == 'N', ::cSortOrder, ::nArrayCol )
     if Len( ::oBrw:aArrayData ) > 0
            cType               := ValType( ::oBrw:aArrayData[ 1 ] )
            if cType == 'A'
                 if ValType( nAt ) == 'N' .and. nAt > 0 .and. nAt <= nLen
                        for nFor := 1 to nLen
                             if aCols[ nFor ]:nArrayCol != ::nArrayCol
                                    aCols[ nFor ]:cOrder := ""
                             endif
                        next
                        # ifdef FRANKDEMONT
                        uSave := IIF(Isnil(::bOrder) , ::oBrw:aArrayData[ ::oBrw:nArrayAt ][ ::nArrayCol ] , ;
                                                                                     EVAL(::bOrder, ::oBrw:aArrayData[::oBrw:nArrayAt] ) )
                        if cOrder == 'A'
                            IF ::bOrder = nil
                                bOrder := {|x,y| x[ nAt ] > y[ nAt ] }
                            ELSE
                                bOrder := {|x,y| EVAL(::bOrder,x) > EVAL(::bOrder,y) }
                            ENDIF
                             ::cOrder           := 'D'
                        else
                            IF ::bOrder = nil
                                bOrder := {|x,y| x[ nAt ] < y[ nAt ] }
                            ELSE
                                bOrder := {|x,y| EVAL(::bOrder,x) < EVAL(::bOrder,y) }
                            ENDIF
                             ::cOrder           := 'A'
                        endif
                        //uSave      :=  //::oBrw:aArrayData[ ::oBrw:nArrayAt ][ ::nArrayCol ]
                        ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, bOrder)
                        IF ::bOrder = nil
                            ::oBrw:nArrayAt     := AScan( ::oBrw:aArrayData, { |a| a[ ::nArrayCol ] == uSave } )
                        ELSE
                            ::oBrw:nArrayAt     := AScan( ::oBrw:aArrayData, { |a| EVAL(::bOrder,a) == uSave } )
                        END
                        # else
                        uSave        := ::oBrw:aArrayData[ ::oBrw:nArrayAt ][ ::nArrayCol ]
                        if cOrder == 'A'
                             ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, {|x,y| x[ nAt ] > y[ nAt ] } )
                             ::cOrder           := 'D'
                        else
                             ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, {|x,y| x[ nAt ] < y[ nAt ] } )
                             ::cOrder           := 'A'
                        endif
                        ::oBrw:nArrayAt     := AScan( ::oBrw:aArrayData, { |a| a[ ::nArrayCol ] == uSave } )
                        # endif
                        ::oBrw:Refresh()
                     endif
            elseif cType $ 'CDLN'
                 if ! Empty( cOrder )
                        uSave        := ::oBrw:aArrayData[ ::oBrw:nArrayAt ]
                        if cOrder == 'A'
                             ::oBrw:aArrayData := ASort( ::oBrw:aArrayData,,,{|x,y| cValToChar( x ) > cValToChar( y ) } )
                             ::cOrder := 'D'
                        else
                             ::oBrw:aArrayData := ASort( ::oBrw:aArrayData,,,{|x,y| cValToChar( x ) < cValToChar( y ) } )
                             ::cOrder := 'A'
                        endif
                        ::oBrw:nArrayAt          := AScan( ::oBrw:aArrayData, uSave )
                        ::oBrw:Refresh()
                 endif
            endif
     endif
return self
//----------------------------------------------------------------------------//
FUNCTION MySeekOnArray( Self, aData, cSeek )
*******************************************
     local aCols
     local nAt, nFor, nLen
     local lExact
     aCols  := ::aCols
     nLen       := len( aCols )
     cSeek  := Upper( cSeek )
     for nFor := 1 to nLen
            if !( aCols[ nFor ]:cOrder == "" )
                 lExact := Set( _SET_EXACT, .f. )
                 # ifdef FRANKDEMONT
                 IF IsBlock(aCols[ nFor ]:bOrder )
                    nAt      := Ascan( aData, {|v| cValToChar(EVAL( aCols[ nFor ]:bOrder    , v  ))  = cSeek } )
                 ELSE
                    nAt      := Ascan( aData, {|v| Upper( cValToChar( v[ aCols[ nFor ]:nCreationOrder    ] ) ) = cSeek } )
                 END
                 # else
                 nAt        := Ascan( aData, {|v| Upper( cValToChar( v[ nFor ] ) ) = cSeek } )
                 # endif
                 Set( _SET_EXACT, lExact )
                 if nAt > 0
                        ::nArrayAt := nAt
                        return .t.
                 endif
            endif
     next
return .f.