Xbrowse array autosort and seek with secundury keys

Post Reply
Frank Demont
Posts: 142
Joined: Sun Oct 09, 2005 10:59 am

Xbrowse array autosort and seek with secundury keys

Post by Frank Demont »

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.

User avatar
nageswaragunupudi
Posts: 8017
Joined: Sun Nov 19, 2006 5:22 am
Location: India
Contact:

Re: Xbrowse array autosort and seek with secundury keys

Post by nageswaragunupudi »

Nice.

But would you mind if I post more simplified code? I think we can achieve all this without overriding the xbrowse. ( I assume you are using fwh10.8 or later preferably)

Now first browsing DBF:
We assume you already created the indexes as indicated in your sample: Here is the browse code only:

Code: Select all

STATIC FUNCTION DbfSortSeek()

local oBrw, /* oCol */ oDlg
//  local Arr[0] , i , oSay  // not needed

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()
/*
commented out since these headers are assigned by default by xbrowse:

FOR EACH oCol IN oBrw:aCols
i := Hb_EnumIndex()
oCol:cHeader := FieldName(i)
NEXT
*/

@ 360 , 100 SAY /*oSay*/ oBrw:oSeek PROMPT /*"cSeek"*/ oBrw:cSeek OF oDlg PIXEL BORDER //SHADED
// oBrw:oSeek := oSay // not needed
// oBrw:bSeek := { | c | DbSeek(UPPER(c)) } // not needed. XBrowse's default bSeek works as required by us
ACTIVATE DIALOG oDlg ON INIT ( oBrw:SetFocus())

RETURN NIL
Regards

G. N. Rao.
Hyderabad, India
Frank Demont
Posts: 142
Joined: Sun Oct 09, 2005 10:59 am

Re: Xbrowse array autosort and seek with secundury keys

Post by Frank Demont »

Thank you for the answer and the sugestions , i learned again something new. Browse a dbf on a index is not a problem , the problem is that i try to become the same results in a array seek . The dbf example is only in the sample to compare with the array seek.

I am using 8.10 , maybe i miss some possibilty's from xbrowse in the newer versions .

When i understand it well , xbrowse sorts a array standard on bOrder := {|x,y| x[ nAt ] < y[ nAt ] } (nAt cSortOrder) . Adding bOrder as a data to TXBrwColumn makes it possible to have for each column its own order , different from the standard (i.e. using UPPER) . It can match with the index expression from a dbf .

Only change in SortArrayData is the line ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, {|x,y| x[ nAt ] < y[ nAt ] } ) , this would be
bOrder := {|x,y| EVAL(::bOrder,x) < EVAL(::bOrder,y) } ; ::oBrw:aArrayData := Asort( ::oBrw:aArrayData,,, bOrder )

I know this can be achieved as described a few days ago , but the sortorder must be folowed by SeekOnArray , which search only (with ascan) for an element from the column:

nAt := Ascan( aData, {|v| Upper( cValToChar( v[ nFor ] ) ) = cSeek } )

This line (in SeekOnArray) would change in :

nAt := Ascan( aData, {|v| EVAL( aCols[ nFor ]:bOrder , v ) = cSeek } )


When you have a better solution , without changing xbrowse , i would apreciate that very much.

P.S. Writing the thread i used "b..code../b" . I do not know why it not works. I tryed to give a working sample . Nothing is changed in the source from xbrowse.

Frank
Post Reply