Posts: 15
Joined: Wed May 03, 2006 02:05 PM
Re: Ordenar matriz multidimensiuonal
Posted: Sat Jun 19, 2010 05:13 AM
Que bueno que te sirvio, la forma como defines los arreglos es como lo vengo trabajando de hace mucho tiempo
aqui te dejo una clase que te puede servir mucho, esto manipula los arreglos como si fuera una tabla/dbf
saludos
Francisco N.
Function TestArray()
Local oDatos
oDatos := tArray():New(5) // ARREGLO DE CINCO COLUMNAS
oDatos:Headers({"codigo","nombre","direccion","direccion_larga"})
oDatos:Append()
oDatos:codigo := "0010"
oDatos:nombre := "JUAN PEREZ"
oDatos:direccion := "AV. TUPAC"
oDatos:direccion_larga := "AV. TUPAC .............."
oDatos:Append()
oDatos:codigo := "0020"
oDatos:nombre := "ANDRES"
oDatos:direccion := "JR. CALLAO"
oDatos:direccion_larga := "JR. CALLAO .............."
oDatos:Append()
oDatos:codigo := "0005"
oDatos:nombre := "PEDRO PEREZ"
oDatos:direccion := "JR. CALLAO"
oDatos:direccion_larga := "JR. CALLAO ..................."
oDatos:SORT("CODIGO") // ordenando por codigo
cReg := ""
oDatos:GoTop()
Do While !oDatos:Eof()
cReg += oDatos:codigo+" "+;
oDatos:nombre+" "+;
oDatos:direccion+" "+;
oDatos:direccion_larga + CHR(13)+CHR(10)
oDatos:Skip()
Enddo
MsgInfo( cReg , "ORDENADO POR CODIGO" )
oDatos:SORT("nombre") // ordenando por nombre
cReg := ""
oDatos:GoTop()
Do While !oDatos:Eof()
cReg += oDatos:codigo+" "+;
oDatos:nombre+" "+;
oDatos:direccion+" "+;
oDatos:direccion_larga + CHR(13)+CHR(10)
oDatos:Skip()
Enddo
MsgInfo( cReg , "ORDENADO POR NOMBRE" )
Return Nil
//----------------------------------------------------------------------------//
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
CLASS TArray
DATA aData AS ARRAY
DATA nAt
DATA lHeaders,aFldNames
DATA lEof,lBof
METHOD New() CONSTRUCTOR
METHOD Sort( nCol )
METHOD GoTop() INLINE ::nAt := 1,::Skip(0)
METHOD GoBottom() INLINE ::nAt := ::LastRec(),::Skip(0)
METHOD Skip(nWant,nOld) INLINE nWant := If(nWant=Nil,1,nWant),;
nOld := ::nAt, ::nAt += nWant,;
::= ::nAt>::LastRec(),;
::= ::nAt<::LastRec(),;
::nAt := Max( 1, Min(::nAt,::LastRec()) ),;
::nAt - nOld
METHOD Eof() INLINE ::lEof
METHOD Recno() INLINE ::nAt
METHOD LastRec() INLINE Len(::aData[1])
METHOD GoTo( nRecno ) INLINE ::nAt:=nRecno,::Skip(0)
METHOD Append()
METHOD fCount() INLINE Len(::aData)
METHOD Headers(aHeaders)
METHOD FieldName( nField ) INLINE ::aFldNames[ nField ]
METHOD FieldPos( cFieldName )
MESSAGE FieldPut METHOD _FieldPut( nField, uVal )
MESSAGE FieldGet METHOD _FieldGet( nField )
ERROR HANDLER OnError( uParam1 )
ENDCLASS
//---------------------------------------------------------------------------//
METHOD New(nCol) CLASS tArray
Local m
::nAt:= 0
::aFldNames:={}
::lHeaders := .f.
If ValType(nCol)="A"
::aData := nCol
Else
::aData :={}
For m=1 To nCol
Aadd( ::aData,{})
Next
EndIf
Return Self
*----------------------------------------------------------------------------*
METHOD Sort(nCol,_AD) CLASS tArray //a=Arreglo , n1=Columna , AD='A'Asc.'D'Desc.
Local aDataAux,_n,_m,_x,bCondicion
If ValType(nCol)="C"
nCol := ::FieldPos(nCol)
EndIf
nCol:=If(nCol=Nil,1,nCol)
_AD :=If(_AD =Nil,"A",_AD)
If ValType(_AD)=[B]
bCondicion:=_AD
Else
bCondicion:={||If(_AD='A',::aData[nCol,_n]>::aData[nCol,_m],::aData[nCol,_n]<::aData[nCol,_m])}
Endif
For _n=1 To Len(::aData[1])
For _m=_n+1 To Len(::aData[1])
If Eval(bCondicion,_n,_m)
For _x=1 To Len(::aData)
aDataAux:=::aData[_x,_n] ; ::aData[_x,_n]:=::aData[_x,_m] ; ::aData[_x,_m]:=aDataAux
Next
Endif
Next
Next
::GoTop()
Return 0
*----------------------------------------------------------------------------*
METHOD OnError( uParam1 ) CLASS TArray
Local cMsg := __GetMessage()
Local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
Local nField
If SubStr( cMsg, 1, 1 ) == "_"
if( ( nField := ::FieldPos( SubStr( cMsg, 2 ) ) ) != 0 )
::FieldPut( nField, uParam1 )
else
_ClsSetError( _GenError( nError, ::ClassName(), SubStr( cMsg, 2 ) ) )
endif
Else
if( ( nField := ::FieldPos( cMsg ) ) != 0 )
return ::FieldGet( nField )
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
endif
Endif
Return nil
//----------------------------------------------------------------------------//
METHOD _FieldPut( nPos, uValue ) CLASS tArray
::aData[nPos,::nAt] := uValue
Return nil
//----------------------------------------------------------------------------//
METHOD _FieldGet( nPos ) CLASS TArray
If nPos=0
MsgInfo( "Objeto Variable, "+::aFldNames[ nPos ]+", No Inicializada"+Chr(13)+;
" Called from " + Trim( ProcName( 3 ) ) + ;
"(" + Str( ProcLine( 3 ),5 ) + ")" )
Endif
Return ::aData[nPos,::nAt]
//----------------------------------------------------------------------------//
METHOD FieldPos( cFieldName,uValor ) CLASS TArray
Local nInd:=Ascan(::aFldNames,cFieldName )
If (nInd:=Ascan(::aFldNames,( cFieldName:=Upper(AllTrim(cFieldName)) )))=0
Alert("No Existe, "+cFieldName)
Return 0
Else
Return nInd
Endif
Return Nil
//----------------------------------------------------------------------------//
METHOD Append() CLASS TArray
Local nCol:=0
aEval(Array(::fCount()),{|| nCol++,Aadd(::aData[nCol],0) })
::GoBottom()
Return Nil
//----------------------------------------------------------------------------//
METHOD Headers(aHeaders) CLASS TArray
::aFldNames := {}
aEval(aHeaders,{|x| AAdd( ::aFldNames,Upper(x) ) })
::lHeaders := .t.
Return Nil
//----------------------------------------------------------------------------//