FiveTech Software tech support forums

by **anserkk** » Tue Dec 09, 2008 6:27 am

¿Puede alguien aquí que han utilizado TArray explicar las diferencias entre

oArray:Add()
oArray:Append()
oArray:Blank()

Otra duda es si me pueden almacenar objetos en serie utilizando TArray

Por ejemplo: oArray:Objeto:=oGet

para que pueda pasar oArray a un proceso de fuction y oGet el objeto en sí

Regards

Anser

by **Patricio Avalos Aguirre** » Tue Dec 09, 2008 1:34 pm

Hola

Revisa la clase, esta documentada..

Code: Select all Expand view: METHOD New() CONSTRUCTOR METHOD AddField( cName, uInit, uDefault ) // Aumenta un campo METHOD Eof() INLINE If( Len(::aDatos) == 0 .or. ::lEof ,.t.,.f.) // Fin de archivo METHOD Bof() INLINE If( Len(::aDatos) == 0 .or. ::lBof ,.t.,.f.) // Principio de archivo METHOD Load() // Carga el buffer METHOD Save() // Guarda el buffer METHOD Blank() // Borra el buffer method ValorVacio( uValor, nPos ) // devuelve el valor por default de uValor METHOD Skip( nRecs ) // cambia de registro nRecs registros METHOD GoTop() INLINE ::Goto( 1 ),if(valType(::bSetFilter)="B" .AND. !eval(::bSetFilter,self),::__filtrando(1),) // va al inicio del arreglo METHOD GoTo(nRecGoto) // cambia al registro nRecGoto METHOD GoBottom() INLINE ::Goto( Len(::aDatos) ),if(valType(::bSetFilter)="B" .AND. !eval(::bSetFilter,self),::skip(-1),) // va al final del registro METHOD Append( nPosRecNo ) // aumenta un registro en nPosRecNo, si no se envía, se aumenta al final METHOD Add( nPos ) // Graba los datos del buffer en nPos, si no se envía se agregan al final del arreglo MESSAGE Delete() METHOD _Delete( nPosRecNo ) // borra el registro nPosRecNo, si no se envía borra ::recNo() METHOD RecNo() INLINE ::nRecNo // devuelve el registro actual METHOD LastRec() INLINE Len(::aDatos) // devuelve el número total de registros METHOD Zap() INLINE ::nRecNo:= 0,::aDatos:={}, ::Blank() // borra todos los datos de la matriz METHOD Sort( cnField, lAscendente, nIni, nNro ) // ordena la matriz de acuerdo al campo cnField METHOD Seek( uClave, cnField, lSoft ) // busca un valor en un campo. lSoft=.t.para búsqueda blanda. Por defecto es falso: busqueda exacta message fieldPos method _fieldPos( cField ) // devuelve la posición del campo cField method fieldName( nField ) inline ::aFields[nField] // devuelve el nombre del camopo nField method aEval( bBloque, nInicio, nElementos ) inline aEval( ::aBuffer, bBloque, nInicio, nElementos ) // realiza un aEval con el buffer message dbEval method _dbEval( bBloque, bFor, bWhile, nNext, nRecord, lRest ) // realiza un aEval a toda la matriz con las mismas caracteristicas que el dbEval de clipper method dbResize( cField, nRecord ) // ajusta el campo cField de todos los registros a un mismo tamaño si es matriz u objeto tArray, toma el tamaño del registro nRecord o el último si este no se envia method sortFields( lDesen ) // ordena los campos del objeto method dbSortField( cField , lDesen ) // ordena los campos del objeto tArray del campo cField a toda la matriz method field2array(caField) // devuelve un campo en una matriz, o una matriz donde cada elemento es una matriz de los campos seleccionados method setFilter(bSetFilter) inline ::bSetFilter:=bSetFilter // define un filtro para los registros method __filtrando(nRecs)

by **anserkk** » Tue Dec 09, 2008 1:44 pm

Thank you Patricio,

He encontrado que TArray objetos FieldNames / nombres de columna de longitud no puede ser más de 9 caracteres

Por ejemplo:

oArray: TestColumn / / Da un error
oArray: TestColum / / Obras

¿Alguien sabe acerca de la condición de TPublic ?

Anser

Saludos

Anser

by **anserkk** » Wed Dec 10, 2008 9:42 am

I necesidad de utilizar la clase TArray en mi aplicación, pero estoy frente a un problema con la longitud de la matriz de nombre de elemento.

He encontrado que TArray objetos FieldNames duración de los nombres de columna no puede ser más de 9 caracteres

Por ejemplo:

oArray: TestColumn / / Dar un error (más de 9)
oArray: TestColum / / Obras (menos de 9)

¿Hay algún trabajo en torno a este problema o estoy usando antiguas TArray clase?

¿Hay alguna nueva versión de TArray disponibles que no tienen este carácter 9 nombre limitación?

Cualquier ayuda? He encontrado esta clase muy útil para la gestión de conjunto.

Gracias

Anser

by **Patricio Avalos Aguirre** » Wed Dec 10, 2008 2:14 pm

Es efectivamente el problema, pero puede ser algo de xharbour el error

ya que el ejemplo el nombre de variable existe

Code: Select all Expand view: #include "TArray.ch" Function _Main() LOCAL oInfo DEFINE STRUCT oInfo STRUCT FIELD dDesde INIT Date() STRUCT FIELD dHasta INIT Date() STRUCT FIELD dHastaprimerofinal INIT Date() END STRUCT Alert( oInfo:dHastaprimerofinal ) //funciona sin ningun problema oInfo:dHastaprimerofinal += 10 //Error description: Error /0 CLASE TArray Campo DHASTAPRIMEROFINAL Inexistente. return Nil

by **Antonio Linares** » Wed Dec 10, 2008 3:08 pm

Anser,

Por favor copia aqui el codigo de la clase TArray para que la revisemos y podamos ayudar, gracias

by **Patricio Avalos Aguirre** » Wed Dec 10, 2008 4:15 pm

archivo tArray.prg

Code: Select all Expand view: #include "objects.ch" #include "fivewin.ch" //----------------------------------------------------------------------------// // TArray: by Hernan Diego Ceccarelli - hceccarelli@cesotech.com.ar // Lenguaje: CA-Clipper/[x]Harbour [+ FiveWin / FiveWin for [x]Harbour] // Fecha: 01/05/1999 // Modificaciones: // Agosto 2000 por Enrique Guerra (Quique) quique@quiquesoft.com // Permite anidar objetos TArray ( utilizar objetos TArray como si // fueran campos // El valor lógico para vacío es .F. // Se agregó un método FieldPos() para que devuelva la posición del // campo como los DBF // Se agreguó el método aEval() el cual hace un simple aEval a ::aBuffer // Se agreguó el método dbEval() el cual funciona parecido al dbeval en // los DBF, pero en este caso es para ::aDatos // El comando STRUCT Field acepta nombres de campos o variables // STRUCT Field nombre => agrega el campo nombre // STRUCT Field ( cNombre ) => agrega el campo con el nombre que // contenga cNombre // Se modificó la función valorVacio para que por DEFAULT revise: // si el valor es una matriz, vacía los elementos de la matriz // si es un objeto TArray vacía el objeto (obj:zap()) // los valores no contemplados (nil, codeblocks, objetos) devuelven // el mismo valor que tienen, no una cadena vacía (nil, codeblocks, // objetos) // Se modificó el método append para que borre el buffer, de forma // parecida a la del append de las DBF devuelven valores vacíos, para // esto, también modifiqué el método add() para que siguiera // funcionando igual, ya que se puede utilizar el metodo add() para // agregar un registro sin borrar el buffer // Se agregó el método dbResize(), el cual sirve si se tiene un campo // que contenga un objeto TArray o un array, y durante el transcurso // del programa se aumentan o se eliminan campos o elementos en // algunos registros, lo que hace es que todoslos registros tengan // ese campo con el mismo tamaño (mismo número de elementos ) // Se agregó el método SortFields() el cual ordena todos los campos en // orden ascendente o descendente, tomando como base los nombres de // los campos // Los métodos Sort() y seek() también se puede enviar el nombre del campo // en lugar del número (ojo, estos son los únicos métodos que lo permite, // todos los métodos que se agregaron únicamente permiten el nombre // no el número del campo, pero esto es muy fácil de solucionar en caso // de que así se necesite) // Se puede indicar el el valor que se quiere utilizar en cada campo como // valor vacio, por si no se quieren utilizar los valores por defaul, // en caso de que se envíe el valor vacio y no el valor inicial, // tomará el valor vacío como valor inical // STRUCT Field fecha INIT date() DEFAULT ctod("01/01/2000") // En este ejemplo, el campo fecha va a tener el valor de date(), // pero para cada registro nuevo, va a tener ctod("01/01/2000") // El método load borra el buffer si se encuentra en un registro mayor // al total de registros, como en el caso de eof() en los DBF // Si se hace un oArray:goto(0) envía a eof() como en los DBF // 02/Nov/00 - quique@quiquesoft.com // Se aumentó la opción de cargar un el objeto desde un DBF desde el // si en el comando el valor de la clausula INIT es un álias // DEFINE STRUCT oArray INIT "archivo" // **OJO** va entre comillas // 09/Nov/00 - quique@quiquesoft.com // se aumento el método SetFilter // 10/Nov/00 - quique@quiquesoft.com // se aumento que los codeblocks FOR y WHILE del método dbEval() // recibieran como parámetro Self // 19/Feb/01 - Por Ing. Mario González - mgonzalez@ing.unne.edu.ar // Se introdujo capacidad de busqueda blanda en el método // Seek( uClave, cnField, lSoft) // Por defecto lSoft es FALSO (búsqueda exacta ) // 29/Sep/04 - Hernan Diego Ceccarelli hceccarelli@cesotech.com.ar // Adaptacion a motor de objetos Harbour/xHarbour //----------------------------------------------------------------------------// STATIC oTArrayTmp := {} //----------------------------------------------------------------------------// function __StructNew( aInit ) local nLen:= Len( oTArrayTmp ), oArray:= TArray():New() aAdd(oTArrayTmp,{oArray,.F.}) if ValType( aInit )$"NC" .and. Select(aInit) > 0 aTail(oTArrayTmp)[2]:=.T. aEval((aInit)->(dbStruct()),{|x|oArray:addField(x[1])}) endif if aInit != Nil oArray:aDatos:= aInit endif if nLen > 0 oTArrayTmp[nLen,1]:aBuffer[Len(oTArrayTmp[nLen,1]:aBuffer)]:= oArray endif return oArray //----------------------------------------------------------------------------// function __StructField(cName,uInit,uDefault) oTArrayTmp[Len(oTArrayTmp),1]:AddField(cName,uInit,uDefault) return .T. //----------------------------------------------------------------------------// function __StructEnd() local oArray,nCampos,cAlias,aMatriz if aTail(oTArrayTmp)[2] oArray := aTail(oTArrayTmp)[1] cAlias := oArray:aDatos nCampos := (cAlias)->(fCount()) oArray:aDatos := {} (cAlias)->(dbEval({||aMatriz:={},aAdd(oArray:aDatos,aMatriz),; aEval(oArray:aBuffer,{|x,y|aAdd(aMatriz,FieldGet(y))},1,nCampos),; aEval(oArray:aBuffer,{|x,y|aAdd(aMatriz,oArray:aDefault[y])},nCampos+1)})) oArray:goTop() endif return aSize(oTArrayTmp,len(oTArrayTmp)-1) //----------------------------------------------------------------------------// CLASS TArray DATA aDatos // Matriz real de datos DATA aBuffer // Según cantidad de Datos DATA aDEFAULT // valores por DEFAULT para cada campo DATA aFields // Nombres de los campos data bSetFilter // Codeblock que indica el filtro para los registros DATA nRecNo INIT 1 // Número del registro DATA lBof INIT .T. // Inicio de archivo DATA lCheckMayuscula INIT .T. DATA lEof INIT .T. // Fin de archivo METHOD New() CONSTRUCTOR METHOD AddField( cName, uInit, uDEFAULT ) // Aumenta un campo METHOD Eof() INLINE If( Len(::aDatos) == 0 .or. ::lEof ,.T.,.F.) // Fin de archivo METHOD Bof() INLINE If( Len(::aDatos) == 0 .or. ::lBof ,.T.,.F.) // Principio de archivo METHOD Load() // Carga el buffer METHOD Save() // Guarda el buffer METHOD Blank() // Borra el buffer METHOD ValorVacio( uValor, nPos ) // devuelve el valor por DEFAULT de uValor METHOD Skip( nRecs ) // cambia de registro nRecs registros METHOD GoTop() INLINE ::Goto( 1 ), if(ValType(::bSetFilter)="B" .and. !Eval(::bSetFilter,Self),::SkipFilter(1),) // va al inicio del arreglo METHOD GoTo(nRecGoto) // cambia al registro nRecGoto METHOD GoBottom() INLINE ::Goto( Len(::aDatos) ),if(ValType(::bSetFilter)="B" .and. !Eval(::bSetFilter,Self),::Skip(-1),) // va al final del registro METHOD Append( nPosRecNo ) // aumenta un registro en nPosRecNo, si no se envía, se aumenta al final METHOD Add( nPos ) // Graba los datos del buffer en nPos, si no se envía se agregan al final del arreglo MESSAGE Delete() METHOD _Delete( nPosRecNo ) // borra el registro nPosRecNo, si no se envía borra ::RecNo() METHOD RecNo() INLINE ::nRecNo // devuelve el registro actual METHOD LastRec() INLINE Len(::aDatos) // devuelve el número total de registros METHOD Zap() INLINE ::nRecNo:= 0,::aDatos:={}, ::Blank() // borra todos los datos de la matriz METHOD Sort( cnField, lAscendente, nIni, nNro ) // ordena la matriz de acuerdo al campo cnField METHOD Seek( uClave, cnField, lSoft ) // busca un valor en un campo. lSoft=.T.para búsqueda blanda. Por defecto es falso: busqueda exacta MESSAGE FieldPos METHOD _FieldPos( cField ) // devuelve la posición del campo cField METHOD FieldName( nField ) INLINE ::aFields[nField] // devuelve el nombre del camopo nField METHOD aEval( bBloque, nInicio, nElementos ) INLINE aEval( ::aBuffer, bBloque, nInicio, nElementos ) // realiza un aEval con el buffer METHOD dbResize( cField, nRecord ) // ajusta el campo cField de todos los registros a un mismo tamaño si es matriz u objeto TArray, toma el tamaño del registro nRecord o el último si este no se envia METHOD SortFields( lDesen ) // ordena los campos del objeto METHOD dbSortField( cField , lDesen ) // ordena los campos del objeto TArray del campo cField a toda la matriz METHOD Field2Array(caField) // devuelve un campo en una matriz, o una matriz donde cada elemento es una matriz de los campos seleccionados METHOD SetFilter(bSetFilter) INLINE ::bSetFilter:=bSetFilter // define un filtro para los registros METHOD SkipFilter( nRecs ) METHOD IsField( cField ) INLINE ( aScan( ::aFields, Upper(AllTrim(cField)) ) > 0 ) METHOD FieldPos( cField ) INLINE aScan( ::aFields, Upper(AllTrim(cField)) ) METHOD FieldGet( nField ) INLINE if( ::LastRec()>0, ::aDatos[::RecNo(),nField], ::aDefault[nField] ) METHOD FieldGetByName( cField ) INLINE ::FieldGet( ::FieldPos( cField ) ) METHOD FieldPut( nField, uVal ) INLINE if( ::LastRec()>0, ::aDatos[::RecNo(), nField]:= uVal, ) METHOD FieldPutByName( cField, uVal ) INLINE ::FieldPut( ::FieldPos( cField ), uVal ) MESSAGE dbEval METHOD _dbEval( bBloque, bFor, bWhile, nNext, nRecord, lRest ) // realiza un aEval a toda la matriz con las mismas caracteristicas que el dbEval de clipper ERROR HANDLER ArrayErrorHand() ENDCLASS //----------------------------------------------------------------------------// METHOD New() CLASS TArray ::aDatos := {} /// Matriz real de datos ::aFields:= {} /// ::aBuffer:= {} /// Seg£n cantidad de Datos ::aDefault:={} return Self //----------------------------------------------------------------------------// METHOD AddField( cName, uInit, uDEFAULT ) CLASS TArray Aadd( ::aFields , Upper(cName) ) Aadd( ::aBuffer , if(uInit=nil,uDefault,uInit) ) Aadd( ::aDEFAULT , uDEFAULT ) return .T. //----------------------------------------------------------------------------// METHOD Load() CLASS TArray local aDatos := ::aDatos local aBuffer:= ::aBuffer local nLen := Len ( aDatos ) local nRecNo := ::nRecNo if nLen > 0 // .or. nRecNo <= ::LastRec() nRecNo := Max( Min( nRecNo, nLen ), 1 ) ::nRecNo:= nRecNo nLen := len(aDatos[nRecNo]) if nLen<len(aBuffer) aSize(aDatos[nRecNo],len(aBuffer)) aEval(aBuffer,{|uValor,nPos|aDatos[nRecNo,nPos] := ::valorVacio(uValor,nPos)},nLen+1) endif ::aBuffer:= aClone( aDatos[nRecNo] ) Else ::Blank() endif return .T. //----------------------------------------------------------------------------// METHOD Blank() CLASS TArray local aBuffer:= ::aBuffer AEval( aBuffer, {|uValor,nPos| aBuffer[nPos]:= ::valorVacio(uValor,nPos) } ) return .T. //----------------------------------------------------------------------------// METHOD ValorVacio( uValor, nPos, aDEFAULT ) CLASS TArray local cType:= ValType( uValor ),uDev DEFAULT aDefault := ::aDefault do case case cType == 'N' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,0,aDefault[nPos]) case cType == 'D' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,CtoD(''),aDefault[nPos]) case cType == 'L' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,.F.,aDefault[nPos]) case cType == 'C' .or. cType == 'M' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,Space(Len(uValor)),aDefault[nPos]) case cType == 'A' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,aEval(aClone(uValor),{|x,y|uDev[y]:=::valorVacio( x )}),aClone(aDefault[nPos])) case cType == 'O' .and. uValor:classname() == "TArray" if nPos=nil .or. aDefault[nPos]=nil uDev:= oClone(uValor) uDev:zap() else oClone(aDefault[nPos]) endif otherwise uDev:= if(nPos=nil .or. aDefault[nPos]=nil,uValor,aDefault[nPos]) endcase return uDev //----------------------------------------------------------------------------// METHOD Save() CLASS TArray local aDatos := ::aDatos local aBuffer:= ::aBuffer local nLen := Len ( aDatos ) local nRecNo := ::nRecNo if nLen > 0 nRecNo := Max( Min( nRecNo, nLen ), 1 ) ::nRecNo:= nRecNo ::aDatos[nRecNo] := aClone(aBuffer) endif return .T. //----------------------------------------------------------------------------// METHOD Skip( nRecs ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo local nSalto := 0 DEFAULT nRecs:= 1 if nLen > 0 .and. nRecs <> 0 // SetFilter if ValType(::bSetFilter)="B" nSalto := ::SkipFilter(nRecs) else // sin SetFilter nRecNo := Max( Min( nRecNo, nLen ), 1 ) nSalto := nRecs if nRecs > 0 // Pa' delante if nRecNo + nRecs > nLen nSalto-= nRecNo + nRecs - nLen endif Else // Pa' tras if nRecNo + nRecs < 1 nSalto+= 1 - ( nRecNo + nRecs ) endif endif endif if nSalto <> 0 nRecNo+= nSalto ::nRecNo:= nRecNo ::Load() endif endif if nSalto == 0 if nRecs <> 0 if nRecs > 0 ::lEof:= .T. ::lBof:= .F. Else ::lEof:= .F. ::lBof:= .T. endif endif Else ::lEof:= .F. ::lBof:= .F. endif return nSalto //----------------------------------------------------------------------------// METHOD Goto( nRecGoto ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo if nRecGoto=0 ::nRecNo := ::LastRec()+1 ::lEof := .T. ::lBof := ::LastRec()=0 ::Blank() else nRecGoto:= Min( nLen, nRecGoto ) if nLen > 0 ::nRecNo:= nRecGoto ::Load() ::lEof:= .F. ::lBof:= .F. Else ::Blank() endif endif return .T. //----------------------------------------------------------------------------// METHOD Append( nPosRecNo ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo local aDatos := ::aDatos if nLen > 0 .and. nPosRecNo != Nil .and. nPosRecNo >= 1 nPosRecNo:= Min( nLen, nPosRecNo ) ASize( aDatos, nLen+1 ) AIns( aDatos, nPosRecNo ) ::nRecNo:= nPosRecNo aDatos[ nPosRecNo ]:= Array( Len(::aFields) ) AEval( ::aBuffer, {|uValor,nPos| aDatos[nPosRecNo,nPos]:= ::valorVacio(uValor,nPos) } ) else Aadd( aDatos, Array( Len(::aFields) ) ) nPosRecNo:= nLen + 1 ::nRecNo := nPosRecNo endif AEval( ::aBuffer, {|uValor,nPos| aDatos[nPosRecNo,nPos]:= ::valorVacio(uValor,nPos) } ) ::aBuffer := aClone( aDatos[nPosRecNo] ) ::lEof:= .F. ::lBof:= .F. return .T. //----------------------------------------------------------------------------// METHOD Add( nPos ) CLASS TArray local aBuffer:= aClone(::aBuffer) ::Append( nPos ) ::aBuffer := aBuffer ::Save() return .T. //----------------------------------------------------------------------------// METHOD _Delete( nPosRecNo ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo local aDatos := ::aDatos DEFAULT nPosRecNo:= ::nRecNo if nLen > 0 nPosRecNo:= Max( Min( nLen, nPosRecNo ), 1) ADel( aDatos, nPosRecNo ) ASize( aDatos, nLen-1 ) if nPosRecNo > nLen-1 nPosRecNo-- endif ::nRecNo:= nPosRecNo ::Load() endif return .T. //----------------------------------------------------------------------------// METHOD Sort( cnField, lAscendente, nIni, nNro ) CLASS TArray local bBlock, uValor, nPosNueva local nField:=if(ValType(cnField)="N",cnField,if(ValType(cnField)="C",::FieldPos(cnField),1)) DEFAULT nField:= 1,; lAscendente:= .T. if Len( ::aDatos ) > 0 if lAscendente bBlock:= {|x,y| x[nField] < y[nField] } Else bBlock:= {|x,y| x[nField] > y[nField] } endif uValor:= ::aDatos[::nRecNo,nField] /// Valor Donde Estaba ASort( ::aDatos, nIni, nNro, bBlock ) if ( nPosNueva:= AScan( ::aDatos, {|x| x[nField] == uValor } ) ) > 0 ::nRecNo:= nPosNueva endif endif return .T. //----------------------------------------------------------------------------// METHOD Seek( uClave, cnField, lSoft ) CLASS TArray local lEncontro:= .F. local nPosNueva:=0 local bSetFilter := if(ValType(::bSetFilter)="B",::bSetFilter,{||.T.}) DEFAULT lSoft:= .F. if(ValType(cnField)="C",cnField:=::FieldPos(cnField),) // if ( nPosNueva:= AScan( ::aDatos, {|x| x[cnField] == uClave }, nPosNueva ) ) > 0 // ::nRecNo:= nPosNueva // ::Load() // ::lEof:= .F. // ::lBof:= .F. // lEncontro:= .T. // else // ::lEof := .T. // ::nRecNo := 0 // ::blank() // endif if lSoft // Busqueda blanda do while .T. nPosNueva := AScan( ::aDatos, {|x| AllTrim( x[cnField] ) = uClave }, nPosNueva+1 ) ::Goto(nPosNueva) if nPosNueva = 0 exit elseif Eval(bSetFilter,Self) lEncontro := .T. exit endif enddo else do while .T. nPosNueva := AScan( ::aDatos, {|x| AllTrim( x[cnField] )== uClave }, nPosNueva+1 ) ::Goto(nPosNueva) if nPosNueva = 0 exit elseif Eval(bSetFilter,Self) lEncontro := .T. exit endif enddo end return lEncontro //----------------------------------------------------------------------------// METHOD _FieldPos( cField ) CLASS TArray cField := if(ValType(cField)="C",upper(cField),"") return aScan( ::aFields, {|x|x==cField} ) //----------------------------------------------------------------------------// METHOD _dbEval( bBloque, bFor, bWhile, nNext, nRecord, lRest ) CLASS TArray local nCont,nSkip:=1,bSetFilter:=if(ValType(::bSetFilter)="B",::bSetFilter,{||.T.}) DEFAULT bFor := {||.T.} DEFAULT bWhile := {||.T.} DEFAULT nNext := ::LastRec() if ValType(nRecord)="N" ::goto(nRecord) nNext := 1 nSkip := 0 elseif pCount()<4 .or. !Empty(lRest) ::GoTop() else ::Load() endif do while --nNext>=0 .and. !::eof() .and. Eval(bWhile,Self) if Eval(bFor,Self) .and. Eval(bSetFilter,Self) Eval(bBloque,Self) endif ::Skip(nSkip) enddo return nil //----------------------------------------------------------------------------// METHOD dbResize( cField, nRecord ) CLASS TArray local nCampo:=::FieldPos(cField),nTamActual,nTamNuevo,aBuffer,aFields,aDefault DEFAULT nRecord := ::LastRec() ::Goto(nRecord) if ValType(::aBuffer[nCampo])="A" nTamNuevo := len(::aBuffer[nCampo]) aEval(::aDatos,{|aReg|aBuffer:=aReg,nTamActual:=len(aReg[nCampo]),; aSize(aReg[nCampo],nTamNuevo),; aEval(aReg[nCampo],{|uValor,nPos|aBuffer[nPos]:= ::valorVacio(uValor,nPos)},nTamActual+1)}) elseif ValType(::aBuffer[nCampo])="O" .and. ::aBuffer[nCampo]:classname() == "TArray" aFields := aClone(::aBuffer[nCampo]:aFields) aDEFAULT := aClone(::aBuffer[nCampo]:aDefault) aBuffer := aClone(::aBuffer[nCampo]:aBuffer) nTamNuevo := len(aBuffer) aEval(aBuffer,{|uValor,nPos|aBuffer[nPos]:= ::valorVacio(uValor,nPos,aDefault)}) ::dbEval({|aBuf|::aBuffer[nCampo]:aFields:=aClone(aFields),; ::aBuffer[nCampo]:aDefault:=aClone(aDefault),; aBuf:=::aBuffer[nCampo]:aBuffer,nTamActual:=len(aBuf),aSize(aBuf,nTamNuevo),; aEval(aBuffer,{|uValor,nPos|::aBuffer[nCampo]:aBuffer[nPos]:= ::valorVacio(uValor,nPos,aDefault)},nTamActual+1),; ::aBuffer[nCampo]:save()}) endif ::GoTop() return nil //----------------------------------------------------------------------------// METHOD SortFields( lDesen ) CLASS TArray local aFields := aClone(::aFields),aNuevo[len(::aFields)] aSort(::aFields,,,if(Empty(lDesen),{|x,y|x<y},{|x,y|x>y})) aEval(::aFields,{|cField,nPos|aNuevo[nPos]:=aScan(aFields,cField)}) aEval(aNuevo,{|nField,nPos|aFields[nPos]:=aScan(aNuevo,nPos)}) aEval(aClone(::aDefault),{|uValor,nPos|::aDefault[aFields[nPos]]:=uValor}) if Empty(::aDatos) aEval(aClone(::aBuffer),{|uValor,nPos|::aBuffer[aFields[nPos]]:=uValor}) else ::dbEval({||aEval(aClone(::aBuffer),{|uValor,nPos|::aBuffer[aFields[nPos]]:=uValor}),::save()}) endif return nil //----------------------------------------------------------------------------// METHOD dbSortField( cField , lDesen ) CLASS TArray local nField:=::FieldPos(cField) return ::dbEval({||::aBuffer[nField]:SortFields( lDesen )}) //----------------------------------------------------------------------------// METHOD Field2Array(caField) CLASS TArray local aArray:={}, nPos if ValType(caField)="C" .and. (nPos:=::FieldPos(caField))>0 ::dbEval({||aAdd(aArray,::aBuffer[nPos])}) elseif ValType(caField)="A" aEval(caField,{|cField,nPos| aAdd( aArray[nPos],::Field2Array(cField) ) }) endif return aArray //------------------------------------------------------------------------------------- METHOD SkipFilter(nRecs) class TArray local nSalto:=0,nRecNo:=::RecNo(),bSetFilter:=::bSetFilter,nSkipFilt,nSkip DEFAULT nRecs := 1 ::bSetFilter := nil nSkipFilt := nRecs nSkip := if(nSkipFilt>0,1,-1) do while nSkipFilt<>0 ::Skip(nSkip) if ::bof() .or. ::eof() ::goto(nRecNo) exit elseif Eval(bSetFilter,Self) nSkipFilt -= nSkip nRecNo := ::nRecNo nSalto += nSkip endif enddo ::bSetFilter := bSetFilter return nSalto //------------------------------------------------------------------------------------- #ifdef __HARBOUR__ METHOD ArrayErrorHand( uParam1 ) CLASS TArray local cMetodo:= __GetMessage() local nError := If( SubStr( cMetodo, 1, 1 ) == "_", 1005, 1004 ) #else METHOD ArrayErrorHand( cMetodo, nError ) CLASS TArray local uParam1 := GetParam( 1, 1 ) #endif local lAsignacion:= .F. local nId local lExact:= Set( _SET_EXACT, .T. ) local uDev local bMetodo := {|x|x==cMetodo}, oError if SubStr( cMetodo, 1, 1 ) == '_' lAsignacion:= .T. cMetodo:= SubStr( cMetodo, 2 ) #ifndef __HARBOUR bMetodo := {|x|left(x,9)==cMetodo} #endif endif if ::lCheckMayuscula AEval( ::aFields, {|cVal,nId| ::aFields[nId]:= Upper(cVal) } ) ::lCheckMayuscula:= .F. endif if ( nId:= AScan( ::aFields, bMetodo ) ) > 0 if lAsignacion uDev:= uParam1 ::aBuffer[ nId ]:= uDev Else uDev:= ::aBuffer[ nId ] endif Else // uDev:= _ClsSetErr( _GenError( nError, ::ClassName, cMetodo ) ) oError:= ErrorNew() oError:description:= "CLASE TArray " + ; "Campo " + cMetodo + " Inexistente." uDev:= Eval( ErrorBlock(), oError ) endif Set( _SET_EXACT, lExact ) return uDev //----------------------------------------------------------------------------//

archivo tArray.CH

Code: Select all Expand view: //----------------------------------------------------------------------------// // Creando Estructuras de Datos // Arrays orientados a objetos //----------------------------------------------------------------------------// #command DEFINE STRUCT [<oTArray>] [INIT <aInit>] => ; [<oTArray>:= ]__StructNew(<aInit>) #command STRUCT FIELD <(cName)> [INIT <uInit>] [DEFAULT <uDefault>] => ; __StructField(<(cName)>,<uInit>,<uDefault> ) #command END STRUCT => __StructEnd()

by **anserkk** » Thu Dec 11, 2008 4:42 am

Estimado Mr.Antonio,

Realmente agradecemos su apoyo

TArray.prg

Code: Select all Expand view: #include "objects.ch" #include "fivewin.ch" //----------------------------------------------------------------------------// // TArray: by Hernan Diego Ceccarelli - hceccarelli@cesotech.com.ar // Lenguaje: CA-Clipper/[x]Harbour [+ FiveWin / FiveWin for [x]Harbour] // Fecha: 01/05/1999 // Modificaciones: // Agosto 2000 por Enrique Guerra (Quique) quique@quiquesoft.com // Permite anidar objetos TArray ( utilizar objetos TArray como si // fueran campos // El valor lógico para vacío es .F. // Se agregó un método FieldPos() para que devuelva la posición del // campo como los DBF // Se agreguó el método aEval() el cual hace un simple aEval a ::aBuffer // Se agreguó el método dbEval() el cual funciona parecido al dbeval en // los DBF, pero en este caso es para ::aDatos // El comando STRUCT Field acepta nombres de campos o variables // STRUCT Field nombre => agrega el campo nombre // STRUCT Field ( cNombre ) => agrega el campo con el nombre que // contenga cNombre // Se modificó la función valorVacio para que por DEFAULT revise: // si el valor es una matriz, vacía los elementos de la matriz // si es un objeto TArray vacía el objeto (obj:zap()) // los valores no contemplados (nil, codeblocks, objetos) devuelven // el mismo valor que tienen, no una cadena vacía (nil, codeblocks, // objetos) // Se modificó el método append para que borre el buffer, de forma // parecida a la del append de las DBF devuelven valores vacíos, para // esto, también modifiqué el método add() para que siguiera // funcionando igual, ya que se puede utilizar el metodo add() para // agregar un registro sin borrar el buffer // Se agregó el método dbResize(), el cual sirve si se tiene un campo // que contenga un objeto TArray o un array, y durante el transcurso // del programa se aumentan o se eliminan campos o elementos en // algunos registros, lo que hace es que todoslos registros tengan // ese campo con el mismo tamaño (mismo número de elementos ) // Se agregó el método SortFields() el cual ordena todos los campos en // orden ascendente o descendente, tomando como base los nombres de // los campos // Los métodos Sort() y seek() también se puede enviar el nombre del campo // en lugar del número (ojo, estos son los únicos métodos que lo permite, // todos los métodos que se agregaron únicamente permiten el nombre // no el número del campo, pero esto es muy fácil de solucionar en caso // de que así se necesite) // Se puede indicar el el valor que se quiere utilizar en cada campo como // valor vacio, por si no se quieren utilizar los valores por defaul, // en caso de que se envíe el valor vacio y no el valor inicial, // tomará el valor vacío como valor inical // STRUCT Field fecha INIT date() DEFAULT ctod("01/01/2000") // En este ejemplo, el campo fecha va a tener el valor de date(), // pero para cada registro nuevo, va a tener ctod("01/01/2000") // El método load borra el buffer si se encuentra en un registro mayor // al total de registros, como en el caso de eof() en los DBF // Si se hace un oArray:goto(0) envía a eof() como en los DBF // 02/Nov/00 - quique@quiquesoft.com // Se aumentó la opción de cargar un el objeto desde un DBF desde el // si en el comando el valor de la clausula INIT es un álias // DEFINE STRUCT oArray INIT "archivo" // **OJO** va entre comillas // 09/Nov/00 - quique@quiquesoft.com // se aumento el método SetFilter // 10/Nov/00 - quique@quiquesoft.com // se aumento que los codeblocks FOR y WHILE del método dbEval() // recibieran como parámetro Self // 19/Feb/01 - Por Ing. Mario González - mgonzalez@ing.unne.edu.ar // Se introdujo capacidad de busqueda blanda en el método // Seek( uClave, cnField, lSoft) // Por defecto lSoft es FALSO (búsqueda exacta ) // 29/Sep/04 - Hernan Diego Ceccarelli hceccarelli@cesotech.com.ar // Adaptacion a motor de objetos Harbour/xHarbour //----------------------------------------------------------------------------// STATIC oTArrayTmp := {} //----------------------------------------------------------------------------// function __StructNew( aInit ) local nLen:= Len( oTArrayTmp ), oArray:= TArray():New() aAdd(oTArrayTmp,{oArray,.F.}) if ValType( aInit )$"NC" .and. Select(aInit) > 0 aTail(oTArrayTmp)[2]:=.T. aEval((aInit)->(dbStruct()),{|x|oArray:addField(x[1])}) endif if aInit != Nil oArray:aDatos:= aInit endif if nLen > 0 oTArrayTmp[nLen,1]:aBuffer[Len(oTArrayTmp[nLen,1]:aBuffer)]:= oArray endif return oArray //----------------------------------------------------------------------------// function __StructField(cName,uInit,uDefault) oTArrayTmp[Len(oTArrayTmp),1]:AddField(cName,uInit,uDefault) return .T. //----------------------------------------------------------------------------// function __StructEnd() local oArray,nCampos,cAlias,aMatriz if aTail(oTArrayTmp)[2] oArray := aTail(oTArrayTmp)[1] cAlias := oArray:aDatos nCampos := (cAlias)->(fCount()) oArray:aDatos := {} (cAlias)->(dbEval({||aMatriz:={},aAdd(oArray:aDatos,aMatriz),; aEval(oArray:aBuffer,{|x,y|aAdd(aMatriz,FieldGet(y))},1,nCampos),; aEval(oArray:aBuffer,{|x,y|aAdd(aMatriz,oArray:aDefault[y])},nCampos+1)})) oArray:goTop() endif return aSize(oTArrayTmp,len(oTArrayTmp)-1) //----------------------------------------------------------------------------// CLASS TArray DATA aDatos // Matriz real de datos DATA aBuffer // Según cantidad de Datos DATA aDEFAULT // valores por DEFAULT para cada campo DATA aFields // Nombres de los campos data bSetFilter // Codeblock que indica el filtro para los registros DATA nRecNo INIT 1 // Número del registro DATA lBof INIT .T. // Inicio de archivo DATA lCheckMayuscula INIT .T. DATA lEof INIT .T. // Fin de archivo METHOD New() CONSTRUCTOR METHOD AddField( cName, uInit, uDEFAULT ) // Aumenta un campo METHOD Eof() INLINE If( Len(::aDatos) == 0 .or. ::lEof ,.T.,.F.) // Fin de archivo METHOD Bof() INLINE If( Len(::aDatos) == 0 .or. ::lBof ,.T.,.F.) // Principio de archivo METHOD Load() // Carga el buffer METHOD Save() // Guarda el buffer METHOD Blank() // Borra el buffer METHOD ValorVacio( uValor, nPos ) // devuelve el valor por DEFAULT de uValor METHOD Skip( nRecs ) // cambia de registro nRecs registros METHOD GoTop() INLINE ::Goto( 1 ), if(ValType(::bSetFilter)="B" .and. !Eval(::bSetFilter,Self),::SkipFilter(1),) // va al inicio del arreglo METHOD GoTo(nRecGoto) // cambia al registro nRecGoto METHOD GoBottom() INLINE ::Goto( Len(::aDatos) ),if(ValType(::bSetFilter)="B" .and. !Eval(::bSetFilter,Self),::Skip(-1),) // va al final del registro METHOD Append( nPosRecNo ) // aumenta un registro en nPosRecNo, si no se envía, se aumenta al final METHOD Add( nPos ) // Graba los datos del buffer en nPos, si no se envía se agregan al final del arreglo MESSAGE Delete() METHOD _Delete( nPosRecNo ) // borra el registro nPosRecNo, si no se envía borra ::RecNo() METHOD RecNo() INLINE ::nRecNo // devuelve el registro actual METHOD LastRec() INLINE Len(::aDatos) // devuelve el número total de registros METHOD Zap() INLINE ::nRecNo:= 0,::aDatos:={}, ::Blank() // borra todos los datos de la matriz METHOD Sort( cnField, lAscendente, nIni, nNro ) // ordena la matriz de acuerdo al campo cnField METHOD Seek( uClave, cnField, lSoft ) // busca un valor en un campo. lSoft=.T.para búsqueda blanda. Por defecto es falso: busqueda exacta MESSAGE FieldPos METHOD _FieldPos( cField ) // devuelve la posición del campo cField METHOD FieldName( nField ) INLINE ::aFields[nField] // devuelve el nombre del camopo nField METHOD aEval( bBloque, nInicio, nElementos ) INLINE aEval( ::aBuffer, bBloque, nInicio, nElementos ) // realiza un aEval con el buffer METHOD dbResize( cField, nRecord ) // ajusta el campo cField de todos los registros a un mismo tamaño si es matriz u objeto TArray, toma el tamaño del registro nRecord o el último si este no se envia METHOD SortFields( lDesen ) // ordena los campos del objeto METHOD dbSortField( cField , lDesen ) // ordena los campos del objeto TArray del campo cField a toda la matriz METHOD Field2Array(caField) // devuelve un campo en una matriz, o una matriz donde cada elemento es una matriz de los campos seleccionados METHOD SetFilter(bSetFilter) INLINE ::bSetFilter:=bSetFilter // define un filtro para los registros METHOD SkipFilter( nRecs ) METHOD IsField( cField ) INLINE ( aScan( ::aFields, Upper(AllTrim(cField)) ) > 0 ) METHOD FieldPos( cField ) INLINE aScan( ::aFields, Upper(AllTrim(cField)) ) METHOD FieldGet( nField ) INLINE if( ::LastRec()>0, ::aDatos[::RecNo(),nField], ::aDefault[nField] ) METHOD FieldGetByName( cField ) INLINE ::FieldGet( ::FieldPos( cField ) ) METHOD FieldPut( nField, uVal ) INLINE if( ::LastRec()>0, ::aDatos[::RecNo(), nField]:= uVal, ) METHOD FieldPutByName( cField, uVal ) INLINE ::FieldPut( ::FieldPos( cField ), uVal ) MESSAGE dbEval METHOD _dbEval( bBloque, bFor, bWhile, nNext, nRecord, lRest ) // realiza un aEval a toda la matriz con las mismas caracteristicas que el dbEval de clipper ERROR HANDLER ArrayErrorHand() ENDCLASS //----------------------------------------------------------------------------// METHOD New() CLASS TArray ::aDatos := {} /// Matriz real de datos ::aFields:= {} /// ::aBuffer:= {} /// Seg£n cantidad de Datos ::aDefault:={} return Self //----------------------------------------------------------------------------// METHOD AddField( cName, uInit, uDEFAULT ) CLASS TArray Aadd( ::aFields , Upper(cName) ) Aadd( ::aBuffer , if(uInit=nil,uDefault,uInit) ) Aadd( ::aDEFAULT , uDEFAULT ) return .T. //----------------------------------------------------------------------------// METHOD Load() CLASS TArray local aDatos := ::aDatos local aBuffer:= ::aBuffer local nLen := Len ( aDatos ) local nRecNo := ::nRecNo if nLen > 0 // .or. nRecNo <= ::LastRec() nRecNo := Max( Min( nRecNo, nLen ), 1 ) ::nRecNo:= nRecNo nLen := len(aDatos[nRecNo]) if nLen<len(aBuffer) aSize(aDatos[nRecNo],len(aBuffer)) aEval(aBuffer,{|uValor,nPos|aDatos[nRecNo,nPos] := ::valorVacio(uValor,nPos)},nLen+1) endif ::aBuffer:= aClone( aDatos[nRecNo] ) Else ::Blank() endif return .T. //----------------------------------------------------------------------------// METHOD Blank() CLASS TArray local aBuffer:= ::aBuffer AEval( aBuffer, {|uValor,nPos| aBuffer[nPos]:= ::valorVacio(uValor,nPos) } ) return .T. //----------------------------------------------------------------------------// METHOD ValorVacio( uValor, nPos, aDEFAULT ) CLASS TArray local cType:= ValType( uValor ),uDev DEFAULT aDefault := ::aDefault do case case cType == 'N' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,0,aDefault[nPos]) case cType == 'D' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,CtoD(''),aDefault[nPos]) case cType == 'L' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,.F.,aDefault[nPos]) case cType == 'C' .or. cType == 'M' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,Space(Len(uValor)),aDefault[nPos]) case cType == 'A' uDev:= if(nPos=nil .or. aDefault[nPos]=nil,aEval(aClone(uValor),{|x,y|uDev[y]:=::valorVacio( x )}),aClone(aDefault[nPos])) case cType == 'O' .and. uValor:classname() == "TArray" if nPos=nil .or. aDefault[nPos]=nil uDev:= oClone(uValor) uDev:zap() else oClone(aDefault[nPos]) endif otherwise uDev:= if(nPos=nil .or. aDefault[nPos]=nil,uValor,aDefault[nPos]) endcase return uDev //----------------------------------------------------------------------------// METHOD Save() CLASS TArray local aDatos := ::aDatos local aBuffer:= ::aBuffer local nLen := Len ( aDatos ) local nRecNo := ::nRecNo if nLen > 0 nRecNo := Max( Min( nRecNo, nLen ), 1 ) ::nRecNo:= nRecNo ::aDatos[nRecNo] := aClone(aBuffer) endif return .T. //----------------------------------------------------------------------------// METHOD Skip( nRecs ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo local nSalto := 0 DEFAULT nRecs:= 1 if nLen > 0 .and. nRecs <> 0 // SetFilter if ValType(::bSetFilter)="B" nSalto := ::SkipFilter(nRecs) else // sin SetFilter nRecNo := Max( Min( nRecNo, nLen ), 1 ) nSalto := nRecs if nRecs > 0 // Pa' delante if nRecNo + nRecs > nLen nSalto-= nRecNo + nRecs - nLen endif Else // Pa' tras if nRecNo + nRecs < 1 nSalto+= 1 - ( nRecNo + nRecs ) endif endif endif if nSalto <> 0 nRecNo+= nSalto ::nRecNo:= nRecNo ::Load() endif endif if nSalto == 0 if nRecs <> 0 if nRecs > 0 ::lEof:= .T. ::lBof:= .F. Else ::lEof:= .F. ::lBof:= .T. endif endif Else ::lEof:= .F. ::lBof:= .F. endif return nSalto //----------------------------------------------------------------------------// METHOD Goto( nRecGoto ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo if nRecGoto=0 ::nRecNo := ::LastRec()+1 ::lEof := .T. ::lBof := ::LastRec()=0 ::Blank() else nRecGoto:= Min( nLen, nRecGoto ) if nLen > 0 ::nRecNo:= nRecGoto ::Load() ::lEof:= .F. ::lBof:= .F. Else ::Blank() endif endif return .T. //----------------------------------------------------------------------------// METHOD Append( nPosRecNo ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo local aDatos := ::aDatos if nLen > 0 .and. nPosRecNo != Nil .and. nPosRecNo >= 1 nPosRecNo:= Min( nLen, nPosRecNo ) ASize( aDatos, nLen+1 ) AIns( aDatos, nPosRecNo ) ::nRecNo:= nPosRecNo aDatos[ nPosRecNo ]:= Array( Len(::aFields) ) AEval( ::aBuffer, {|uValor,nPos| aDatos[nPosRecNo,nPos]:= ::valorVacio(uValor,nPos) } ) else Aadd( aDatos, Array( Len(::aFields) ) ) nPosRecNo:= nLen + 1 ::nRecNo := nPosRecNo endif AEval( ::aBuffer, {|uValor,nPos| aDatos[nPosRecNo,nPos]:= ::valorVacio(uValor,nPos) } ) ::aBuffer := aClone( aDatos[nPosRecNo] ) ::lEof:= .F. ::lBof:= .F. return .T. //----------------------------------------------------------------------------// METHOD Add( nPos ) CLASS TArray local aBuffer:= aClone(::aBuffer) ::Append( nPos ) ::aBuffer := aBuffer ::Save() return .T. //----------------------------------------------------------------------------// METHOD _Delete( nPosRecNo ) CLASS TArray local nLen := Len ( ::aDatos ) local nRecNo := ::nRecNo local aDatos := ::aDatos DEFAULT nPosRecNo:= ::nRecNo if nLen > 0 nPosRecNo:= Max( Min( nLen, nPosRecNo ), 1) ADel( aDatos, nPosRecNo ) ASize( aDatos, nLen-1 ) if nPosRecNo > nLen-1 nPosRecNo-- endif ::nRecNo:= nPosRecNo ::Load() endif return .T. //----------------------------------------------------------------------------// METHOD Sort( cnField, lAscendente, nIni, nNro ) CLASS TArray local bBlock, uValor, nPosNueva local nField:=if(ValType(cnField)="N",cnField,if(ValType(cnField)="C",::FieldPos(cnField),1)) DEFAULT nField:= 1,; lAscendente:= .T. if Len( ::aDatos ) > 0 if lAscendente bBlock:= {|x,y| x[nField] < y[nField] } Else bBlock:= {|x,y| x[nField] > y[nField] } endif uValor:= ::aDatos[::nRecNo,nField] /// Valor Donde Estaba ASort( ::aDatos, nIni, nNro, bBlock ) if ( nPosNueva:= AScan( ::aDatos, {|x| x[nField] == uValor } ) ) > 0 ::nRecNo:= nPosNueva endif endif return .T. //----------------------------------------------------------------------------// METHOD Seek( uClave, cnField, lSoft ) CLASS TArray local lEncontro:= .F. local nPosNueva:=0 local bSetFilter := if(ValType(::bSetFilter)="B",::bSetFilter,{||.T.}) DEFAULT lSoft:= .F. if(ValType(cnField)="C",cnField:=::FieldPos(cnField),) // if ( nPosNueva:= AScan( ::aDatos, {|x| x[cnField] == uClave }, nPosNueva ) ) > 0 // ::nRecNo:= nPosNueva // ::Load() // ::lEof:= .F. // ::lBof:= .F. // lEncontro:= .T. // else // ::lEof := .T. // ::nRecNo := 0 // ::blank() // endif if lSoft // Busqueda blanda do while .T. nPosNueva := AScan( ::aDatos, {|x| AllTrim( x[cnField] ) = uClave }, nPosNueva+1 ) ::Goto(nPosNueva) if nPosNueva = 0 exit elseif Eval(bSetFilter,Self) lEncontro := .T. exit endif enddo else do while .T. nPosNueva := AScan( ::aDatos, {|x| AllTrim( x[cnField] )== uClave }, nPosNueva+1 ) ::Goto(nPosNueva) if nPosNueva = 0 exit elseif Eval(bSetFilter,Self) lEncontro := .T. exit endif enddo end return lEncontro //----------------------------------------------------------------------------// METHOD _FieldPos( cField ) CLASS TArray cField := if(ValType(cField)="C",upper(cField),"") return aScan( ::aFields, {|x|x==cField} ) //----------------------------------------------------------------------------// METHOD _dbEval( bBloque, bFor, bWhile, nNext, nRecord, lRest ) CLASS TArray local nCont,nSkip:=1,bSetFilter:=if(ValType(::bSetFilter)="B",::bSetFilter,{||.T.}) DEFAULT bFor := {||.T.} DEFAULT bWhile := {||.T.} DEFAULT nNext := ::LastRec() if ValType(nRecord)="N" ::goto(nRecord) nNext := 1 nSkip := 0 elseif pCount()<4 .or. !Empty(lRest) ::GoTop() else ::Load() endif do while --nNext>=0 .and. !::eof() .and. Eval(bWhile,Self) if Eval(bFor,Self) .and. Eval(bSetFilter,Self) Eval(bBloque,Self) endif ::Skip(nSkip) enddo return nil //----------------------------------------------------------------------------// METHOD dbResize( cField, nRecord ) CLASS TArray local nCampo:=::FieldPos(cField),nTamActual,nTamNuevo,aBuffer,aFields,aDefault DEFAULT nRecord := ::LastRec() ::Goto(nRecord) if ValType(::aBuffer[nCampo])="A" nTamNuevo := len(::aBuffer[nCampo]) aEval(::aDatos,{|aReg|aBuffer:=aReg,nTamActual:=len(aReg[nCampo]),; aSize(aReg[nCampo],nTamNuevo),; aEval(aReg[nCampo],{|uValor,nPos|aBuffer[nPos]:= ::valorVacio(uValor,nPos)},nTamActual+1)}) elseif ValType(::aBuffer[nCampo])="O" .and. ::aBuffer[nCampo]:classname() == "TArray" aFields := aClone(::aBuffer[nCampo]:aFields) aDEFAULT := aClone(::aBuffer[nCampo]:aDefault) aBuffer := aClone(::aBuffer[nCampo]:aBuffer) nTamNuevo := len(aBuffer) aEval(aBuffer,{|uValor,nPos|aBuffer[nPos]:= ::valorVacio(uValor,nPos,aDefault)}) ::dbEval({|aBuf|::aBuffer[nCampo]:aFields:=aClone(aFields),; ::aBuffer[nCampo]:aDefault:=aClone(aDefault),; aBuf:=::aBuffer[nCampo]:aBuffer,nTamActual:=len(aBuf),aSize(aBuf,nTamNuevo),; aEval(aBuffer,{|uValor,nPos|::aBuffer[nCampo]:aBuffer[nPos]:= ::valorVacio(uValor,nPos,aDefault)},nTamActual+1),; ::aBuffer[nCampo]:save()}) endif ::GoTop() return nil //----------------------------------------------------------------------------// METHOD SortFields( lDesen ) CLASS TArray local aFields := aClone(::aFields),aNuevo[len(::aFields)] aSort(::aFields,,,if(Empty(lDesen),{|x,y|x<y},{|x,y|x>y})) aEval(::aFields,{|cField,nPos|aNuevo[nPos]:=aScan(aFields,cField)}) aEval(aNuevo,{|nField,nPos|aFields[nPos]:=aScan(aNuevo,nPos)}) aEval(aClone(::aDefault),{|uValor,nPos|::aDefault[aFields[nPos]]:=uValor}) if Empty(::aDatos) aEval(aClone(::aBuffer),{|uValor,nPos|::aBuffer[aFields[nPos]]:=uValor}) else ::dbEval({||aEval(aClone(::aBuffer),{|uValor,nPos|::aBuffer[aFields[nPos]]:=uValor}),::save()}) endif return nil //----------------------------------------------------------------------------// METHOD dbSortField( cField , lDesen ) CLASS TArray local nField:=::FieldPos(cField) return ::dbEval({||::aBuffer[nField]:SortFields( lDesen )}) //----------------------------------------------------------------------------// METHOD Field2Array(caField) CLASS TArray local aArray:={}, nPos if ValType(caField)="C" .and. (nPos:=::FieldPos(caField))>0 ::dbEval({||aAdd(aArray,::aBuffer[nPos])}) elseif ValType(caField)="A" aEval(caField,{|cField,nPos| aAdd( aArray[nPos],::Field2Array(cField) ) }) endif return aArray //------------------------------------------------------------------------------------- METHOD SkipFilter(nRecs) class TArray local nSalto:=0,nRecNo:=::RecNo(),bSetFilter:=::bSetFilter,nSkipFilt,nSkip DEFAULT nRecs := 1 ::bSetFilter := nil nSkipFilt := nRecs nSkip := if(nSkipFilt>0,1,-1) do while nSkipFilt<>0 ::Skip(nSkip) if ::bof() .or. ::eof() ::goto(nRecNo) exit elseif Eval(bSetFilter,Self) nSkipFilt -= nSkip nRecNo := ::nRecNo nSalto += nSkip endif enddo ::bSetFilter := bSetFilter return nSalto //------------------------------------------------------------------------------------- #ifdef __HARBOUR__ METHOD ArrayErrorHand( uParam1 ) CLASS TArray local cMetodo:= __GetMessage() local nError := If( SubStr( cMetodo, 1, 1 ) == "_", 1005, 1004 ) #else METHOD ArrayErrorHand( cMetodo, nError ) CLASS TArray local uParam1 := GetParam( 1, 1 ) #endif local lAsignacion:= .F. local nId local lExact:= Set( _SET_EXACT, .T. ) local uDev local bMetodo := {|x|x==cMetodo}, oError if SubStr( cMetodo, 1, 1 ) == '_' lAsignacion:= .T. cMetodo:= SubStr( cMetodo, 2 ) #ifndef __HARBOUR bMetodo := {|x|left(x,9)==cMetodo} #endif endif if ::lCheckMayuscula AEval( ::aFields, {|cVal,nId| ::aFields[nId]:= Upper(cVal) } ) ::lCheckMayuscula:= .F. endif if ( nId:= AScan( ::aFields, bMetodo ) ) > 0 if lAsignacion uDev:= uParam1 ::aBuffer[ nId ]:= uDev Else uDev:= ::aBuffer[ nId ] endif Else // uDev:= _ClsSetErr( _GenError( nError, ::ClassName, cMetodo ) ) oError:= ErrorNew() oError:description:= "CLASE TArray " + ; "Campo " + cMetodo + " Inexistente." uDev:= Eval( ErrorBlock(), oError ) endif Set( _SET_EXACT, lExact ) return uDev //----------------------------------------------------------------------------//

TArray.ch

Code: Select all Expand view: //----------------------------------------------------------------------------// // Creando Estructuras de Datos // Arrays orientados a objetos //----------------------------------------------------------------------------// #command DEFINE STRUCT [<oTArray>] [INIT <aInit>] => ; [<oTArray>:= ]__StructNew(<aInit>) #command STRUCT FIELD <(cName)> [INIT <uInit>] [DEFAULT <uDefault>] => ; __StructField(<(cName)>,<uInit>,<uDefault> ) #command END STRUCT => __StructEnd()

Aquí está el código de ejemplo, tanto el código de trabajo y el código de error cuando con el nombre de la variable longitud es de más de 9

Código de Trabajo muestra

Code: Select all Expand view: #Include "FiveWin.ch" #Include "TArray.ch" *--------------------------* Function Main() *--------------------------* Local oArray DEFINE STRUCT oArray STRUCT FIELD Date INIT CtoD("") STRUCT FIELD No INIT 0 STRUCT FIELD Name INIT Space(40) END STRUCT oArray:Date :=Date()-1 oArray:No :=1 oArray:Name:="Customer 1" oArray:Add() oArray:Date :=Date() oArray:No :=2 oArray:Name:="Customer 2" oArray:Add() oArray:GoTop() Do While !oArray:Eof() MsgInfo("Invoice Date :"+Dtoc(oArray:Date)+CRLF+; "Invoice No :"+Str(oArray:No,4)+CRLF+; "Customer Name :"+oArray:Name ) oArray:Skip() Enddo *oArray:End() Return Nil

Error de código de ejemplo

Code: Select all Expand view: #Include "FiveWin.ch" #Include "TArray.ch" *--------------------------* Function Main() *--------------------------* Local oArray DEFINE STRUCT oArray STRUCT FIELD InvoiceDate INIT CtoD("") STRUCT FIELD InvoiceNo INIT 0 STRUCT FIELD CustomerName INIT Space(40) END STRUCT oArray:InvoiceDate :=Date()-1 oArray:InvoiceNo :=1 oArray:CustomerName:="Customer 1" oArray:Add() oArray:InvoiceDate :=Date() oArray:InvoiceNo :=2 oArray:CustomerName:="Customer 2" oArray:Add() oArray:GoTop() Do While !oArray:Eof() MsgInfo("Invoice Date :"+Dtoc(oArray:InvoiceDate)+CRLF+; "Invoice No :"+Str(oArray:InvoiceNo,4)+CRLF+; "Customer Name :"+oArray:CustomerName ) oArray:Skip() Enddo //oArray:End() Return Nil

Gracias

Anser

by **Antonio Linares** » Thu Dec 11, 2008 7:40 am

Anser,

Prueba a cambiar esta línea en la clase TArray:

bMetodo := {|x|left(x,9)==cMetodo}

por

bMetodo := {|x| x == cMetodo}

by **anserkk** » Thu Dec 11, 2008 8:40 am

Estimado Mr.Antonio,

Su solución funcionó. Ahora gama nombre de elemento de longitud apoya > 9 caracteres.

Muchas gracias por su excelente y oportuna.

Recuerdos,

Anser

FiveTech Software tech support forums

Ayuda: TArray

Ayuda: TArray

Who is online