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.