FiveTech Support Forums

///////////////
// 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
*
*

// 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

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