Manejo de Variables Dinamicas en Clases

[Compuin]

A los master del foro...

Al trabajar con Clases, solo puedo utilizar las variables definidas en la DATA y las funciones en los METHOD o existe alguna forma de hacerlo dinamico, es decir, trabajar con variables en forma virtual o dinamica?

Atento a sus comentarios

[horacio]

Cuando utilizas clases puedes utilizar cualquier variable, lo que te limita es el ámbito de dicha variable. Las declaradas en la clase solo pueden ser invocadas por la misma y no fuera de ese ámbito, pero puedes usar local, static, private y públicas.
Saludos

[Compuin]

HOracio,

Gracias x tu pronta respuesta. Tendras algun pequeño ejemplo? Ya que soy nuevo en el uso de Clases

Agradeciendo de antemano

[xmanuel]

Mira esto que hice hace unos añitos:

Code: Select all  Expand view

//---------------------------------------------------------------------------//
//  AUTOR.....: Manuel Expósito Suárez                                       //
//  eMails....: xmessoft@gmail.com                                           //
//  CLASE.....: TDbRecord                                                    //
//  FECHA MOD.: 21/09/1997                                                   //
//  VERSION...: 1.5                                                          //
//  PROPOSITO.: Clase para el manejo del BUFFER de registros                 //
//---------------------------------------------------------------------------//

#include "HbClass.ch"
#include "Error.ch"

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

CLASS TDbRecord

    DATA aBuffer        // Buffer de trabajo
    DATA aBlank         // Buffer de vacios
    DATA nArea INIT 0   // Area de trabajo
    DATA nFields INIT 0 // Numero de campos

    METHOD New( xArea ) CONSTRUCTOR
    METHOD Use( cDBF, lNewWA, cRDD, cAlias, lShare, lRO ) CONSTRUCTOR
    METHOD Used()
    METHOD RecNo()
    METHOD Append( lUnlock )
    METHOD Insert( lUnlock )
    METHOD Update( lUnlock )
    METHOD Delete( lUnlock )
    METHOD Lock()
    METHOD UnLock()
    METHOD NetError()
    METHOD Load()
    METHOD Save()
    METHOD Blank()
    METHOD BufferGet( i )
    METHOD BufferPut( i, xValue )

    ERROR HANDLER OnError( uParam1 )

ENDCLASS

//---------------------------------------------------------------------------//
// Constructor de la clase estando el DBF abierto

METHOD New( xArea ) CLASS TDbRecord

    local n
    local cType := ValType( xArea )

    do case
        case cType == "N"
            ::nArea := xArea
        case cType == "C"
            ::nArea := Select( xArea )
        otherwise
            ::nArea := Select()
    end case

    // Creamos un array vacío para el buffer de datos
    n := ( ::nArea )->( FCount() )
    ::aBuffer := Array( n )
    ::nFields := n

    // Creamos un array con datos en blanco a partir de registro fantasma
    n := ( ::nArea )->( RecNo() )
    ( ::nArea )->( DbGoTo( LastRec() + 1 ) )
    ::Load()
    ::aBlank := AClone( ::aBuffer )
    ( ::nArea )->( DbGoTo( n ) )

return( Self )

//---------------------------------------------------------------------------//
// Constructor de la clase estando el DBF cerrada

METHOD Use( cDBF, lNewWA, cRDD, cAlias, lShare, lRO ) CLASS TDbRecord

    DbUseArea( lNewWA, cRDD, cDBF, cAlias, lShare, lRO )

    if !::NetError()
        ::New( Select() )
    else
        Alert( "No se puede abrir " + cDBF )
    endif

return( Self )

//---------------------------------------------------------------------------//
// Determina si se está utilizando la DBF

METHOD Used() CLASS TDbRecord
return( ( ::nArea )->( Used() ) )

//---------------------------------------------------------------------------//
// Registro actual en la DBF

METHOD RecNo() CLASS TDbRecord
return( ( ::nArea )->( RecNo() ) )

//---------------------------------------------------------------------------//
// Añade un registro vacío en la DBF, si lFree libera bloqueo

METHOD Append( lUnlock ) CLASS TDbRecord

    ( ::nArea )->( DbAppend( lUnlock ) )

return( Self )

//---------------------------------------------------------------------------//
// Añade un registro vacío y lo rellena con los valores del buffer

METHOD Insert( lUnlock ) CLASS TDbRecord

    if ::Lock()
        ( ::nArea )->( DbAppend() )
        ::Save()
        if ValType( lUnlock ) == "L" .and. lUnlock
            ::Unlock()
        endif
    endif

return( !::NetError() )

//---------------------------------------------------------------------------//
// Actualiza un registro con los valores del buffer

METHOD Update( lUnlock ) CLASS TDbRecord

    if ::Lock()
        ::Save()
        if ValType( lUnlock ) == "L" .and. lUnlock
            ::Unlock()
        endif
    endif

return( !::NetError() )

//---------------------------------------------------------------------------//
// Borra un registro

METHOD Delete( lUnlock ) CLASS TDbRecord

    if ::Lock()
        ( ::nArea )->( DbDelete() )
        if ValType( lUnlock ) == "L" .and. lUnlock
            ::Unlock()
        endif
    endif

return( !::NetError() )

//---------------------------------------------------------------------------//
// Bloquea el registro actual, devuelve un .t. si lo consigue

METHOD Lock() CLASS TDbRecord
return( ( ::nArea )->( RLock() ) )

//---------------------------------------------------------------------------//
// Desbloquea el registro actual

METHOD UnLock() CLASS TDbRecord

    ( ::nArea )->( DbUnlock() )

return( Self )

//---------------------------------------------------------------------------//
// Comprueba si ha habido algún error

METHOD NetError() CLASS TDbRecord
return( ( ::nArea )->( NetErr() ) )

//---------------------------------------------------------------------------//
// Carga el buffer desde la DBF

METHOD Load() CLASS TDbRecord

    local n := ::nFields
    local i

    for i := 1 to n
        ::aBuffer[ i ] := ( ::nArea )->( FieldGet( i ) )
    next

return( Self )

//---------------------------------------------------------------------------//
// Salva el buffer a la DBF

METHOD Save() CLASS TDbRecord

    local n := ::nFields
    local i

    for i := 1 to n
         ( ::nArea )->( FieldPut( i, ::aBuffer[ i ] ) )
    next

return( Self )

//---------------------------------------------------------------------------//
// Limpia el buffer

METHOD Blank() CLASS TDbRecord

    local n := ::nFields
    local i

    for i := 1 to n
         ::aBuffer[ i ] := ::aBlank[ i ]
    next

return( Self )

//---------------------------------------------------------------------------//
// Devuelve el valor de un elemento del buffer

METHOD BufferGet( i ) CLASS TDbRecord
return( ::aBuffer[ i ] )

//---------------------------------------------------------------------------//
// Asigna un valor a un elemento del buffer

METHOD BufferPut( i, xVal ) CLASS TDbRecord

    ::aBuffer[ i ] := xVal

return( Self )

//---------------------------------------------------------------------------//
// Acesso o Buffer usando

METHOD OnError( uParam ) CLASS TDbRecord

   local cMsg := __GetMessage()
   local nPos, uRet, oError

   if uParam <> nil .and. Left( cMsg, 1 ) == '_'
      cMsg := SubStr( cMsg, 2 )
   endif

   if ( ( nPos := ( ::nArea )->( FieldPos( cMsg ) ) ) <> 0 )
        if uParam == nil
            uRet := ::aBuffer[ nPos ]
        else
            ::aBuffer[ nPos ] := uParam
        endif
   else
      oError := ErrorNew()
      oError:Args := { Self, cMsg, uParam }
      oError:CanDefault := .F.
      oError:CanRetry := .F.
      oError:CanSubstitute := .T.
      oError:Description := "Invalid class member"
      oError:GenCode := EG_NOVARMETHOD
      oError:Operation := "TDbRecord:" + cMsg
      oError:Severity := ES_ERROR
      oError:SubCode := -1
      oError:SubSystem := "TDbRecord"
      uRet := Eval( ErrorBlock(), oError )
   endif

return( uRet )

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

 

[Compuin]

Gracias amigo,

Puedes poner un ejemplo de como llamarla con variables y funciones dinamicas?

Atento a tus comentarios

[xmanuel]

Claro que si, aquí verás que los nombres de los campos se usan como DATAS dinámicas ya que no se de finen en la clase TDbRecord.
La magia está en el método ERROR HANDLER OnError( uParam1 )
Recuerda crear un PRG llamado "TDbRecord.prg" con el código del mensaje anterior para que no de error esta linea del final: #include "TDbRecord.prg"

Code: Select all  Expand view

//----------------------------------------------------------------------------//
//  AUTOR.....: Manuel Expósito Suárez                                        //
//  eMails....: xmessoft@gmail.com                                            //
//  CLASE.....: TDbRecord                                                     //
//  FECHA MOD.: 21/09/1997                                                    //
//  VERSION...: 1.5                                                           //
//  PROPOSITO.: Clase para el manejo del BUFFER de registros                  //
//----------------------------------------------------------------------------//
//  PROPOSITO.: Ejemplo de mantenimiento de una tabla con TDbRecord           //
//----------------------------------------------------------------------------//

//-- Definiciones ------------------------------------------------------------//

#define B_BOX ( CHR( 218 ) + CHR( 196 ) + CHR( 191 ) + CHR( 179 ) + ;
                CHR( 217 ) + CHR( 196 ) + CHR( 192 ) + CHR( 179 ) + " " )

#define ID_CONSUTA  0
#define ID_MODIFICA 1
#define ID_ALTA     2
#define ID_BORRA    3

//-- Includes ----------------------------------------------------------------//

#include "InKey.ch"

REQUEST HB_GT_WIN

//-- Modulo principal --------------------------------------------------------//

procedure main()

    local oRec

    SET DATE FORMAT TO "DD/MM/YYYY"
    SET DELETED ON

    cls

    // Creamos objeto Record y abrimo la DBF es igual que hacer:
    // USE Test NEW SHARED
    // oRec := TDbRecord():New()

    // La sitaxis es:
    // METHOD Use( cDBF, lNewWA, cRDD, cAlias, lShare, lReadOnly )
    oRec := TDbRecord():Use( "Test", .t.,,, .t. )

    if oRec:Used()
        // Abrimos el Browse
        GestBrw( oRec )
    else
        Alert( "No se pudo abrir el fichero..." )
    endif

    DbCloseAll()

return

//-- Modulos auxiliares ------------------------------------------------------//

//----------------------------------------------------------------------------//
// Gestion completa de una tabla MySQL

static procedure GestBrw( oRec )

    local oBrw, oCol
    local lEnd := .f.
    local nKey, n, nFld

    oBrw := TBrowseDb( 1, 0, MaxRow() - 1, MaxCol() )

    oBrw:colorSpec := "W+/B, N/BG"
    oBrw:ColSep    := " ³ "
    oBrw:HeadSep   := "ÄÅÄ"
    oBrw:FootSep   := "ÄÁÄ"

    nFld := oRec:nFields

    FOR n := 1 TO nFld
        oBrw:AddColumn( TBColumnNew( ( oRec:nArea )->( FieldName( n ) ), GenCB( oRec, n ) ) )
    NEXT

    cls

    @ 0, 0 SAY PadC( "Ojeando la tabla: " + ;
                        upper( ( oRec:nArea )->( Alias() ) ), MaxCol() + 1, " " ) COLOR "W+/G+"

    @ MaxRow(),         0 SAY "INSERT"              COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Altas"               COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "ENTER"               COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Modifica"            COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "SUPR"                COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Bajas"               COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F4"                  COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "      "              COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F5"                  COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "      "              COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F6"                  COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "      "              COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "ESC"                 COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Salir"               COLOR "W+/R+"

    while !lEnd

      oBrw:ForceStable()

      nKey = InKey( 0 )

      do case
         case nKey == K_ESC             // Salir
              SetPos( MaxRow(), 0 )
              lEnd = .t.

         case nKey == K_DOWN            // Fila siguiente
              oBrw:Down()
         case nKey == K_UP              // Fila anterior
              oBrw:Up()

         case nKey == K_LEFT            // Va a la columna antrior
              oBrw:Left()

         case nKey == K_RIGHT           // Va a la columna siguiente
              oBrw:Right()

         case nKey = K_PGDN             // Va a la pagina siguiente
              oBrw:pageDown()

         case nKey = K_PGUP             // Va a la pagina antrior
              oBrw:pageUp()

         case nKey = K_CTRL_PGUP        // Va al principio
              oBrw:goTop()

         case nKey = K_CTRL_PGDN        // Va al final
              oBrw:goBottom()

         case nKey = K_HOME             // Va a la primera columna visible
              oBrw:home()

         case nKey = K_END              // Va a la ultima columna visible
              oBrw:end()

         case nKey = K_CTRL_LEFT        // Va a la primera columna
              oBrw:panLeft()

         case nKey = K_CTRL_RIGHT       // Va a la ultima columna
              oBrw:panRight()

         case nKey = K_CTRL_HOME        // Va a la primera página
              oBrw:panHome()

         case nKey = K_CTRL_END         // Va a la última página
              oBrw:panEnd()

         case nKey = K_DEL              // Borra fila
            Borrar( oRec, oBrw )

         case nKey = K_INS              // Inserta columna
            Insertar( oRec, oBrw )

         case nKey = K_ENTER            // Modifica columna
            Modificar( oRec, oBrw )

      endcase

   end

return

//----------------------------------------------------------------------------//
// Crea los codeblock SETGET de las columnas del browse

static function GenCB( oRec, n )
return( { || ( oRec:nArea )->( FieldGet( n ) ) } )

//----------------------------------------------------------------------------//
// Pantalla de datos de la tabla

static function PantMuestra( oRec, nTipo )

    local GetList := {}
    local cTipo, cId

    do case
        case nTipo == ID_ALTA
            cTipo := "Insertando"
            cId := "nuevo"
        case nTipo == ID_BORRA
        case nTipo == ID_CONSUTA
        case nTipo == ID_MODIFICA
            cTipo := "Modificando"
            cId := AllTrim( Str( ( oRec:nArea )->( RecNo() ) ) )
    end

    SET CURSOR ON

    DispBox( 3, 2, 18, 74, B_BOX )

    @ 04, 03 SAY cTipo + " registro en tabla " + ( oRec:nArea )->( Alias() ) + " - Numero: " + cId

    @ 06, 03 SAY "First....:" GET oRec:First    PICTURE "@K"
    @ 07, 03 SAY "Last.....:" GET oRec:Last     PICTURE "@K"
    @ 08, 03 SAY "Street...:" GET oRec:Street   PICTURE "@K"
    @ 09, 03 SAY "City.....:" GET oRec:City     PICTURE "@K"
    @ 10, 03 SAY "State....:" GET oRec:State    PICTURE "@K"
    @ 11, 03 SAY "Zip......:" GET oRec:Zip      PICTURE "@K"
    @ 12, 03 SAY "Hiredate.:" GET oRec:Hiredate PICTURE "@K"
    @ 13, 03 SAY "Married..:" GET oRec:Married  PICTURE "@K"
    @ 14, 03 SAY "Age......:" GET oRec:Age      PICTURE "@K"
    @ 15, 03 SAY "Salary...:" GET oRec:Salary   PICTURE "@K"
    @ 16, 03 SAY "Notes:"
    @ 17, 03                  GET oRec:Notes    PICTURE "@K"

return( GetList )

//----------------------------------------------------------------------------//
// Inserta una fila

static procedure Insertar( oRec, oBrw )

    local GetList := {}
    local cPant := SaveScreen( 3, 2, 18, 74 )

    oRec:Blank()

    GetList := PantMuestra( oRec, ID_ALTA )
    READ

    set cursor off

    RestScreen( 3, 2, 18, 74, cPant )

    if LastKey() != K_ESC .and. Updated()
        if oRec:Insert( .t. )
            Alert( "Tupla insertada" )
            oBrw:RefreshAll()
        else
            Alert( "No se pudo insertar el registro;" +;
                   "El reistro está bloqueado por otro" )
        endif
    endif

return

//----------------------------------------------------------------------------//
// Modifica la fila actual

static procedure Modificar(oRec,oBrw )

    local GetList := {}
    local cPant := SaveScreen( 3, 2, 18, 74 )

    oRec:Load()

    GetList := PantMuestra( oRec, ID_MODIFICA )
    READ

    set cursor off

    RestScreen( 3, 2, 18, 74, cPant )

    if LastKey() != K_ESC .and. Updated()
        if oRec:Update( .t. )
            Alert( "Tupla Modificada" )
            oBrw:RefreshCurrent()
        else
            Alert( "No se pudo actualizar el registro;" +;
                   "El reistro está bloqueado por otro" )
        endif
    endif

return

//----------------------------------------------------------------------------//
// Borra la fila actual

static procedure Borrar( oRec, oBrw )

    local nRec := ( oRec:nArea )->( RecNo() )

    if Alert( "Realmente quieres borrar el registro?", { "Si", "No" } ) == 1
        if oRec:Delete( .t. )
            Alert( "Borrado..." )
            oBrw:RefreshAll()
        else
            Alert( "No se pudo borrar el registro;" +;
                   "El reistro está bloqueado por otro" )
        endif
    else
        Alert( "No se ha borrado..." )
    endif

return

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

#include "TDbRecord.prg"

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

 

[Compuin]

Muchas gracias,

Voy a probarlo

Saludos

[xmanuel]

Qué tal?
Te funcionó?
Era eso lo que querías?

Saludos
Manu Expósito

[Compuin]

HOla xmanuel,

Estoy finalizando de ajustarlo para probar

Te hare saer los resultados

[Compuin]

Me da este error al momento de tratar de compilar

Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland
prueba.c:
Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland
Error: Unresolved external '_HB_FUN_HB_GT_WIN' referenced from C:\FWH\SAMPLES\PR
UEBA.OBJ
* Linking errors *

C:\FWH\samples>

[xmanuel]

Quita la línea de código del principio que pone:
REQUEST HB_GT_WIN

[Compuin]

Compilo pero se quedo

Compiling...
xHarbour Compiler build 1.2.1 (SimpLex) (Rev. 6714)
Copyright 1999-2010, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'prueba.prg' and generating preprocessed output to 'prueba.ppo'...
Lines 266, Functions/Procedures 25
Generating C source output to 'prueba.c'...
Done.
Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland
prueba.c:
Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland
* Application successfully built *

Puse los archivos en la carpeta SAMPLES de FWH

[xmanuel]

Tendrás que volver a poner la linea:
REQUEST HB_GT_WIN
Y enlazar la lib gtwin.lib en tu buildxxxx.bat

[xmanuel]

Te funcionó ya?