Page 1 of 1
Buffer de registro
Posted: Tue Aug 01, 2017 12:06 pm
by José Luis Sánchez
Hola,
estoy intentando hacer un buffer de registro que me permita acceder al mismo con la notación dbf:campo. Una alternativa al _/gather pero que pueda usar los nombres de campo para acceder. Me da igual una clase que funciones.
El primer ejemplo que he encontrado es de Maurizio, en este foro -
http://forums.fivetechsupport.com/viewt ... =tdatabase
Pero el siguiente ejemplo no funciona con Harbour:
Code: Select all
Function MAin()
Local aVArs
USE "CUSTOMER.dbf"
aVars := LoadDbf()
? aVars:FIRST// := "ABCD"
? aVars:LAST
SaveDbf(aVars)
dbcloseall()
Return nil
Function LoadDbf() // Scatter()
Local aVars := {=>}
LOcal nField := FCount()
LOcal nX := 1
FOR nX := 1 TO nField
aVars[FIELDNAME(nX)] := FieldGet(nX)
NEXT
Return aVars
//--------------------------------------------------------------------------
Function SaveDbf(aVArs) //Gather(aVars)
lOCAL Nx := 1
FOR Nx := 1 TO LEN(aVars)
FieldPut(nX,aVArs[FIELDNAME(nX)] )
NEXT
Return TRUE
//--------------------------------------------------------------------------
Function Blank(aVars)
local i,nX
i := len(aVars)
for nX :=1 to i
do case
case valtype(aVars[FIELDNAME(nX)]) == "C" ; aVars[FIELDNAME(nX)] := space(len(aVars[FIELDNAME(nX)]))
case valtype(aVars[FIELDNAME(nX)]) == "N" ; aVars[FIELDNAME(nX)] := 0
case valtype(aVars[FIELDNAME(nX)]) == "D" ; aVars[FIELDNAME(nX)] := CTOD("00-00-00")
case valtype(aVars[FIELDNAME(nX)]) == "M" ; aVars[FIELDNAME(nX)] := space(200)
case valtype(aVars[FIELDNAME(nX)]) == "L" ; aVars[FIELDNAME(nX)] := .F.
endcase
next
Return aVars
Mirando en los fuentes de harbour, hay un ejemplo de clase pero tampoco me funciona como yo quiero, puedo acceder al campo por la posición en el buffer pero no por el nombre del campo:
Code: Select all
#include "FiveWin.ch"
FUNCTION Main()
LOCAL oCu
MsgInfo( "start" )
USE Customer ALIAS CU NEW
oCu := HbRecord():New("CU")
oCu:Get()
? oCu:Buffer[1]
? oCu:FIRST
RETURN nil
// código de C:\harbour\contrib\xhb\ttable.prg
CREATE CLASS HBField
VAR ALIAS INIT Alias()
VAR Name INIT ""
VAR TYPE INIT "C"
VAR Len INIT 0
VAR Dec INIT 0
VAR ORDER INIT 0
VAR Value
METHOD Get() INLINE ::value := ( ::alias )->( FieldGet( ::order ) )
METHOD Put( x ) INLINE ::value := x, ;
( ::alias )->( FieldPut( ::order, x ) )
ENDCLASS
CREATE CLASS HBRecord
VAR Buffer INIT {}
VAR ALIAS INIT Alias()
VAR Number INIT 0
VAR aFields INIT {}
METHOD New( cAlias )
METHOD Get()
METHOD Put()
ENDCLASS
METHOD NEW( cAlias ) CLASS HBRecord
LOCAL i
LOCAL oFld
LOCAL aStruc
LOCAL aItem
__defaultNIL( @cAlias, Alias() )
::Alias := cAlias
::Buffer := {} // {=>}
::aFields := Array( ( ::alias )->( FCount() ) )
aStruc := ( ::alias )->( dbStruct() )
FOR EACH aItem in ::aFields
i := aItem:__EnumIndex()
oFld := HBField()
oFld:order := i
oFld:Name := ( ::alias )->( FieldName( i ) )
oFld:Type := aStruc[ i, 2 ]
oFld:LEN := aStruc[ i, 3 ]
oFld:Dec := aStruc[ i, 4 ]
oFld:Alias := ::alias
aItem := oFld
NEXT
RETURN Self
METHOD PROCEDURE Get() CLASS HBRecord
LOCAL xField
FOR EACH xField IN ::aFields
xField:Get()
::buffer[ xField:__EnumIndex() ] := xField:value
NEXT
RETURN
METHOD PROCEDURE Put() CLASS HBRecord
LOCAL xField
FOR EACH xField IN ::aFields
IF !( xField:Value == ::buffer[ xField:__EnumIndex() ] )
xField:PUT( ::buffer[ xField:__EnumIndex() ] )
::buffer[ xField:__EnumIndex() ] := xField:value
ENDIF
NEXT
RETURN
Se que FWH tiene la clase DataRow, pero me parece matar _ a cañonazos. Si alguien tiene una alternativa al _ / Gather que permita acceder via nombre del campo, le agracederé que lo comparta.
Saludos,
José Luis
Re: Buffer de registro
Posted: Tue Aug 01, 2017 1:14 pm
by darioflores
Buenas, si utilizas una clase puedes usar las funciones __objGetValueList y __objSetValueList para añadir al objeto los nombres de _ como propiedades (y los valores del registro claro).
Luego, claro está, deberás actualizar las propiedades cuando te muevas por la tabla.
Un saludo.
Re: Buffer de registro
Posted: Tue Aug 01, 2017 2:41 pm
by quim
José Luís, te adjunto un pequeño código a ver que te parece
Saludos
Code: Select all
/**
* Creacion de variables de clase dinámicas
* v1.0 09-02-2015
* @info :
* Se adapta para mantener un array asociativo
*
*/
#include "hbclass.ch"
function main()
local oData := DynClass():New()
// Set
oData:NewData("Name")
oData:NewData("City")
oData:NewData("Phone")
// Put
oData:Name := "John"
oData:City := "New York"
oData:Phone := "555 667 788"
// Get
? oData:Name, oData:City, oData:Phone
// Associative mode
oData:aBuffer['Name'] := "Mark"
oData:aBuffer['City'] := "Dallas"
oData:aBuffer['Phone'] := "636 695 487"
? oData:aBuffer['Name'], oData:aBuffer['City'], oData:aBuffer['Phone']
return .T.
//-------------------------------------------------------------------------------------------------//
CLASS DynClass
DATA aItems INIT {}
DATA aDatas INIT {}
DATA aBuffer INIT {=>}
METHOD New() CONSTRUCTOR
METHOD NewData()
METHOD GetData()
METHOD PutData()
ENDCLASS
//-------------------------------------------------------------------------------------------------//
METHOD New() CLASS DynClass
return Self
//-------------------------------------------------------------------------------------------------//
METHOD NewData( cName, uValue ) CLASS DynClass
aadd( ::aItems, cName )
aadd( ::aDatas, uValue )
::aBuffer[cName] := uValue
__clsAddMsg( ::ClassH, cName,;
{|Self| Self:GetData( cName ) }, HB_OO_MSG_INLINE )
__clsAddMsg( ::ClassH, "_" + cName,;
{|Self,Value| Self:PutData( cName, Value ) }, HB_OO_MSG_INLINE )
return Self
//-------------------------------------------------------------------------------------------------//
METHOD GetData( cName ) CLASS DynClass
local nIndex := ascan( ::aItems, cName )
return( If(nIndex > 0, ::aDatas[ nIndex ], NIL) )
//-------------------------------------------------------------------------------------------------//
METHOD PutData( cName, uValue ) CLASS DynClass
local nIndex := ascan( ::aItems, cName )
::aBuffer[cName] := uValue
return( If(nIndex > 0, ::aDatas[ nIndex ] := uValue, NIL) )
//-------------------------------------------------------------------------------------------------//
Re: Buffer de registro
Posted: Tue Aug 01, 2017 4:03 pm
by José Luis Sánchez
Dario: Gracias por indicarme las funciones __objGetValueList y __objSetValueList. No las conocía. No quiero cambiar los valores cuando se mueva el puntero del DBF, solo quiero hacer get y put.
Quim: Gracias por el código, creo que me va a servir mucho. Si le paso un alias al new y monto las datas de _ casi lo tengo.
Saludos,
Re: Buffer de registro
Posted: Tue Aug 01, 2017 4:17 pm
by hmpaquito
Muy interesante la clase de Quim. Gracias.
Tengo una similar basada en el método errorblock del gestor de errores... pero nunca me gustó... siempre pensé que debe ser lenta en ejecución.
Utilizaré, algún día, la de Quim: el proceso de transición no es inmediato, es una clase con multiples funcionalidades, fruto de muchos años de dale que te pego.
Por cierto Quim, ¿ por qué la clase duplica el almacenamiento, en datas y en hash ? ¿ Es más rápido el acceso al hash o cual es el motivo ?
EDITADO: Por cierto, modificaría los dos métodos de la clase, para darle velocidad, suprimiendo aItems y aDatas, así:
Code: Select all
//-------------------------------------------------------------------------------------------------//
CLASS DynClass
// DATA aItems INIT {}
// DATA aDatas INIT {}
DATA aBuffer INIT {=>}
METHOD New() CONSTRUCTOR
METHOD NewData()
METHOD GetData()
METHOD PutData()
METHOD MsgError() // Nuevo !!
ENDCLASS
//-------------------------------------------------------------------------------------------------//
METHOD New() CLASS DynClass
return Self
//-------------------------------------------------------------------------------------------------//
METHOD NewData( cName, uValue ) CLASS DynClass
// aadd( ::aItems, cName )
// aadd( ::aDatas, uValue )
::aBuffer[cName] := uValue
__clsAddMsg( ::ClassH, cName,;
{|Self| Self:GetData( cName ) }, HB_OO_MSG_INLINE )
__clsAddMsg( ::ClassH, "_" + cName,;
{|Self,Value| Self:PutData( cName, Value ) }, HB_OO_MSG_INLINE )
return Self
//-------------------------------------------------------------------------------------------------//
METHOD GetData( cName ) CLASS DynClass
RETURN If( HHaskey(::aBuffer, cName), ::aBuffer[cName], ::MsgError("Nombre de data desconocido en acceso "+ cName) )
//-------------------------------------------------------------------------------------------------//
METHOD PutData( cName, uValue ) CLASS DynClass
RETURN If( HHaskey(::aBuffer, cName), ::aBuffer[cName] := uValue, ::MsgError("Nombre de data desconocido en asignación "+ cName) )
//-------------------------------------------------------------------------------------------------//
// Nuevo
METHOD MsgError(cMsg)
RETURN (MsgInfo(cMsg), NIL)
Re: Buffer de registro
Posted: Tue Aug 01, 2017 4:25 pm
by quim
José Luis :
Me alegra que te sirva, tienes los planos de una ermita, ahora toca construir tu catedral
hmpaquito :
Son dos formas distintas de acceder al dato, cuestión de estética, la que más te guste
Si suprimes aItems y aDatas ya no podrás referirte al objeto de la forma oData:Nombre, oData:Fecha, ... sólo por su equivalente hash oData["Nombre"] ...
La rapidez que buscas es imperceptible
Saludos
Re: Buffer de registro
Posted: Tue Aug 01, 2017 7:19 pm
by Marcelo Via Giglio
Hola,
esto utilizo, no solo para un registro desde una tabla, sino, de manera general manejar varios datos en un solo registro
Code: Select all
#INCLUDE "FIVEWIN.CH"
CLASS oRecord
DATA aData, aFields
METHOD new() CONSTRUCTOR
METHOD FieldGet( nField ) INLINE ::aData[ nField ]
METHOD FieldName( nField ) INLINE ::aFields[ nField ]
METHOD FieldPos( cFieldName ) INLINE ASCAN( ::aFields, UPPER( cFieldName ) )
METHOD FieldPut( cFieldName, uVal )
METHOD LASTREC() INLINE LEN( ::aData )
METHOD FieldLen() INLINE LEN( ::aData )
METHOD loadFromAlias( cAlias )
METHOD show()
ERROR HANDLER OnError( cMsg, nError )
ENDCLASS
//------------------------------------------------------------------------------
METHOD new()
//------------------------------------------------------------------------------
::aData := {}
::aFields := {}
RETURN(Self)
//------------------------------------------------------------------------------
METHOD FieldPut( cFieldName, uVal )
//------------------------------------------------------------------------------
LOCAL pos := ::FieldPos( cFieldName )
IF pos = 0
AAdd( ::AFields, UPPER( cFieldName ) )
AAdd( ::aData, uVal )
ELSE
::aData[ pos ] := uVal
ENDIF
RETURN NIL
//------------------------------------------------------------------------------
METHOD OnError( uValor , nError)
//------------------------------------------------------------------------------
LOCAL cMensaje := UPPER ( ALLTRIM(__GetMessage() ) )
IF SUBSTR( cMensaje, 1, 1 ) == "_" // ASIGNACION
::FieldPut( SUBSTR( cMensaje, 2 ), uValor )
ELSE
RETURN ::FieldGet( ::FieldPos( cMensaje ) )
ENDIF
RETURN NIL
//------------------------------------------------------------------------------
METHOD loadFromAlias( cAlias )
//------------------------------------------------------------------------------
LOCAL i
FOR i := 1 TO (cAlias) -> ( FCOUNT() )
::FIELDPUT( (cAlias) -> ( FieldName(i) ), (cAlias) -> ( FieldGet(i) ) )
NEXT
RETURN NIL
//------------------------------------------------------------------------------
METHOD show()
//------------------------------------------------------------------------------
LOCAL a := {}
AEVAL( ::AFIELDS, {|b,i| AADD( a , { ::AFIELDS[i], ::aData[i] } ) } )
xBrowse( a )
RETURN NIL
Si utilizar el LoadFromAlias, tendras un registro con la información de _ de la tabla.
La cualidad de esta clase es que te permite
Code: Select all
oRec := oRecord():new()
oRec:algo := "ALGO"
? oRec:algo
no necesitas definir sus datos, se los crea dinamicamente
Saludos
Marcelo Vía
Re: Buffer de registro
Posted: Wed Aug 02, 2017 7:23 am
by hmpaquito
Marcelo,
Yo tengo una similar.
El sistema de funcionamiento de la clase, basado en el gestor de errores, podría ser lento. No he hecho prueba de tiempos.
La novedad de la clase de Quim es que no utiliza el OnError. Ahí radica su bondad.
Saludos
Re: Buffer de registro
Posted: Wed Aug 02, 2017 9:24 am
by José Luis Sánchez
Marcelo,
Tu clase hace lo que yo pretendo. He añadido un método saveToAlias y puedo salvar también a un DBF.
Code: Select all
//------------------------------------------------------------------------------
METHOD saveToAlias( cAlias )
//------------------------------------------------------------------------------
LOCAL i, pos
FOR i := 1 TO Len(::aData) // (cAlias) -> ( FCOUNT() )
pos := FieldPos( ::aFields[i] )
if pos != 0
FIELDPUT( pos, ::aData[i] ) // FIELDPUT de Harbour
endif
NEXT
RETURN NIL
hmpaquito: no entiendo lo que dices que al estar basado en el gestor de errores podría ser lenta, ¿ lo puedes explicar y la manera de solucionarlo ? Quiero hacer una clase a partir del código de Quim, cuando la tenga la publicaré y también te animo, si te parece bien, a publicar tu clase de manejo de buffer.
Saludos,
José Luis
Re: Buffer de registro
Posted: Wed Aug 02, 2017 9:50 am
by quim
Al utilizar OnError hace que la clase se 'cae' cada vez que se declara un nuevo miembro, similar a lo que hace TDataBase
oRecord:Nuevo produce un error en tiempo de ejecución pero no 'se nota' ya que el error 'se recupera' devolviendo el valor get o put solicitado
La llamada a la funcion __clsAddMsg que hago, es la misma función que crea las variables de clase en su propia definición
Saludos
Re: Buffer de registro
Posted: Wed Aug 02, 2017 10:05 am
by hmpaquito
José Luis,
Primero. Mi clase tiene un montón de dependencias. Es lo bueno (y lo malo) de tantos años de dale que te pego sobre el mismo código. Tiene dos mil líneas.
Segundo. En este mismo hilo podríamos ir mejorando la de Quim. Puedo ir sugiriendo / añadiendo funcionalidades en base a lo que ya tengo. O si acaso subirla a Github y allí ir desarrollandola, aunque yo nunca lo he usado.
Tercero. Por favor, lo primero, ponerle una data xCargo, que tendrían que tener todos los objetos, incluso las sillas y las mesas
Cuarto. Mi clase se basa en el OnError, lo cual me parece muy chapucero, y quizá lento.
Re: Buffer de registro
Posted: Wed Aug 02, 2017 10:53 am
by Carlos Mora
hmpaquito wrote:
El sistema de funcionamiento de la clase, basado en el gestor de errores, podría ser lento. No he hecho prueba de tiempos.
Podría, si, pero no tanto. Si necesitas una clase para solo contener el registro, tampoco es que vayas a hacer gran diferencia. El peso es que al buscar el mensaje no lo ha encontrado , luego el motor de objetos busca por el metodo Onerror, y lo ejecuta. No es para tanto.
Considera además que esa propiedad de los objetos de poder adaptarse es una gran ventaja, esa introspección te permite declarar más cosas como campos virtuales. Tengo especial predilección por esta alternativa, porque es lo que más se parece a los ORMs (objet relational mappers) que se usan en otros lenguajes.
La alternativa de Quim requiere que explícitamente declares _, con lo que el ahorro de tiempo es relativo, requiere de bastante administración y gestion para usarlo en una escala importante. La definicion es dificil de 'cachear', ya que podriamos tener mas de una tabla con = nombre y diferente estructura durante la ejecucion del programa.
A ver si me pongo y subo la que yo uso, muy parecida a la tuya.
Re: Buffer de registro
Posted: Wed Aug 02, 2017 11:38 am
by darioflores
hmpaquito wrote:José Luis,
Primero. Mi clase tiene un montón de dependencias. Es lo bueno (y lo malo) de tantos años de dale que te pego sobre el mismo código. Tiene dos mil líneas.
Segundo. En este mismo hilo podríamos ir mejorando la de Quim. Puedo ir sugiriendo / añadiendo funcionalidades en base a lo que ya tengo. O si acaso subirla a Github y allí ir desarrollandola, aunque yo nunca lo he usado.
Tercero. Por favor, lo primero, ponerle una data xCargo, que tendrían que tener todos los objetos, incluso las sillas y las mesas
Cuarto. Mi clase se basa en el OnError, lo cual me parece muy chapucero, y quizá lento.
Con un EXTEND CLASS HBObject WITH DATA xCargo al inicio de tu main, todos los objetos que instancies contendrán esa propiedad.
Buenos aportes los del hilo, muchas gracias.
Un saludo.
Re: Buffer de registro
Posted: Fri Aug 04, 2017 6:53 pm
by xmanuel
Mi grano de arena.
Es vieja pero creo que funciona:
Code: Select all
//---------------------------------------------------------------------------//
// AUTOR.....: Manuel Exposito Suarez //
// eMails....: xmessoft@gmail.com //
// CLASE.....: TDbRecord //
// FECHA MOD.: 21/09/1994 //
// VERSION...: 1.5 //
// PROPOSITO.: Clase para el manejo del BUFFER de registros //
//---------------------------------------------------------------------------//
#include "HbClass.ch"
#include "Error.ch"
//---------------------------------------------------------------------------//
CLASS TDbRecord
CLASSDATA oError INIT ErrorNew()
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 vacio 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 esta utilizando la DBF
METHOD Used() CLASS TDbRecord
return( ( ::nArea )->( Used() ) )
//---------------------------------------------------------------------------//
// Registro actual en la DBF
METHOD RecNo() CLASS TDbRecord
return( ( ::nArea )->( RecNo() ) )
//---------------------------------------------------------------------------//
// Anade un registro vacio en la DBF, si lFree libera bloqueo
METHOD Append( lUnlock ) CLASS TDbRecord
( ::nArea )->( DbAppend( lUnlock ) )
return( Self )
//---------------------------------------------------------------------------//
// Anade un registro vacio 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 algun 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
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: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 )
//---------------------------------------------------------------------------//
Es vieja pero en su día me enseñó mucho...
Ahora estoy con otras cosas.
Pronto estará en la palestra HDO para MySQL junto a HDO para SQLite
Re: Buffer de registro
Posted: Fri Aug 04, 2017 6:53 pm
by xmanuel
Y el ejemplo:
Code: Select all
//----------------------------------------------------------------------------//
// 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"
//----------------------------------------------------------------------------//