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
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
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
HOracio,
Gracias x tu pronta respuesta. Tendras algun pequeño ejemplo? Ya que soy nuevo en el uso de Clases
Agradeciendo de antemano
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
//---------------------------------------------------------------------------//
// AUTOR.....: Manuel Expósito Suárez //
// eMails....: <!-- e --><a href="mailto:xmessoft@gmail.com">xmessoft@gmail.com</a><!-- e --> //
// 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 )
//---------------------------------------------------------------------------//Gracias amigo,
Puedes poner un ejemplo de como llamarla con variables y funciones dinamicas?
Atento a tus comentarios
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
//----------------------------------------------------------------------------//
// AUTOR.....: Manuel Expósito Suárez //
// eMails....: <!-- e --><a href="mailto:xmessoft@gmail.com">xmessoft@gmail.com</a><!-- e --> //
// 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"
//----------------------------------------------------------------------------//Muchas gracias,
Voy a probarlo
Saludos
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
Qué tal?
Te funcionó?
Era eso lo que querías?
Saludos
Manu Expósito
HOla xmanuel,
Estoy finalizando de ajustarlo para probar
Te hare saer los resultados
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
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>
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
Quita la línea de código del principio que pone:
REQUEST HB_GT_WIN
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
FWH 25.12
Harbour/Hbmk2
Microsoft Visual C++
MySql 8.0
Antigravity
Tendrás que volver a poner la linea:
REQUEST HB_GT_WIN
Y enlazar la lib gtwin.lib en tu buildxxxx.bat
Te funcionó ya? 