Hola Jose o Ignacio...
Como ya he manifestado en más ocasiones, el mejor editor para xBase que he usado es XEdit y por eso insisto en que su actualización siga en paralelo a la del componete de Xailer...
Jose puedes hacer el paquetito con Xedit 4.00?
Gracias y que paseis unas felices fiestas de Semana Santa chicos!!!
XEdit... yo sigo!!!
-
Manu Exposito
- Mensajes: 116
- Registrado: Mié Feb 08, 2006 4:41 pm
XEdit... yo sigo!!!
Me uno a la petición y a la felicitación.
Saludos
Toni Sales
Saludos
Toni Sales
-
Pablo Herranz
- Mensajes: 253
- Registrado: Lun Feb 07, 2005 1:20 pm
XEdit... yo sigo!!!
El 31/03/2015 a las 15:42, Manu Exposito escribió:
> Hola Jose o Ignacio...
>
> Como ya he manifestado en más ocasiones, el mejor editor
> para xBase que he usado es XEdit y por eso insisto en que
> sua actualización siga en paralelo a la del componete de
> Xailer...
>
> Ignacio puedes hacer el apquetito con Xedit 4.00?
> Gracias y que paseis unas felices fiestas de Semana Santa
> chicos!!!
>
:d 
¡¡ Hola Manu!! ¿Que es de tu vida?, no se te ve ni se te oye.
:)
Saludos y a ver si nos vemos !!
> Hola Jose o Ignacio...
>
> Como ya he manifestado en más ocasiones, el mejor editor
> para xBase que he usado es XEdit y por eso insisto en que
> sua actualización siga en paralelo a la del componete de
> Xailer...
>
> Ignacio puedes hacer el apquetito con Xedit 4.00?
> Gracias y que paseis unas felices fiestas de Semana Santa
> chicos!!!
>
:d ¡¡ Hola Manu!! ¿Que es de tu vida?, no se te ve ni se te oye.
:)
Saludos y a ver si nos vemos !!
-
Pablo Herranz
- Mensajes: 253
- Registrado: Lun Feb 07, 2005 1:20 pm
XEdit... yo sigo!!!
El 31/03/2015 a las 15:42, Manu Exposito escribió:
> Hola Jose o Ignacio...
>
> Como ya he manifestado en más ocasiones, el mejor editor
> para xBase que he usado es XEdit y por eso insisto en que
> sua actualización siga en paralelo a la del componete de
> Xailer...
>
> Ignacio puedes hacer el apquetito con Xedit 4.00?
> Gracias y que paseis unas felices fiestas de Semana Santa
> chicos!!!
> :d
¡¡ Hola Manu!! ¿Que es de tu vida?, no se te ve ni se te oye.
:)
Saludos y a ver si nos vemos !!
> Hola Jose o Ignacio...
>
> Como ya he manifestado en más ocasiones, el mejor editor
> para xBase que he usado es XEdit y por eso insisto en que
> sua actualización siga en paralelo a la del componete de
> Xailer...
>
> Ignacio puedes hacer el apquetito con Xedit 4.00?
> Gracias y que paseis unas felices fiestas de Semana Santa
> chicos!!!
>
:d ¡¡ Hola Manu!! ¿Que es de tu vida?, no se te ve ni se te oye.
:)
Saludos y a ver si nos vemos !!
XEdit... yo sigo!!!
Hola Manu,
> Hola Jose o Ignacio...
>
> Como ya he manifestado en más ocasiones, el mejor editor
> para xBase que he usado es XEdit y por eso insisto en que
> sua actualización siga en paralelo a la del componete de
> Xailer...
>
> Ignacio puedes hacer el apquetito con Xedit 4.00?
> Gracias y que paseis unas felices fiestas de Semana Santa
> chicos!!!
> :d
no os preocupeis... lo publicaremos a la vuelta de Semana Santa
Un saludo,
José F. Giménez
http://www.xailer.com
http://www.xailer.info
> Hola Jose o Ignacio...
>
> Como ya he manifestado en más ocasiones, el mejor editor
> para xBase que he usado es XEdit y por eso insisto en que
> sua actualización siga en paralelo a la del componete de
> Xailer...
>
> Ignacio puedes hacer el apquetito con Xedit 4.00?
> Gracias y que paseis unas felices fiestas de Semana Santa
> chicos!!!
>
:d no os preocupeis... lo publicaremos a la vuelta de Semana Santa
Un saludo,
José F. Giménez
http://www.xailer.com
http://www.xailer.info
-
Manu Exposito
- Mensajes: 116
- Registrado: Mié Feb 08, 2006 4:41 pm
XEdit... yo sigo!!!
Hola Pablo, espero que todo te vaya SUPER...
Sí, estoy un poco por los mundos de Yupy. Aunque no se me oiga, sigo atento a lo que se cocina en el ambiente xBase...
Si vienes por Sevilla avísame y nos tomamos unas birras juntos.
Ahora, aunque no al 100% estoy enfrascado en un proyecto muy bonito...
Por otro lado terminé una TDbf PRO hecha 100% en lenguaje C.
Mira esta es la definicón de la clase en C:
/*
* Proyecto: tdbf_pro
* Fichero: tdbf_c.c
* Descripcion: Clase para manejo de DBF
* Autor: Manu Exposito
* Fecha: 12/12/2014
*/
#include "tdbf_pro.h"
//------------------------------------------------------------------------------
// Prototipo de funciones
//------------------------------------------------------------------------------
/* De Harbour: */
HB_FUNC( DBSETFILTER );
HB_FUNC( USED );
HB_FUNC( HB_DBDROP );
HB_FUNC( HB_DBEXISTS );
HB_FUNC( HB_DBRENAME );
HB_FUNC( ORDCREATE );
HB_FUNC( ORDKEYCOUNT );
HB_FUNC( ORDLISTADD );
HB_FUNC( DBSETRELATION );
HB_FUNC( DBCREATE );
HB_FUNC( DBEVAL );
HB_FUNC( FIELDBLOCK );
//------------------------------------------------------------------------------
/* Prototipo de funciones estaticas de TDbf */
static HB_AREANO selectArea( void );
static void restArea( HB_AREANO uiArea );
/* Prototipo de metodos de TDbf */
// Buffer de datos
HB_METHOD( TCDBF_LOAD );
HB_METHOD( TCDBF_SAVE );
HB_METHOD( TCDBF_UPDATE );
HB_METHOD( TCDBF_INSERT );
HB_METHOD( TCDBF_REMOVE );
HB_METHOD( TCDBF_BUFFER );
HB_METHOD( TCDBF_BUFFERLEN );
HB_METHOD( TCDBF_BUFFERKEYAT );
HB_METHOD( TCDBF_BUFFERKEYS );
HB_METHOD( TCDBF_SETBUFKEYCASEMATCH );
HB_METHOD( TCDBF_GETBUFFER );
HB_METHOD( TCDBF_GETBUFFERAT );
HB_METHOD( TCDBF_ABUFFER );
HB_METHOD( TCDBF_BLANK );
HB_METHOD( TCDBF_SETBUFFER );
HB_METHOD( TCDBF_SETBUFFERAT );
//------------------------------------------------------------------------------
HB_METHOD( TCDBF_VNULL );
HB_METHOD( TCDBF_INIT );
HB_METHOD( TCDBF_SELECT );
HB_METHOD( TCDBF_ISSELECTED );
HB_METHOD( TCDBF_GETAREA );
//------------------------------------------------------------------------------
// Work Area Methods
HB_METHOD( TCDBF_BOF );
HB_METHOD( TCDBF_EOF );
HB_METHOD( TCDBF_FOUND );
HB_METHOD( TCDBF_GOTO );
HB_METHOD( TCDBF_GOBOTTOM );
HB_METHOD( TCDBF_GOTOP );
HB_METHOD( TCDBF_SEEK );
HB_METHOD( TCDBF_SKIP );
//------------------------------------------------------------------------------
// Data Management Methods
HB_METHOD( TCDBF_APPEND );
HB_METHOD( TCDBF_DELETE );
HB_METHOD( TCDBF_DELETED );
HB_METHOD( TCDBF_FIELDCOUNT );
HB_METHOD( TCDBF_FIELDINFO );
HB_METHOD( TCDBF_FIELDNAME );
HB_METHOD( TCDBF_COMMIT );
HB_METHOD( TCDBF_FIELDGET );
HB_METHOD( TCDBF_FIELDPUT );
HB_METHOD( TCDBF_FIELDLEN );
HB_METHOD( TCDBF_RECALL );
HB_METHOD( TCDBF_RECCOUNT );
HB_METHOD( TCDBF_RECINFO );
HB_METHOD( TCDBF_RECNO );
//------------------------------------------------------------------------------
// Work Area/Database Management Methods
HB_METHOD( TCDBF_ALIAS );
HB_METHOD( TCDBF_CLOSE );
HB_METHOD( TCDBF_EVAL );
HB_METHOD( TCDBF_PACK );
HB_METHOD( TCDBF_SYSNAME );
HB_METHOD( TCDBF_OPEN );
HB_METHOD( TCDBF_INFO );
HB_METHOD( TCDBF_ZAP );
HB_METHOD( TCDBF_FREE );
//------------------------------------------------------------------------------
// Relational Operation Methods
HB_METHOD( TCDBF_SETRELATION );
HB_METHOD( TCDBF_CLEARRELATION );
HB_METHOD( TCDBF_RELAREA );
HB_METHOD( TCDBF_RELTEXT );
//------------------------------------------------------------------------------
// Order Management Methods
HB_METHOD( TCDBF_ORDCREATE );
HB_METHOD( TCDBF_ORDINFO );
HB_METHOD( TCDBF_ORDLISTADD );
HB_METHOD( TCDBF_ORDLISTCLEAR );
HB_METHOD( TCDBF_ORDSETFOCUS );
HB_METHOD( TCDBF_ORDLISTREBUILD );
// Basados en ORDINFO
HB_METHOD( TCDBF_ORDKEYCOUNT );
HB_METHOD( TCDBF_ORDKEYNO );
HB_METHOD( TCDBF_ORDKEYGOTO );
HB_METHOD( TCDBF_FULLPATH );
HB_METHOD( TCDBF_ORDKEY );
HB_METHOD( TCDBF_ORDNAME );
HB_METHOD( TCDBF_ORDBAGNAME );
HB_METHOD( TCDBF_ORDBAGEXT );
HB_METHOD( TCDBF_ORDCOND );
HB_METHOD( TCDBF_ORDNUMBER );
HB_METHOD( TCDBF_ORDCOUNT );
HB_METHOD( TCDBF_ORDKEYRELPOS );
HB_METHOD( TCDBF_ORDFINDREC );
HB_METHOD( TCDBF_ORDKEYVAL );
//------------------------------------------------------------------------------
// Filter and Scoping Methods
HB_METHOD( TCDBF_SETSCOPE );
HB_METHOD( TCDBF_SETSCOPETOP );
HB_METHOD( TCDBF_SETSCOPEBOTTOM );
HB_METHOD( TCDBF_CLEARSCOPE );
HB_METHOD( TCDBF_SETFILTER );
HB_METHOD( TCDBF_CLEARFILTER );
HB_METHOD( TCDBF_LOCATE );
HB_METHOD( TCDBF_SETLOCATE );
HB_METHOD( TCDBF_CONTINUE );
HB_METHOD( TCDBF_CLEARLOCATE );
HB_METHOD( TCDBF_FILTERTEXT );
//------------------------------------------------------------------------------
// Memo File Management Methods
HB_METHOD( TCDBF_GETVALUEFILE );
HB_METHOD( TCDBF_PUTVALUEFILE );
//------------------------------------------------------------------------------
// Network Operation Methods
HB_METHOD( TCDBF_RECLOCK );
HB_METHOD( TCDBF_UNLOCK );
HB_METHOD( TCDBF_FLOCK );
HB_METHOD( TCDBF_RECLOCKLIST );
// Miscellaneous Methods
HB_METHOD( TCDBF_USED );
//------------------------------------------------------------------------------
Se puede usar desde Xailer también. Uso como gestor de proyectos XEdit...
Algunas características TDbf PRO son:
* Hecha en lenguaje C al 100%
* Se puede usar directamente instanciando objetos directamente
* Se puede usar como clase interface para crear nuevas clases
* Se puede usar con cualquier RDD disponible
* Implementa scopes nativos
* Implementa filtros nativos
* Implementa relaciones nativas
* Implementa bloqueos simples y multiples
* Implementa buffer de edicion basado en una tablas hash
* Implementa campos calculados
Y un ejemplo de uso:
Clase específica para una DBF:
/*
* Proyecto: TDBF_PRO
* Fichero: ttest.prg
* Descripcion: Uso de los DATAFIELD para un determinado DBF y de la herencia
* Autor: Manu Exposito
* Fecha: 12/12/2014
*/
//------------------------------------------------------------------------------
#include "tdbf_pro.ch"
//------------------------------------------------------------------------------
REQUEST DBFCDX
//------------------------------------------------------------------------------
// Clase para maneja especificamente la DBF test.dbf
TDBF CLASS TTest
/*
Propiedad que contiene el nombre del fichero DBF con PATH si no esta en
mismo directorio que el ejecutable
*/
VAR cDbf INIT "test.dbf"
/*
Variables de instacia que relacionan el campo de la DBF con un miembro
del buffer (hash table)
*/
DATAFIELD First
DATAFIELD Last
DATAFIELD Street
DATAFIELD City
DATAFIELD State
DATAFIELD Zip
DATAFIELD Hiredate
DATAFIELD Married
DATAFIELD Age
DATAFIELD Salary
DATAFIELD Notes
/* Campos calculados. Se resuelven cuando se consultan */
CALCFIELD media IS ::fieldGet( 10 ) / ::fieldGet( 9 ) // Sobre la DBF
CALCFIELD nombreCompleto IS ::Last + " " + ::First // Sobre DataField
CALCFIELD nombre IS AllTrim( ::fieldGet( 2 ) ) + ", " + AllTrim( ::fieldGet( 1 ) ) // Sobre metodos
CALCFIELD id IS ::recNo()
CALCFIELD cId IS AllTrim( Str( ::recNo() ) )
CALCFIELD fecha IS DToC( Date() ) + " " + Time() // Sobre cualquier expresion
CONSTRUCTOR new()
ENDCLASS
//------------------------------------------------------------------------------
// Constructor
// Constructor de la clase. Sobrescribe al de TCDbf para especializarlo con esta
// DBF. Comprueba si existe la DBF y los indices y crea si es necesario
// Abre la DBF
METHOD new() CLASS TTest
::super:new( ::cDbf ) // Ejecuta el constructor del padre
// Comprueba si existe el fichero y si no es asi lo crea
if !::exists( ::cDbf )
msg( "Lo siento, " + ::cDbf + " no existe, la creo" )
::create( ::cDbf, { ;
{ "FIRST", "C", 20, 0 }, ;
{ "LAST", "C", 20, 0 }, ;
{ "STREET", "C", 30, 0 }, ;
{ "CITY", "C", 30, 0 }, ;
{ "STATE", "C", 2, 0 }, ;
{ "ZIP", "C", 10, 0 }, ;
{ "HIREDATE", "D", 8, 0 }, ;
{ "MARRIED", "L", 1, 0 }, ;
{ "AGE", "N", 2, 0 }, ;
{ "SALARY", "N", 6, 0 }, ;
{ "NOTES", "C", 70, 0 } ;
} )
endif
/*
Si existe el fichero lo abre con la RDD DBFCDX en entorno de red.
Comprueba la existencia de los ficheros de indices y los crea si no
existen. Por defecto se pone el foco en el primer orden.
*/
if ::exists( ::cDbf ) .and. ::open(, "DBFCDX",, .t. )
if ::exists( "test.cdx" )
::ordListAdd( "test", "nombre" )
::ordListAdd( "test", "apellido" )
else
::ordCreate( "test", "nombre", "first", { || ( ::getArea() )->first } )
::ordCreate( "test", "apellido", "last", { || ( ::getArea() )->last } )
endif
::blank() // Carga (inicializa) el buffer con valores en blanco
else
msg( "No se pudo abrir " + ::cDbf )
endif
return Self
//------------------------------------------------------------------------------
Y por fin el mantenimiento completo de una DBF. Si no existe la DBF se crea. Si no existen los indices también se crean etc, etc:
/*
* Proyecto: TDBF_PRO
* Fichero: Demo01.prg
* Descripcion: Demostraci¾«áñe la clase TCDbf
* Autor: Manu Exposito
* Fecha: 12/12/2014
*/
//-- 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
//-- Traducciones en tiempo de compilacion -----------------------------------//
#xtranslate toStr( <n> ) => ( AllTrim( Str( <n> ) ) )
//-- Includes ----------------------------------------------------------------//
#include "TDbf_pro.ch"
#include "InKey.ch"
//-- Modulo principal --------------------------------------------------------//
procedure main()
local aplicacion := TAplicacion():new()
aplicacion:ejecuta()
aplicacion:fin()
return
//-- Clase aplicacion --------------------------------------------------------//
CREATE CLASS TAplicacion
VAR oDb
VAR oBrw
CONSTRUCTOR new()
METHOD ejecuta()
METHOD cabecera()
METHOD mainMenu()
METHOD limpiaPie()
METHOD gestBrw()
METHOD genCB( n )
METHOD muestraPantalla()
METHOD insertar()
METHOD modificar()
METHOD borrar()
METHOD ayuda()
METHOD cambiaOrden()
METHOD irA()
METHOD info()
METHOD scp()
METHOD usoLocate()
METHOD consulta()
METHOD fin()
END CLASS
//------------------------------------------------------------------------------
METHOD new() CLASS TAplicacion
local oCol, n, nFld
::oDb := TTest():new()
if ::oDb:isOpen()
::oBrw := TBrowseDb( 1, 0, MaxRow() - 1, MaxCol() )
::oBrw:colorSpec := "W+/B, N/BG"
::oBrw:ColSep := " │ "
::oBrw:HeadSep := "─┼─"
::oBrw:FootSep := "─┴─"
nFld := ::oDb:FieldCount()
::oBrw:AddColumn( TBColumnNew( "ID", {|| ::oDb:id } ) )
for n := 1 to nFld
::oBrw:AddColumn( TBColumnNew( ::oDb:fieldName( n ), ::genCB( n ) ) )
next
endif
return Self
//------------------------------------------------------------------------------
PROCEDURE fin() CLASS TAplicacion
cls
if ::oDb:isOpen()
::oDb:free()
endif
msg( "Se termino..." )
return
//------------------------------------------------------------------------------
PROCEDURE ejecuta() CLASS TAplicacion
if ::oDb:isOpen()
SET DATE FORMAT TO "DD/MM/YYYY"
SET DELETED ON
if ValType( ::oBrw ) == "O"
::gestBrw()
endif
else
msg( "No se pudo abrir el fichero..." )
endif
return
//------------------------------------------------------------------------------
//
PROCEDURE mainMenu() CLASS TAplicacion
::limpiaPie()
@ 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 "F1" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Ayuda " COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F2" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Orden " COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F3" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Scope " COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ESC" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Salir " COLOR "W+/R+"
return
//------------------------------------------------------------------------------
//
PROCEDURE cabecera() CLASS TAplicacion
@ 0, 00 SAY "Ojeando la tabla: " + ::oDb:alias() + ;
PadL( " ", MaxCol(), " " ) COLOR "W+/G+"
return
//------------------------------------------------------------------------------
//
PROCEDURE gestBrw() CLASS TAplicacion
local lEnd := .f.
cls
::cabecera()
::mainMenu()
::oBrw:goTop()
while !lEnd
::oBrw:ForceStable()
switch InKey()
case K_ESC // Salir
SetPos( MaxRow(), 0 )
lEnd = .t.
EXIT
case K_DOWN // Fila siguiente
::oBrw:Down()
EXIT
case K_UP // Fila anterior
::oBrw:Up()
EXIT
case K_LEFT // Va a la columna antrior
::oBrw:Left()
EXIT
case K_RIGHT // Va a la columna siguiente
::oBrw:Right()
EXIT
case K_PGDN // Va a la pagina siguiente
::oBrw:pageDown()
EXIT
case K_PGUP // Va a la pagina antrior
::oBrw:pageUp()
EXIT
case K_CTRL_PGUP // Va al principio
::oBrw:goTop()
EXIT
case K_CTRL_PGDN // Va al final
::oBrw:goBottom()
EXIT
case K_HOME // Va a la primera columna visible
::oBrw:home()
EXIT
case K_END // Va a la ultima columna visible
::oBrw:end()
EXIT
case K_CTRL_LEFT // Va a la primera columna
::oBrw:panLeft()
EXIT
case K_CTRL_RIGHT // Va a la ultima columna
::oBrw:panRight()
EXIT
case K_CTRL_HOME // Va a la primera píŸgina
::oBrw:panHome()
EXIT
case K_CTRL_END // Va a la ·ltima píŸgina
::oBrw:panEnd()
EXIT
case K_DEL // Borra fila
::Borrar()
EXIT
case K_INS // Inserta columna
::Insertar()
EXIT
case K_ENTER // Modifica columna
::Modificar()
EXIT
case K_F1
::ayuda()
EXIT
case K_F2
::cambiaOrden()
EXIT
case K_F3
::scp()
EXIT
case K_F4
::info()
EXIT
case K_F5
::irA()
EXIT
case K_F6
// La data id y el metodo recno son sinonimos
::oDb:recLock( ::oDb:recNo() )
msg( "Rec. " + ::oDb:cId + " bloqueado" )
EXIT
case K_F7
muestra( ::oDb:recLockList(), "Registros bloqueados" )
EXIT
case K_F8
::usoLocate()
EXIT
case K_F9
::oDb:continue()
if ::oDb:found()
::oBrw:refreshAll()
else
msg( "No hay mas registros" )
endif
EXIT
case K_F10
::consulta()
EXIT
endswitch
end
return
//------------------------------------------------------------------------------
// Crea los codeblock SETGET de las columnas del browse
METHOD GenCB( n ) CLASS TAplicacion
return( {|| ::oDb:fieldGet( n ) } )
//------------------------------------------------------------------------------
// Pantalla de datos de la tabla
METHOD muestraPantalla( nTipo ) CLASS TAplicacion
local GetList := {}
local cId := ::oDb:cId
local cTipo
local lRedOnly := .f.
switch nTipo
case ID_MODIFICA
cTipo := "MODIFICANDO"
EXIT
case ID_ALTA
cTipo := "INSERTANDO"
cId := toStr( ::oDb:recCount() + 1 )
EXIT
case ID_BORRA
lRedOnly := .t.
cTipo := "BORRANDO"
EXIT
case ID_CONSUTA
lRedOnly := .t.
cTipo := "CONSULTANDO"
EXIT
endswitch
SET CURSOR ON
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY cTipo + " registro " + cId + " en tabla " + ::oDb:alias()
if !lRedOnly
@ 06, 03 SAY "First....:" GET ::oDb:First PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET ::oDb:Last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET ::oDb:Street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET ::oDb:City PICTURE "@K"
@ 10, 03 SAY "State....:" GET ::oDb:State PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET ::oDb:Zip PICTURE "@K"
@ 12, 03 SAY "Hiredate.:" GET ::oDb:Hiredate PICTURE "@K"
@ 13, 03 SAY "Married..:" GET ::oDb:Married PICTURE "@K"
@ 14, 03 SAY "Age......:" GET ::oDb:Age PICTURE "@K"
@ 15, 03 SAY "Salary...:" GET ::oDb:Salary PICTURE "@K"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET ::oDb:Notes PICTURE "@K"
else
@ 06, 03 SAY "First....: " + ::oDb:First
@ 07, 03 SAY "Last.....: " + ::oDb:Last
@ 08, 03 SAY "Street...: " + ::oDb:Street
@ 09, 03 SAY "City.....: " + ::oDb:City
@ 10, 03 SAY "State....: " + ::oDb:State
@ 11, 03 SAY "Zip......: " + ::oDb:Zip
@ 12, 03 SAY "Hiredate.: " + DToC( ::oDb:Hiredate )
@ 13, 03 SAY "Married..: " + IF( ::oDb:Married, "Si", "No" )
@ 14, 03 SAY "Age......: " + toStr( ::oDb:Age )
@ 15, 03 SAY "Salary...: " + toStr( ::oDb:Salary )
@ 16, 03 SAY "Notes:"
@ 17, 03 SAY ::oDb:Notes
endif
return( GetList )
//------------------------------------------------------------------------------
// Inserta una fila
PROCEDURE insertar() CLASS TAplicacion
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
::oDb:Blank()
GetList := ::muestraPantalla( ID_ALTA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if ::oDb:Insert()
msg( "Registro insertado" )
::oBrw:RefreshAll()
else
msg( "No se pudo insertar el registro;" + ;
"El reistro estíŸ bloqueado por otro" )
endif
endif
return
//------------------------------------------------------------------------------
// Modifica la fila actual
PROCEDURE modificar() CLASS TAplicacion
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
::oDb:Load()
GetList := ::muestraPantalla( ID_MODIFICA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if ::oDb:update()
msg( "Tupla Modificada" )
::oBrw:RefreshCurrent()
else
msg( "No se pudo actualizar el registro;" + ;
"El reistro estíŸ bloqueado por otro" )
endif
endif
return
//------------------------------------------------------------------------------
// Borra la fila actual
PROCEDURE borrar() CLASS TAplicacion
local cPant := SaveScreen( 3, 2, 18, 74 )
::oDb:Load()
::muestraPantalla( ID_BORRA )
Inkey( 2 )
if alert( "Realmente quieres borrar el registro?", { "No", "Si" } ) == 2
if ::oDb:remove()
msg( "Borrado..." )
::oBrw:RefreshAll()
else
msg( "No se pudo borrar el registro;" + ;
"El reistro estíŸ bloqueado por otro" )
endif
else
msg( "No se ha borrado..." )
RestScreen( 3, 2, 18, 74, cPant )
endif
return
//------------------------------------------------------------------------------
// Cambia el orden actual
PROCEDURE cambiaOrden() CLASS TAplicacion
local nId := ::oDb:id
local ordAnt := ::oDb:ordName()
if ordAnt == "NOMBRE"
::oDb:ordSetFocus( "APELLIDO" ) // Tambien :oDb:ordSetFocus( 2 )
else
::oDb:ordSetFocus( "nombre", "test" ) // El segundo parametro es el nombre del fichero en caso de CDX
endif
msg( "El orden anterior era " + ordAnt + ";el orden actual es " + ;
::oDb:ordName() )
::oDb:goTo( nId )
::oBrw:RefreshAll()
return
//------------------------------------------------------------------------------
// Cambia el orden actual
PROCEDURE irA() CLASS TAplicacion
local GetList := {}
local nRec := 0
local nRecOld
loca nRMax := ::oDb:recCount()
::limpiaPie()
@ MaxRow(), 15 SAY "Entre un numero entre 1 y " + toStr( nRMax ) + ;
":" GET nRec PICTURE "@K 9999999999" VALID nRec > 0 .and. nRec <= nRMax
READ
if LastKey() != K_ESC .and. Updated()
nRecOld := ::oDb:recNo()
::oDb:goTo( nRec )
if ::oDb:deleted()
msg( "Este registro esta marcado como borrado..." )
::oDb:goTo( nRecOld )
endif
::oBrw:RefreshAll()
endif
::mainMenu()
return
//------------------------------------------------------------------------------
PROCEDURE scp() CLASS TAplicacion
local GetList := {}
local cTop := space( 20 )
local cBottom := space( 20 )
local nRecOld
::limpiaPie()
@ MaxRow(), 00 SAY "Tope inicial:" GET cTop PICTURE "@K"
@ MaxRow(), Col() + 10 SAY "Tope final:" GET cBottom PICTURE "@K"
READ
if LastKey() != K_ESC
if Updated()
if cTop > cBottom
msg( "Lo siento...!!!;;;" + ;
"El tope inicial no puede ser superior al tope final" )
else
//::oDb:setScopeTop( cTop )
//::oDb:setScopeBottom( cBottom )
::oDb:setScope( cTop, cBottom )
msg( "Hay " + LTrim( Str( ::oDb:ordKeyCount() ) ) + ;
" registros que cumplen con el SCOPE" )
::oDb:goTop()
::oBrw:RefreshAll()
endif
else
::oDb:clearScope()
::oBrw:RefreshAll()
msg( ";Se han eliminado; los topes del SCOPE" )
endif
endif
::mainMenu()
return
//------------------------------------------------------------------------------
PROCEDURE consulta() CLASS TAplicacion
local cPant := SaveScreen( 3, 2, 18, 74 )
set cursor off
::oDb:Load()
::muestraPantalla( ID_CONSUTA )
Inkey( 60 )
RestScreen( 3, 2, 18, 74, cPant )
return
//------------------------------------------------------------------------------
PROCEDURE ayuda() CLASS TAplicacion
msg("F1 Ayuda ;F2 Cambio de orden ;F3 Activar Scope ;" + ;
"F4 Informacion ;F5 Ir a reg. numero;F6 Bloqueo registro;" + ;
"F7 Ver bloqueados ;F8 Uso de Locate ;F9 Siguiente locate;" + ;
"F10 Ver registro ;", "AYUDA" )
return
//------------------------------------------------------------------------------
PROCEDURE info() CLASS TAplicacion
local cInfo := ""
cInfo += " ordKeyCount....:" + PadL( ::oDb:ordKeyCount(), 30, " " )
cInfo += ";ordKeyRelPos...:" + PadL( ::oDb:ordKeyRelPos(), 30, " " )
cInfo += ";ordFullPath....:" + PadL( ::oDb:ordFullPath(), 30, " " )
cInfo += ";ordKey.........:" + PadL( ::oDb:ordKey(), 30, " " )
cInfo += ";ordKeyNo.......:" + PadL( ::oDb:ordKeyNo(), 30, " " )
cInfo += ";ordName........:" + PadL( ::oDb:ordName(), 30, " " )
cInfo += ";ordNumber......:" + PadL( ::oDb:ordNumber(), 30, " " )
cInfo += ";ordBagName.....:" + PadL( ::oDb:ordBagName(), 30, " " )
cInfo += ";ordBagExt......:" + PadL( ::oDb:ordBagExt(), 30, " " )
cInfo += ";ordKeyVal......:" + PadL( Trim( ::oDb:ordKeyVal() ), 30, " " )
cInfo += ";ordCount.......:" + PadL( ::oDb:ordCount(), 30, " " )
cInfo += ";=============[ Campos calculados ]============"
cInfo += ";Media..........:" + PadL( ::oDb:media, 30, " " )
cInfo += ";Nombre.........:" + PadL( ::oDb:nombre, 30, " " )
cInfo += ";Fecha..........:" + PadL( ::oDb:fecha, 30, " " )
msg( cInfo, "Datos del orden activo" )
::oDb:nombre := "kk"
return
//------------------------------------------------------------------------------
PROCEDURE usoLocate() CLASS TAplicacion
local GetList := {}
local xFor := space( 30 )
local xWhile := space( 30 )
local nRecOld
::limpiaPie()
@ MaxRow(), 00 SAY "Cond. FOR:" GET xFor PICTURE "@K"
@ MaxRow(), Col() + 02 SAY "Cond. WHILE:" GET xWhile PICTURE "@K"
READ
if LastKey() != K_ESC
if Updated()
if !Empty( xFor )
xFor := &( "{ || " + xFor + " }" )
else
xFor := &( "{ || NIL }" )
endif
if !Empty( xWhile )
xWhile := &( "{ || " + xWhile + " }" )
else
xWhile := &( "{ || NIL }" )
endif
::oDb:locate( xFor, xWhile )
::oBrw:refreshAll()
endif
endif
::mainMenu()
return
//------------------------------------------------------------------------------
//
PROCEDURE limpiaPie() CLASS TAplicacion
@ MaxRow(), 0 SAY Replicate( " ", MaxCol() )
return
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
// Muestra el contenido de "a" en un Alert()
//------------------------------------------------------------------------------
procedure msg( cMsg, cTitle )
if ValType( cTitle ) != 'C'
cTitle := "Atencion"
endif
Alert( cTitle + ';' + Replicate( "_", Len( cTitle ) + 2 ) + ;
";;;" + AllTrim( Transform( cMsg, "@" ) ) )
return
//------------------------------------------------------------------------------
// Muestra el contenido de "a" en un Alert() con titulo "t"
procedure muestra( a, cTitle )
local n, i, c := ""
if ValType( a ) == 'A'
i := Len( a )
for n := 1 to i
c += AllTrim( Transform( a[ n ], "@" ) ) + ";"
next
else
c += AllTrim( Transform( a, "@" ) )
endif
msg( c, cTitle )
return
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
Sí, estoy un poco por los mundos de Yupy. Aunque no se me oiga, sigo atento a lo que se cocina en el ambiente xBase...
Si vienes por Sevilla avísame y nos tomamos unas birras juntos.
Ahora, aunque no al 100% estoy enfrascado en un proyecto muy bonito...
Por otro lado terminé una TDbf PRO hecha 100% en lenguaje C.
Mira esta es la definicón de la clase en C:
/*
* Proyecto: tdbf_pro
* Fichero: tdbf_c.c
* Descripcion: Clase para manejo de DBF
* Autor: Manu Exposito
* Fecha: 12/12/2014
*/
#include "tdbf_pro.h"
//------------------------------------------------------------------------------
// Prototipo de funciones
//------------------------------------------------------------------------------
/* De Harbour: */
HB_FUNC( DBSETFILTER );
HB_FUNC( USED );
HB_FUNC( HB_DBDROP );
HB_FUNC( HB_DBEXISTS );
HB_FUNC( HB_DBRENAME );
HB_FUNC( ORDCREATE );
HB_FUNC( ORDKEYCOUNT );
HB_FUNC( ORDLISTADD );
HB_FUNC( DBSETRELATION );
HB_FUNC( DBCREATE );
HB_FUNC( DBEVAL );
HB_FUNC( FIELDBLOCK );
//------------------------------------------------------------------------------
/* Prototipo de funciones estaticas de TDbf */
static HB_AREANO selectArea( void );
static void restArea( HB_AREANO uiArea );
/* Prototipo de metodos de TDbf */
// Buffer de datos
HB_METHOD( TCDBF_LOAD );
HB_METHOD( TCDBF_SAVE );
HB_METHOD( TCDBF_UPDATE );
HB_METHOD( TCDBF_INSERT );
HB_METHOD( TCDBF_REMOVE );
HB_METHOD( TCDBF_BUFFER );
HB_METHOD( TCDBF_BUFFERLEN );
HB_METHOD( TCDBF_BUFFERKEYAT );
HB_METHOD( TCDBF_BUFFERKEYS );
HB_METHOD( TCDBF_SETBUFKEYCASEMATCH );
HB_METHOD( TCDBF_GETBUFFER );
HB_METHOD( TCDBF_GETBUFFERAT );
HB_METHOD( TCDBF_ABUFFER );
HB_METHOD( TCDBF_BLANK );
HB_METHOD( TCDBF_SETBUFFER );
HB_METHOD( TCDBF_SETBUFFERAT );
//------------------------------------------------------------------------------
HB_METHOD( TCDBF_VNULL );
HB_METHOD( TCDBF_INIT );
HB_METHOD( TCDBF_SELECT );
HB_METHOD( TCDBF_ISSELECTED );
HB_METHOD( TCDBF_GETAREA );
//------------------------------------------------------------------------------
// Work Area Methods
HB_METHOD( TCDBF_BOF );
HB_METHOD( TCDBF_EOF );
HB_METHOD( TCDBF_FOUND );
HB_METHOD( TCDBF_GOTO );
HB_METHOD( TCDBF_GOBOTTOM );
HB_METHOD( TCDBF_GOTOP );
HB_METHOD( TCDBF_SEEK );
HB_METHOD( TCDBF_SKIP );
//------------------------------------------------------------------------------
// Data Management Methods
HB_METHOD( TCDBF_APPEND );
HB_METHOD( TCDBF_DELETE );
HB_METHOD( TCDBF_DELETED );
HB_METHOD( TCDBF_FIELDCOUNT );
HB_METHOD( TCDBF_FIELDINFO );
HB_METHOD( TCDBF_FIELDNAME );
HB_METHOD( TCDBF_COMMIT );
HB_METHOD( TCDBF_FIELDGET );
HB_METHOD( TCDBF_FIELDPUT );
HB_METHOD( TCDBF_FIELDLEN );
HB_METHOD( TCDBF_RECALL );
HB_METHOD( TCDBF_RECCOUNT );
HB_METHOD( TCDBF_RECINFO );
HB_METHOD( TCDBF_RECNO );
//------------------------------------------------------------------------------
// Work Area/Database Management Methods
HB_METHOD( TCDBF_ALIAS );
HB_METHOD( TCDBF_CLOSE );
HB_METHOD( TCDBF_EVAL );
HB_METHOD( TCDBF_PACK );
HB_METHOD( TCDBF_SYSNAME );
HB_METHOD( TCDBF_OPEN );
HB_METHOD( TCDBF_INFO );
HB_METHOD( TCDBF_ZAP );
HB_METHOD( TCDBF_FREE );
//------------------------------------------------------------------------------
// Relational Operation Methods
HB_METHOD( TCDBF_SETRELATION );
HB_METHOD( TCDBF_CLEARRELATION );
HB_METHOD( TCDBF_RELAREA );
HB_METHOD( TCDBF_RELTEXT );
//------------------------------------------------------------------------------
// Order Management Methods
HB_METHOD( TCDBF_ORDCREATE );
HB_METHOD( TCDBF_ORDINFO );
HB_METHOD( TCDBF_ORDLISTADD );
HB_METHOD( TCDBF_ORDLISTCLEAR );
HB_METHOD( TCDBF_ORDSETFOCUS );
HB_METHOD( TCDBF_ORDLISTREBUILD );
// Basados en ORDINFO
HB_METHOD( TCDBF_ORDKEYCOUNT );
HB_METHOD( TCDBF_ORDKEYNO );
HB_METHOD( TCDBF_ORDKEYGOTO );
HB_METHOD( TCDBF_FULLPATH );
HB_METHOD( TCDBF_ORDKEY );
HB_METHOD( TCDBF_ORDNAME );
HB_METHOD( TCDBF_ORDBAGNAME );
HB_METHOD( TCDBF_ORDBAGEXT );
HB_METHOD( TCDBF_ORDCOND );
HB_METHOD( TCDBF_ORDNUMBER );
HB_METHOD( TCDBF_ORDCOUNT );
HB_METHOD( TCDBF_ORDKEYRELPOS );
HB_METHOD( TCDBF_ORDFINDREC );
HB_METHOD( TCDBF_ORDKEYVAL );
//------------------------------------------------------------------------------
// Filter and Scoping Methods
HB_METHOD( TCDBF_SETSCOPE );
HB_METHOD( TCDBF_SETSCOPETOP );
HB_METHOD( TCDBF_SETSCOPEBOTTOM );
HB_METHOD( TCDBF_CLEARSCOPE );
HB_METHOD( TCDBF_SETFILTER );
HB_METHOD( TCDBF_CLEARFILTER );
HB_METHOD( TCDBF_LOCATE );
HB_METHOD( TCDBF_SETLOCATE );
HB_METHOD( TCDBF_CONTINUE );
HB_METHOD( TCDBF_CLEARLOCATE );
HB_METHOD( TCDBF_FILTERTEXT );
//------------------------------------------------------------------------------
// Memo File Management Methods
HB_METHOD( TCDBF_GETVALUEFILE );
HB_METHOD( TCDBF_PUTVALUEFILE );
//------------------------------------------------------------------------------
// Network Operation Methods
HB_METHOD( TCDBF_RECLOCK );
HB_METHOD( TCDBF_UNLOCK );
HB_METHOD( TCDBF_FLOCK );
HB_METHOD( TCDBF_RECLOCKLIST );
// Miscellaneous Methods
HB_METHOD( TCDBF_USED );
//------------------------------------------------------------------------------
Se puede usar desde Xailer también. Uso como gestor de proyectos XEdit...
Algunas características TDbf PRO son:
* Hecha en lenguaje C al 100%
* Se puede usar directamente instanciando objetos directamente
* Se puede usar como clase interface para crear nuevas clases
* Se puede usar con cualquier RDD disponible
* Implementa scopes nativos
* Implementa filtros nativos
* Implementa relaciones nativas
* Implementa bloqueos simples y multiples
* Implementa buffer de edicion basado en una tablas hash
* Implementa campos calculados
Y un ejemplo de uso:
Clase específica para una DBF:
/*
* Proyecto: TDBF_PRO
* Fichero: ttest.prg
* Descripcion: Uso de los DATAFIELD para un determinado DBF y de la herencia
* Autor: Manu Exposito
* Fecha: 12/12/2014
*/
//------------------------------------------------------------------------------
#include "tdbf_pro.ch"
//------------------------------------------------------------------------------
REQUEST DBFCDX
//------------------------------------------------------------------------------
// Clase para maneja especificamente la DBF test.dbf
TDBF CLASS TTest
/*
Propiedad que contiene el nombre del fichero DBF con PATH si no esta en
mismo directorio que el ejecutable
*/
VAR cDbf INIT "test.dbf"
/*
Variables de instacia que relacionan el campo de la DBF con un miembro
del buffer (hash table)
*/
DATAFIELD First
DATAFIELD Last
DATAFIELD Street
DATAFIELD City
DATAFIELD State
DATAFIELD Zip
DATAFIELD Hiredate
DATAFIELD Married
DATAFIELD Age
DATAFIELD Salary
DATAFIELD Notes
/* Campos calculados. Se resuelven cuando se consultan */
CALCFIELD media IS ::fieldGet( 10 ) / ::fieldGet( 9 ) // Sobre la DBF
CALCFIELD nombreCompleto IS ::Last + " " + ::First // Sobre DataField
CALCFIELD nombre IS AllTrim( ::fieldGet( 2 ) ) + ", " + AllTrim( ::fieldGet( 1 ) ) // Sobre metodos
CALCFIELD id IS ::recNo()
CALCFIELD cId IS AllTrim( Str( ::recNo() ) )
CALCFIELD fecha IS DToC( Date() ) + " " + Time() // Sobre cualquier expresion
CONSTRUCTOR new()
ENDCLASS
//------------------------------------------------------------------------------
// Constructor
// Constructor de la clase. Sobrescribe al de TCDbf para especializarlo con esta
// DBF. Comprueba si existe la DBF y los indices y crea si es necesario
// Abre la DBF
METHOD new() CLASS TTest
::super:new( ::cDbf ) // Ejecuta el constructor del padre
// Comprueba si existe el fichero y si no es asi lo crea
if !::exists( ::cDbf )
msg( "Lo siento, " + ::cDbf + " no existe, la creo" )
::create( ::cDbf, { ;
{ "FIRST", "C", 20, 0 }, ;
{ "LAST", "C", 20, 0 }, ;
{ "STREET", "C", 30, 0 }, ;
{ "CITY", "C", 30, 0 }, ;
{ "STATE", "C", 2, 0 }, ;
{ "ZIP", "C", 10, 0 }, ;
{ "HIREDATE", "D", 8, 0 }, ;
{ "MARRIED", "L", 1, 0 }, ;
{ "AGE", "N", 2, 0 }, ;
{ "SALARY", "N", 6, 0 }, ;
{ "NOTES", "C", 70, 0 } ;
} )
endif
/*
Si existe el fichero lo abre con la RDD DBFCDX en entorno de red.
Comprueba la existencia de los ficheros de indices y los crea si no
existen. Por defecto se pone el foco en el primer orden.
*/
if ::exists( ::cDbf ) .and. ::open(, "DBFCDX",, .t. )
if ::exists( "test.cdx" )
::ordListAdd( "test", "nombre" )
::ordListAdd( "test", "apellido" )
else
::ordCreate( "test", "nombre", "first", { || ( ::getArea() )->first } )
::ordCreate( "test", "apellido", "last", { || ( ::getArea() )->last } )
endif
::blank() // Carga (inicializa) el buffer con valores en blanco
else
msg( "No se pudo abrir " + ::cDbf )
endif
return Self
//------------------------------------------------------------------------------
Y por fin el mantenimiento completo de una DBF. Si no existe la DBF se crea. Si no existen los indices también se crean etc, etc:
/*
* Proyecto: TDBF_PRO
* Fichero: Demo01.prg
* Descripcion: Demostraci¾«áñe la clase TCDbf
* Autor: Manu Exposito
* Fecha: 12/12/2014
*/
//-- 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
//-- Traducciones en tiempo de compilacion -----------------------------------//
#xtranslate toStr( <n> ) => ( AllTrim( Str( <n> ) ) )
//-- Includes ----------------------------------------------------------------//
#include "TDbf_pro.ch"
#include "InKey.ch"
//-- Modulo principal --------------------------------------------------------//
procedure main()
local aplicacion := TAplicacion():new()
aplicacion:ejecuta()
aplicacion:fin()
return
//-- Clase aplicacion --------------------------------------------------------//
CREATE CLASS TAplicacion
VAR oDb
VAR oBrw
CONSTRUCTOR new()
METHOD ejecuta()
METHOD cabecera()
METHOD mainMenu()
METHOD limpiaPie()
METHOD gestBrw()
METHOD genCB( n )
METHOD muestraPantalla()
METHOD insertar()
METHOD modificar()
METHOD borrar()
METHOD ayuda()
METHOD cambiaOrden()
METHOD irA()
METHOD info()
METHOD scp()
METHOD usoLocate()
METHOD consulta()
METHOD fin()
END CLASS
//------------------------------------------------------------------------------
METHOD new() CLASS TAplicacion
local oCol, n, nFld
::oDb := TTest():new()
if ::oDb:isOpen()
::oBrw := TBrowseDb( 1, 0, MaxRow() - 1, MaxCol() )
::oBrw:colorSpec := "W+/B, N/BG"
::oBrw:ColSep := " │ "
::oBrw:HeadSep := "─┼─"
::oBrw:FootSep := "─┴─"
nFld := ::oDb:FieldCount()
::oBrw:AddColumn( TBColumnNew( "ID", {|| ::oDb:id } ) )
for n := 1 to nFld
::oBrw:AddColumn( TBColumnNew( ::oDb:fieldName( n ), ::genCB( n ) ) )
next
endif
return Self
//------------------------------------------------------------------------------
PROCEDURE fin() CLASS TAplicacion
cls
if ::oDb:isOpen()
::oDb:free()
endif
msg( "Se termino..." )
return
//------------------------------------------------------------------------------
PROCEDURE ejecuta() CLASS TAplicacion
if ::oDb:isOpen()
SET DATE FORMAT TO "DD/MM/YYYY"
SET DELETED ON
if ValType( ::oBrw ) == "O"
::gestBrw()
endif
else
msg( "No se pudo abrir el fichero..." )
endif
return
//------------------------------------------------------------------------------
//
PROCEDURE mainMenu() CLASS TAplicacion
::limpiaPie()
@ 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 "F1" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Ayuda " COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F2" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Orden " COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F3" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Scope " COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ESC" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Salir " COLOR "W+/R+"
return
//------------------------------------------------------------------------------
//
PROCEDURE cabecera() CLASS TAplicacion
@ 0, 00 SAY "Ojeando la tabla: " + ::oDb:alias() + ;
PadL( " ", MaxCol(), " " ) COLOR "W+/G+"
return
//------------------------------------------------------------------------------
//
PROCEDURE gestBrw() CLASS TAplicacion
local lEnd := .f.
cls
::cabecera()
::mainMenu()
::oBrw:goTop()
while !lEnd
::oBrw:ForceStable()
switch InKey()
case K_ESC // Salir
SetPos( MaxRow(), 0 )
lEnd = .t.
EXIT
case K_DOWN // Fila siguiente
::oBrw:Down()
EXIT
case K_UP // Fila anterior
::oBrw:Up()
EXIT
case K_LEFT // Va a la columna antrior
::oBrw:Left()
EXIT
case K_RIGHT // Va a la columna siguiente
::oBrw:Right()
EXIT
case K_PGDN // Va a la pagina siguiente
::oBrw:pageDown()
EXIT
case K_PGUP // Va a la pagina antrior
::oBrw:pageUp()
EXIT
case K_CTRL_PGUP // Va al principio
::oBrw:goTop()
EXIT
case K_CTRL_PGDN // Va al final
::oBrw:goBottom()
EXIT
case K_HOME // Va a la primera columna visible
::oBrw:home()
EXIT
case K_END // Va a la ultima columna visible
::oBrw:end()
EXIT
case K_CTRL_LEFT // Va a la primera columna
::oBrw:panLeft()
EXIT
case K_CTRL_RIGHT // Va a la ultima columna
::oBrw:panRight()
EXIT
case K_CTRL_HOME // Va a la primera píŸgina
::oBrw:panHome()
EXIT
case K_CTRL_END // Va a la ·ltima píŸgina
::oBrw:panEnd()
EXIT
case K_DEL // Borra fila
::Borrar()
EXIT
case K_INS // Inserta columna
::Insertar()
EXIT
case K_ENTER // Modifica columna
::Modificar()
EXIT
case K_F1
::ayuda()
EXIT
case K_F2
::cambiaOrden()
EXIT
case K_F3
::scp()
EXIT
case K_F4
::info()
EXIT
case K_F5
::irA()
EXIT
case K_F6
// La data id y el metodo recno son sinonimos
::oDb:recLock( ::oDb:recNo() )
msg( "Rec. " + ::oDb:cId + " bloqueado" )
EXIT
case K_F7
muestra( ::oDb:recLockList(), "Registros bloqueados" )
EXIT
case K_F8
::usoLocate()
EXIT
case K_F9
::oDb:continue()
if ::oDb:found()
::oBrw:refreshAll()
else
msg( "No hay mas registros" )
endif
EXIT
case K_F10
::consulta()
EXIT
endswitch
end
return
//------------------------------------------------------------------------------
// Crea los codeblock SETGET de las columnas del browse
METHOD GenCB( n ) CLASS TAplicacion
return( {|| ::oDb:fieldGet( n ) } )
//------------------------------------------------------------------------------
// Pantalla de datos de la tabla
METHOD muestraPantalla( nTipo ) CLASS TAplicacion
local GetList := {}
local cId := ::oDb:cId
local cTipo
local lRedOnly := .f.
switch nTipo
case ID_MODIFICA
cTipo := "MODIFICANDO"
EXIT
case ID_ALTA
cTipo := "INSERTANDO"
cId := toStr( ::oDb:recCount() + 1 )
EXIT
case ID_BORRA
lRedOnly := .t.
cTipo := "BORRANDO"
EXIT
case ID_CONSUTA
lRedOnly := .t.
cTipo := "CONSULTANDO"
EXIT
endswitch
SET CURSOR ON
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY cTipo + " registro " + cId + " en tabla " + ::oDb:alias()
if !lRedOnly
@ 06, 03 SAY "First....:" GET ::oDb:First PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET ::oDb:Last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET ::oDb:Street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET ::oDb:City PICTURE "@K"
@ 10, 03 SAY "State....:" GET ::oDb:State PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET ::oDb:Zip PICTURE "@K"
@ 12, 03 SAY "Hiredate.:" GET ::oDb:Hiredate PICTURE "@K"
@ 13, 03 SAY "Married..:" GET ::oDb:Married PICTURE "@K"
@ 14, 03 SAY "Age......:" GET ::oDb:Age PICTURE "@K"
@ 15, 03 SAY "Salary...:" GET ::oDb:Salary PICTURE "@K"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET ::oDb:Notes PICTURE "@K"
else
@ 06, 03 SAY "First....: " + ::oDb:First
@ 07, 03 SAY "Last.....: " + ::oDb:Last
@ 08, 03 SAY "Street...: " + ::oDb:Street
@ 09, 03 SAY "City.....: " + ::oDb:City
@ 10, 03 SAY "State....: " + ::oDb:State
@ 11, 03 SAY "Zip......: " + ::oDb:Zip
@ 12, 03 SAY "Hiredate.: " + DToC( ::oDb:Hiredate )
@ 13, 03 SAY "Married..: " + IF( ::oDb:Married, "Si", "No" )
@ 14, 03 SAY "Age......: " + toStr( ::oDb:Age )
@ 15, 03 SAY "Salary...: " + toStr( ::oDb:Salary )
@ 16, 03 SAY "Notes:"
@ 17, 03 SAY ::oDb:Notes
endif
return( GetList )
//------------------------------------------------------------------------------
// Inserta una fila
PROCEDURE insertar() CLASS TAplicacion
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
::oDb:Blank()
GetList := ::muestraPantalla( ID_ALTA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if ::oDb:Insert()
msg( "Registro insertado" )
::oBrw:RefreshAll()
else
msg( "No se pudo insertar el registro;" + ;
"El reistro estíŸ bloqueado por otro" )
endif
endif
return
//------------------------------------------------------------------------------
// Modifica la fila actual
PROCEDURE modificar() CLASS TAplicacion
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
::oDb:Load()
GetList := ::muestraPantalla( ID_MODIFICA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if ::oDb:update()
msg( "Tupla Modificada" )
::oBrw:RefreshCurrent()
else
msg( "No se pudo actualizar el registro;" + ;
"El reistro estíŸ bloqueado por otro" )
endif
endif
return
//------------------------------------------------------------------------------
// Borra la fila actual
PROCEDURE borrar() CLASS TAplicacion
local cPant := SaveScreen( 3, 2, 18, 74 )
::oDb:Load()
::muestraPantalla( ID_BORRA )
Inkey( 2 )
if alert( "Realmente quieres borrar el registro?", { "No", "Si" } ) == 2
if ::oDb:remove()
msg( "Borrado..." )
::oBrw:RefreshAll()
else
msg( "No se pudo borrar el registro;" + ;
"El reistro estíŸ bloqueado por otro" )
endif
else
msg( "No se ha borrado..." )
RestScreen( 3, 2, 18, 74, cPant )
endif
return
//------------------------------------------------------------------------------
// Cambia el orden actual
PROCEDURE cambiaOrden() CLASS TAplicacion
local nId := ::oDb:id
local ordAnt := ::oDb:ordName()
if ordAnt == "NOMBRE"
::oDb:ordSetFocus( "APELLIDO" ) // Tambien :oDb:ordSetFocus( 2 )
else
::oDb:ordSetFocus( "nombre", "test" ) // El segundo parametro es el nombre del fichero en caso de CDX
endif
msg( "El orden anterior era " + ordAnt + ";el orden actual es " + ;
::oDb:ordName() )
::oDb:goTo( nId )
::oBrw:RefreshAll()
return
//------------------------------------------------------------------------------
// Cambia el orden actual
PROCEDURE irA() CLASS TAplicacion
local GetList := {}
local nRec := 0
local nRecOld
loca nRMax := ::oDb:recCount()
::limpiaPie()
@ MaxRow(), 15 SAY "Entre un numero entre 1 y " + toStr( nRMax ) + ;
":" GET nRec PICTURE "@K 9999999999" VALID nRec > 0 .and. nRec <= nRMax
READ
if LastKey() != K_ESC .and. Updated()
nRecOld := ::oDb:recNo()
::oDb:goTo( nRec )
if ::oDb:deleted()
msg( "Este registro esta marcado como borrado..." )
::oDb:goTo( nRecOld )
endif
::oBrw:RefreshAll()
endif
::mainMenu()
return
//------------------------------------------------------------------------------
PROCEDURE scp() CLASS TAplicacion
local GetList := {}
local cTop := space( 20 )
local cBottom := space( 20 )
local nRecOld
::limpiaPie()
@ MaxRow(), 00 SAY "Tope inicial:" GET cTop PICTURE "@K"
@ MaxRow(), Col() + 10 SAY "Tope final:" GET cBottom PICTURE "@K"
READ
if LastKey() != K_ESC
if Updated()
if cTop > cBottom
msg( "Lo siento...!!!;;;" + ;
"El tope inicial no puede ser superior al tope final" )
else
//::oDb:setScopeTop( cTop )
//::oDb:setScopeBottom( cBottom )
::oDb:setScope( cTop, cBottom )
msg( "Hay " + LTrim( Str( ::oDb:ordKeyCount() ) ) + ;
" registros que cumplen con el SCOPE" )
::oDb:goTop()
::oBrw:RefreshAll()
endif
else
::oDb:clearScope()
::oBrw:RefreshAll()
msg( ";Se han eliminado; los topes del SCOPE" )
endif
endif
::mainMenu()
return
//------------------------------------------------------------------------------
PROCEDURE consulta() CLASS TAplicacion
local cPant := SaveScreen( 3, 2, 18, 74 )
set cursor off
::oDb:Load()
::muestraPantalla( ID_CONSUTA )
Inkey( 60 )
RestScreen( 3, 2, 18, 74, cPant )
return
//------------------------------------------------------------------------------
PROCEDURE ayuda() CLASS TAplicacion
msg("F1 Ayuda ;F2 Cambio de orden ;F3 Activar Scope ;" + ;
"F4 Informacion ;F5 Ir a reg. numero;F6 Bloqueo registro;" + ;
"F7 Ver bloqueados ;F8 Uso de Locate ;F9 Siguiente locate;" + ;
"F10 Ver registro ;", "AYUDA" )
return
//------------------------------------------------------------------------------
PROCEDURE info() CLASS TAplicacion
local cInfo := ""
cInfo += " ordKeyCount....:" + PadL( ::oDb:ordKeyCount(), 30, " " )
cInfo += ";ordKeyRelPos...:" + PadL( ::oDb:ordKeyRelPos(), 30, " " )
cInfo += ";ordFullPath....:" + PadL( ::oDb:ordFullPath(), 30, " " )
cInfo += ";ordKey.........:" + PadL( ::oDb:ordKey(), 30, " " )
cInfo += ";ordKeyNo.......:" + PadL( ::oDb:ordKeyNo(), 30, " " )
cInfo += ";ordName........:" + PadL( ::oDb:ordName(), 30, " " )
cInfo += ";ordNumber......:" + PadL( ::oDb:ordNumber(), 30, " " )
cInfo += ";ordBagName.....:" + PadL( ::oDb:ordBagName(), 30, " " )
cInfo += ";ordBagExt......:" + PadL( ::oDb:ordBagExt(), 30, " " )
cInfo += ";ordKeyVal......:" + PadL( Trim( ::oDb:ordKeyVal() ), 30, " " )
cInfo += ";ordCount.......:" + PadL( ::oDb:ordCount(), 30, " " )
cInfo += ";=============[ Campos calculados ]============"
cInfo += ";Media..........:" + PadL( ::oDb:media, 30, " " )
cInfo += ";Nombre.........:" + PadL( ::oDb:nombre, 30, " " )
cInfo += ";Fecha..........:" + PadL( ::oDb:fecha, 30, " " )
msg( cInfo, "Datos del orden activo" )
::oDb:nombre := "kk"
return
//------------------------------------------------------------------------------
PROCEDURE usoLocate() CLASS TAplicacion
local GetList := {}
local xFor := space( 30 )
local xWhile := space( 30 )
local nRecOld
::limpiaPie()
@ MaxRow(), 00 SAY "Cond. FOR:" GET xFor PICTURE "@K"
@ MaxRow(), Col() + 02 SAY "Cond. WHILE:" GET xWhile PICTURE "@K"
READ
if LastKey() != K_ESC
if Updated()
if !Empty( xFor )
xFor := &( "{ || " + xFor + " }" )
else
xFor := &( "{ || NIL }" )
endif
if !Empty( xWhile )
xWhile := &( "{ || " + xWhile + " }" )
else
xWhile := &( "{ || NIL }" )
endif
::oDb:locate( xFor, xWhile )
::oBrw:refreshAll()
endif
endif
::mainMenu()
return
//------------------------------------------------------------------------------
//
PROCEDURE limpiaPie() CLASS TAplicacion
@ MaxRow(), 0 SAY Replicate( " ", MaxCol() )
return
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
// Muestra el contenido de "a" en un Alert()
//------------------------------------------------------------------------------
procedure msg( cMsg, cTitle )
if ValType( cTitle ) != 'C'
cTitle := "Atencion"
endif
Alert( cTitle + ';' + Replicate( "_", Len( cTitle ) + 2 ) + ;
";;;" + AllTrim( Transform( cMsg, "@" ) ) )
return
//------------------------------------------------------------------------------
// Muestra el contenido de "a" en un Alert() con titulo "t"
procedure muestra( a, cTitle )
local n, i, c := ""
if ValType( a ) == 'A'
i := Len( a )
for n := 1 to i
c += AllTrim( Transform( a[ n ], "@" ) ) + ";"
next
else
c += AllTrim( Transform( a, "@" ) )
endif
msg( c, cTitle )
return
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
-
Manu Exposito
- Mensajes: 116
- Registrado: Mié Feb 08, 2006 4:41 pm
XEdit... yo sigo!!!
Gracias Jose!!!!