Aporte. Nueva clase TQRecord. Para el árbol de Navidad

Aporte. Nueva clase TQRecord. Para el árbol de Navidad

Postby hmpaquito » Thu Dec 13, 2018 8:58 pm

Hola a todos,

Siguiendo la estela de una pregunta de José Luis, os dejo una clase Record, orientada a la versatilidad y la rapidez.

Espero vuestros comentarios. Saludos

Code: Select all  Expand view
///////////////
// TQRecord.prg  -  Quick Record
//
/////////////////////////////////////////////////

#include "hbclass.ch"
#Include "\prg\genlib\debug.ch"


//-------------------------------------------------------------------------//
function PruebaTQRecord()
Local oRec
Local cAlias:= "JAlgo", xRegistro

SELECT 0
USE \Algo ALIAS (cAlias)
IF Select(cAlias) == 0
   MERROR_("no se pudo abrir !!", cAlias)
ENDIF
*
*
xRegistro:= 2
*
oRec:= TQRecord(cAlias):New(cAlias, xRegistro, .t.)
*
SELECT (cAlias)
GO xRegistro
*
FLOGMSG_("1", oRec, oRec:cAlias, oRec:AlmCod, AlmCod)
*
oRec:AlmCod:= "24"
FLOGMSG_("2", oRec, oRec:cAlias, oRec:AlmCod, AlmCod)
*
oRec:Graba()
FLOGMSG_("3", oRec, oRec:cAlias, oRec:AlmCod, AlmCod)
*
CLOSE (cAlias)
return nil
*
*
//-------------------------------------------------------------------------//
CLASS TQRecord

  DATA cAlias
  DATA nFCount                      HIDDEN


  DATA   aBuffer      INIT {=>}     HIDDEN

  METHOD New()        CONSTRUCTOR
  METHOD AddField()                 HIDDEN

  DATA nRecNumber                   HIDDEN
  DATA aCampos                      HIDDEN

  METHOD DondeCargar()              HIDDEN

  METHOD Llena()
  METHOD Graba()

  DATA lValueNil                    HIDDEN

ENDCLASS

//-------------------------------------------------------------------------//
// cAlias, Obligatorio
// xDondeCargar, posibles valores son: NIL, nRegistro, "EOF"
// lValueNil, indica si se cargaran las datas-field con NIL
METHOD New(cAlias, xDondeCargar, lValueNil) CLASS TQRecord
  Local nArea:= Select()
  Local nSitio
  Local cName
  Local nPos
  *
  ::cAlias:= cAlias
  IF lValueNil == NIL
     lValueNil:= .f.
  ENDIF
  ::lValueNil:= lValueNil
  *
  SELECT (cAlias)
  ::nFCount:= FCount()
  nSitio:= Recno()
  *
  *
  ::aCampos:= Array(::nFCount)
  *
  ::DondeCargar(xDondeCargar, lValueNil)
  *
  IF lValueNil
     // Carga datas con NIL. Interesante para luego solo grabar los que no son NIL y asi
     // permitir grabaciones parciales utiles por ejemplo en registros que tienen campos
     // que se deben actualizar de forma separada, por ejemplo campos contador.
     FOR nPos:= 1 TO ::nFCount
        cName:= FieldName(nPos)
        *
        ::aCampos[nPos] := cName
        *
        ::AddField(cName, NIL)
     NEXT
     *
  ELSE
     FOR nPos:= 1 TO ::nFCount
        cName:= FieldName(nPos)
        *
        ::aCampos[nPos] := cName
        *
        ::AddField(cName, FieldGet(nPos))
     NEXT
     *
  ENDIF
  GO nSitio
  SELECT (nArea)
  *
RETURN Self
*
//-------------------------------------------------------------------------//
METHOD DondeCargar(xDondeCargar)
  *
  DO CASE
     CASE xDondeCargar == NIL .OR. ValType(xDondeCargar) == "N"
        IF xDondeCargar == NIL
           xDondeCargar:= Recno()
        ENDIF
        IF !::lValueNil              // No necesario pq para lValueNil = .T. no se cargan datos
           GO xDondeCargar
        ENDIF
        ::nRecNumber:= xDondeCargar
        *
     CASE ValType(xDondeCargar) == "C" .AND. xDondeCargar == "EOF"
        IF !::lValueNil
           GO BOTTOM
           SKIP          // Eof(), para datas vacias, y nuevo
        ENDIF
        ::nRecNumber:= 0
        *
        *
     CASE .T.
        MERROR_("Opcion no contemplada !!", cAlias, xDondeCargar)
        *
  ENDCASE
  *
RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD AddField(cName, uValue)
  *
  ::aBuffer[cName] := uValue
  *
  __clsAddMsg( ::ClassH, cName,;
               {|Self        | Self:aBuffer[cName]           }, HB_OO_MSG_INLINE )
  *
  __clsAddMsg( ::ClassH, "_" + cName,;
               {|Self, uValue| Self:aBuffer[cName] := uValue }, HB_OO_MSG_INLINE )
  *
return Self

//-------------------------------------------------------------------------//
STATIC FUNCTION Vacia()
   ::Llena(xDondeCargar)
RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD Llena(xDondeCargar)
  Local nArea:= Select()
  Local nSitio
  Local nPos
  Local cName
  *
  SELECT (cAlias)
  nSitio:= Record()
  *
  ::DondeCargar(xDondeCargar)
  *
  IF ::lValueNil
     // Carga datas con NIL. Interesante para luego solo grabar los que no son NIL
     FOR nPos:= 1 TO ::nFCount
        cName:= FieldName(nPos)
        *
        ::Buffer[cName]:= NIL
        *
     NEXT
     *
  ELSE
     FOR nPos:= 1 TO ::nFCount
        cName:= FieldName(nPos)
        *
        ::Buffer[cName]:= FieldGet(nPos)
        *
     NEXT
     *
  ENDIF
  *
  GO nSitio
  SELECT (nArea)
RETURN NIL

//-------------------------------------------------------------------------//
METHOD Graba()
  Local nArea:= Select()
  Local nSitio
  Local nI, nPos
  Local lValueNil:= ::lValueNil
  *
  SELECT (::cAlias)
  nSitio:= Recno()
  *
  IF ::nRecNumber == 0
     Add_Rec(0)
  ELSE
     GO ::nRecNumber
     Rec_Lock(0)
  ENDIF
  *
  FOR nI:= 1 TO ::nFCount
     // Grabacion segura (cambio de orden de campos entre tabla de origen y
     // tabla de destino o bien no existe el campo en destino.)
     nPos:= FieldPos(::aCampos[nI])
     IF nPos > 0
        IF If(lValueNil , ::aBuffer[::aCampos[nI]] != NIL, .t.)          
           FieldPut(nPos, ::aBuffer[::aCampos[nI]])
        ENDIF
     ENDIF
  NEXT
  *
  UNLOCK
  *
  GO nSitio
  *
  SELECT (nArea)
RETURN NIL
*
*
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Aporte. Nueva clase TQRecord. Para el árbol de Navidad

Postby José Luis Sánchez » Sat Dec 15, 2018 7:30 am

Hola,
Pues me alegro de que la idea te sirviera la idea, a veces las cosas sencillas son las que más utilizamos. Yo ahora estoy utilizando una modificación de la clase original que me envió Biel Maimó y que dejo por si alguien más está interesado.

Hay varias diferencias con la clase original. El alias lo defines en el momento de crear el objeto, en vez de arrays esta nueva clase usa tablas hash, y la creación de una data no existente en la dbf original debe hacerse mediante el métido adddata('data').

Saludos,

Code: Select all  Expand view

// Código basado en una aportación de Marcelo Via Giglio y modificada por Biel Maimó.
#include "hbclass.ch"

CLASS tRecord

   DATA   aFld                INIT {=>} HIDDEN
   DATA   cAlias AS CHARACTER INIT ""   HIDDEN
   METHOD New(cAlias) CONSTRUCTOR
   METHOD FieldGet( cName)
   METHOD FieldPut( cName, uVal )
   METHOD AddData( cName )
   METHOD AddDataFromAlias()
   METHOD LoadFromAlias()
   METHOD saveToAlias()
   METHOD blankFromAlias()
   METHOD SetAlias( cAlias )
   METHOD GetAlias( ) INLINE ::cAlias

ENDCLASS

//------------------------------------------------------------------------------
METHOD New( cAlias ) CLASS tRecord
   IF cAlias!=NIL .AND. Select(cAlias)!=0
      ::cAlias:=cAlias
      ::AddDataFromAlias()
      //::loadFromAlias()
   ENDIF
RETURN SELF

//------------------------------------------------------------------------------
METHOD FieldGet( cName ) CLASS tRecord ; RETURN ::aFld[ cName ]

//-----------------------------------------------------------------------------
METHOD FieldPut( cName, uVal ) CLASS tRecord
   ::aFld[ cName ]:=uVal
RETURN NIL

//------------------------------------------------------------------------------
METHOD AddData( cName ) CLASS tRecord

  __clsAddMsg( ::ClassH, cName,;
               {|Self| Self:FieldGet( cName ) }, HB_OO_MSG_INLINE )

  __clsAddMsg( ::ClassH, "_" + cName,;
               {|Self,Value| Self:FieldPut( cName, Value ) }, HB_OO_MSG_INLINE )

RETURN Self

//------------------------------------------------------------------------------
METHOD AddDataFromAlias() CLASS tRecord
   LOCAL nFld,i
   nFld:=(::cAlias)->(FCount())
   FOR i:=1 TO nFld
      ::AddData( (::cAlias)->(FieldName( i )) )
   NEXT
RETURN NIL

//------------------------------------------------------------------------------
METHOD LoadFromAlias( ) CLASS tRecord
   LOCAL nFld,i
   nFld:=(::cAlias)->(FCount())
   FOR i:=1 TO nFld
      ::aFld[ ( (::cAlias)->(FieldName( i )) )]:= (::cAlias)->(FieldGet(i) )
   NEXT
RETURN NIL

//-----------------------------------------------------------------------------
METHOD SetAlias( cAlias ) CLASS tRecord
   LOCAL lVal
   IF cAlias!=NIL .AND. Empty(::cAlias) .AND. Select(cAlias)!=0
      ::cAlias:=cAlias
     
      ::AddDataFromAlias()
      //::loadFromAlias()
      lVal:=.T.
   ELSE
      lVal:=.F.
      //En este caso deberia borrar los mensajes del objeto, y de momento no se como hacerlo.
   ENDIF
RETURN lVal

//-----------------------------------------------------------------------------
METHOD blankFromAlias() CLASS tRecord
   LOCAL i, cInit
   FOR i := 1 TO ( ::cAlias ) ->( FCount() )
      DO CASE
      CASE ( ::cAlias )->( FieldName( i ) ) == "C"
         cinit := Space( Len( ( ::cAlias )->( FieldName( i ) ) ) )
      CASE ( ::cAlias )->( FieldName( i ) ) == "N"
         cinit := 0
      CASE ( ::cAlias )->( FieldName( i ) ) == "D"
         cinit := Date()
      CASE ( ::cAlias )->( FieldName( i ) ) == "M"
         cInit := Space( 255 )
      CASE ( ::cAlias )->( FieldName( i ) ) == "L"
         cinit := .F.
      ENDCASE
      ::aFld[ ( (::cAlias)->(FieldName( i )) )]:= cInit
   NEXT
RETURN NIL

// ------------------------------------------------------------------------------
METHOD saveToAlias() CLASS tRecord
   LOCAL i, key, pos
   FOR i := 1 TO Len( ::aFld ) // (::cAlias) -> ( FCOUNT() )
      key := hb_hKeyAt( ::aFld, i )
      pos := (::cAlias)->(FieldPos( key ))
      IF pos != 0
        (::cAlias)->(FieldPut( pos, ::aFld[ key ] )) // FIELDPUT de Harbour
      ENDIF
   NEXT
RETURN NIL

// ------------------------------------------------------------------------------

 
User avatar
José Luis Sánchez
 
Posts: 540
Joined: Thu Oct 13, 2005 9:23 am
Location: Novelda - Alicante - España


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 35 guests