Xbrowse array autosort and seek with secundury keys
Posted: Sun Feb 13, 2011 10:15 am
Hello,
A few days ago i asked how we can sort in a array with a secundary key (i.e. column 1 + column 2). Answer from nages : oCol:cSortOrder := { |oCol| <yourfunction> }
It works very good , but i try to have the same result when using a dbf with an index like PAD(UPPER(Trim(first) + trim(Last)),20) . Using the seek method we can enter the characters from first AND last to seek the record.
So i had to add some features to xbrowse to handle secundary keys in autoorder and seek.
EXTEND CLASS TXBrwColumn WITH DATA bOrder
After defining the browse :
oBrw:aCols[1]:bOrder := {|x|UPPER(TRIM(x[1])+TRIM(x[2]))}
There are a few changes in SortArrayData (aSort(oBrw:aArrayData,.....) and in SeekOnArray (nAt := ASCAN(aData , .....)
Here some code to test :
#include "FiveWin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
# include "common.ch"
static oWnd
//----------------------------------------------------------------------------//
function Main()
SET _3DLOOK ON
REQUEST DBFCDX
rddsetdefault( "DBFCDX" )
USE CUSTOMER NEW
INDEX ON PAD(UPPER(TRIM(First))+UPPER(TRIM(Last)),20) TAG First //TO Cust
INDEX ON PAD(UPPER(TRIM(Last))+UPPER(TRIM(First)),20) TAG Last //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 ;
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[2]:bOrder := {|x|UPPER(TRIM(x[2])+TRIM(x[1]))}
oBrw:aCols[1]:bOrder := {|x|UPPER(TRIM(x[1])+TRIM(x[2]))}
@ 360 , 100 SAY oSay PROMPT " test " OF oDlg PIXEL BORDER //SHADED
oBrw:oSeek := oSay
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()
FOR EACH oCol IN oBrw:aCols
i := Hb_EnumIndex()
oCol:cHeader := FieldName(i)
NEXT
@ 360 , 100 SAY oSay PROMPT "cSeek" OF oDlg PIXEL BORDER //SHADED
oBrw:oSeek := oSay
oBrw:bSeek := { | c | DbSeek(UPPER(c)) }
ACTIVATE DIALOG oDlg ON INIT ( oBrw:SetFocus())
RETURN NIL
*********************************************************************************************
FUNCTION READREC()
******************
LOCAL aField[fCount()]
LOCAL i
FOR i := 1 TO fCount()
aField := 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
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 )
# 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
# endif
::oBrw:nArrayAt := AScan( ::oBrw:aArrayData, { |a| a[ ::nArrayCol ] == uSave } )
::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| 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.
A few days ago i asked how we can sort in a array with a secundary key (i.e. column 1 + column 2). Answer from nages : oCol:cSortOrder := { |oCol| <yourfunction> }
It works very good , but i try to have the same result when using a dbf with an index like PAD(UPPER(Trim(first) + trim(Last)),20) . Using the seek method we can enter the characters from first AND last to seek the record.
So i had to add some features to xbrowse to handle secundary keys in autoorder and seek.
EXTEND CLASS TXBrwColumn WITH DATA bOrder
After defining the browse :
oBrw:aCols[1]:bOrder := {|x|UPPER(TRIM(x[1])+TRIM(x[2]))}
There are a few changes in SortArrayData (aSort(oBrw:aArrayData,.....) and in SeekOnArray (nAt := ASCAN(aData , .....)
Here some code to test :
#include "FiveWin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
# include "common.ch"
static oWnd
//----------------------------------------------------------------------------//
function Main()
SET _3DLOOK ON
REQUEST DBFCDX
rddsetdefault( "DBFCDX" )
USE CUSTOMER NEW
INDEX ON PAD(UPPER(TRIM(First))+UPPER(TRIM(Last)),20) TAG First //TO Cust
INDEX ON PAD(UPPER(TRIM(Last))+UPPER(TRIM(First)),20) TAG Last //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 ;
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[2]:bOrder := {|x|UPPER(TRIM(x[2])+TRIM(x[1]))}
oBrw:aCols[1]:bOrder := {|x|UPPER(TRIM(x[1])+TRIM(x[2]))}
@ 360 , 100 SAY oSay PROMPT " test " OF oDlg PIXEL BORDER //SHADED
oBrw:oSeek := oSay
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()
FOR EACH oCol IN oBrw:aCols
i := Hb_EnumIndex()
oCol:cHeader := FieldName(i)
NEXT
@ 360 , 100 SAY oSay PROMPT "cSeek" OF oDlg PIXEL BORDER //SHADED
oBrw:oSeek := oSay
oBrw:bSeek := { | c | DbSeek(UPPER(c)) }
ACTIVATE DIALOG oDlg ON INIT ( oBrw:SetFocus())
RETURN NIL
*********************************************************************************************
FUNCTION READREC()
******************
LOCAL aField[fCount()]
LOCAL i
FOR i := 1 TO fCount()
aField := 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
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 )
# 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
# endif
::oBrw:nArrayAt := AScan( ::oBrw:aArrayData, { |a| a[ ::nArrayCol ] == uSave } )
::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| 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.