//----------------------------------------------------------------------------//
// AUTOR.....: Manuel Exp¾sito Sußrez Soft4U 2002-2010 //
// CLASE.....: Pt45.prg //
// FECHA MOD.: 11/04/2010 //
// VERSION...: 6.00 //
// PROPOSITO.: Ejemplo de mantenimiento simple de una tabla //
// Como unir la potencia de los RDD y el objeto TMSTable //
//----------------------------------------------------------------------------//
//-- 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"
#include "Eagle1.ch"
//-- Fuerza el enlazado -----------------------------------------------------//
REQUEST HB_GT_WIN
//-- Modulo principal --------------------------------------------------------//
procedure main()
local cDb := "E1Prueba"
local cTable := "Test"
local cHost := "127.0.0.1"
local cUser := "root"
local cPwd := "root"
local oCon := TMSConnect():New()
local nWA
SET DATE FORMAT TO "DD/MM/YYYY"
cls
oCon:Connect( cHost, cUser, cPwd, cDb )
if oCon:lConnected
// Se inicia el sistema E1RDD
InitE1RDD( oCon )
// A partir de aquÝ como una DBF
USE test NEW ALIAS test VIA "E1RDD"
nWA := Select( "test" )
GestBrw( nWA )
else
Alert( "No se pudo conectar..." )
endif
// Liberamos la memoria de la conexion
oCon:Free()
return
//-- Modulos auxiliares ------------------------------------------------------//
//----------------------------------------------------------------------------//
// Gestion completa de una tabla MySQL
static procedure GestBrw( nWA )
local oBrw, oCol
local lEnd := .f.
local nKey, n, nFld
local oTb := GetTableObject( nWA )
oTb:SetTinyAsLogical( .t. )
oBrw := TBrowseNew( 1, 0, MaxRow() - 1, MaxCol() )
oBrw:goTopBlock := { || ( nWA )->( DbGoTop() ) }
oBrw:goBottomBlock := { || ( nWA )->( DbGoBottom() ) }
oBrw:SkipBlock := { | n | ( nWA )->( E1DbSkipper( n ) ) }
oBrw:colorSpec := "W+/B, N/BG"
oBrw:ColSep := " │ "
oBrw:HeadSep := "─┼─"
oBrw:FootSep := "─┴─"
nFld := ( nWA )->( FCount() )
FOR n := 1 TO nFld
oBrw:AddColumn( TBColumnNew( PADL( n, 2, "0" ) + "-" + ;
( nWA )->( FieldType( n ) ) + "-" + ;
( nWA )->( FieldName( n ) ), ;
GenCB( nWA, n ) ) )
NEXT
cls
@ 0, 0 SAY PadC( "Ojeando la tabla: " + ;
upper( Alias( nWA ) ), MaxCol() + 1, " " ) COLOR "W+/G+"
@ MaxRow(), 0 SAY "INS" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Altas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ENTER" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Mod." 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 "F4" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Orden" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F5" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Busca" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F6" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Busca ->" 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_F3 // Activa o desactiva forzar ancho columna
oTb:SetReadPADAll( !oTb:SetReadPADAll() )
oBrw:Configure()
case nKey == K_F4 // Establece el orden
if ElOrden( oTb )
oBrw:goTop()
endif
case nKey == K_F5 // Busca valor en columna
if !BuscaValor( oTb )
Alert( "Valor no encontrado..." )
endif
oBrw:RefreshAll()
case nKey == K_F6 // Busca siguiente columna
if !oTb:FindLikeNext()
Alert( "Valor no encontrado..." )
endif
oBrw:RefreshAll()
case nKey == K_UP // Fila anterior
oBrw:Up()
case nKey == K_DOWN // Fila siguiente
oBrw:Down()
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( nWA, oBrw )
case nKey = K_INS // Inserta columna
Insertar( nWA, oBrw )
case nKey = K_ENTER // Modifica columna
Modificar( nWA, oBrw )
case nKey == K_F1 // Algunos datos
Alert( "Datos de la tabla " + Alias( nWA ) + ";" + ;
";Registro actual......: " + Str( ( nWA )->( RecNo() ) ) + ;
";Total de registros...: " + Str( ( nWA )->( RecCount() ) ) + ;
";Total de columnas....: " + Str( ( nWA )->( FCount() ) ) )
endcase
end
return
//----------------------------------------------------------------------------//
// Crea los codeblock SETGET de las columnas del browse
static function GenCB( nWA, n ) ; return( { || ( nWA )->( FieldGet( n ) ) } )
//----------------------------------------------------------------------------//
// Pantalla de datos de la tabla
static function PantMuestra( nWA, 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 := StrNum( ( nWA )->Id )
end
SET CURSOR ON
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY cTipo + " registro en tabla " + Alias( nWA ) + " - Numero: " + cId
@ 06, 03 SAY "First....:" GET ( nWA )->First PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET ( nWA )->Last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET ( nWA )->Street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET ( nWA )->City PICTURE "@K"
@ 10, 03 SAY "State....:" GET ( nWA )->State PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET ( nWA )->Zip PICTURE "@K"
@ 12, 03 SAY "Hiredate.:" GET ( nWA )->Hiredate PICTURE "@K"
@ 13, 03 SAY "Married..:" GET ( nWA )->Married PICTURE "@K"
@ 14, 03 SAY "Age......:" GET ( nWA )->Age PICTURE "@K"
@ 15, 03 SAY "Salary...:" GET ( nWA )->Salary PICTURE "@K"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET ( nWA )->Notes PICTURE "@K"
return( GetList )
//----------------------------------------------------------------------------//
// Inserta una fila
static procedure Insertar( nWA, oBrw )
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
( nWA )->( DbAppend() )
GetList := PantMuestra( nWA, ID_ALTA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
( nWA )->( DbCommit() )
Alert( "Tupla insertada" )
oBrw:goBottom()
oBrw:RefreshAll()
endif
return
//----------------------------------------------------------------------------//
// Modifica la fila actual
static procedure Modificar( nWA, oBrw )
local GetList := {}
local nRecNo := ( nWA )->( RecNo() )
local cPant := SaveScreen( 3, 2, 18, 74 )
GetList := PantMuestra( nWA, ID_MODIFICA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
( nWA )->( DbCommit() )
( nWA )->( DbGoTo( nRecNo ) )
oBrw:RefreshAll()
endif
return
//----------------------------------------------------------------------------//
// Borra la fila actual
static procedure Borrar( nWA, oBrw )
local nRecNo := ( nWA )->( RecNo() )
if Alert( "Realmente quieres borrar el registro?", { "Si", "No" } ) == 1
( nWA )->( DbDelete() )
Alert( "Borrado en el servidor" )
( nWA )->( DbGoTo( nRecNo ) )
oBrw:RefreshAll()
else
Alert( "No se ha borrado..." )
endif
return
//----------------------------------------------------------------------------//
// Establece un nuevo orden de visualizacion
static function ElOrden( oTb )
local i := oTb:FieldCount()
local aFld := Array( i )
local n, lRet
FOR n := 1 TO i
aFld[ n ] := oTb:FieldName( n )
NEXT
DispBox( 5, 9, 10, 25, B_BOX )
i := 0
i := AChoice( 6, 10, 9, 24, aFld )
if lRet := ( i > 0 )
Alert( "Ordenado por la columna: " + StrNum( i ) + " " + oTb:FieldName( i ) )
oTb:SetOrderBy( i,, .t. )
endif
return( lRet )
//----------------------------------------------------------------------------//
// Busca un valor de una columna
static function BuscaValor( oTb )
local GetList := {}
local nCol := 0
local lRet, uVal
DispBox( 5, 5, 8, 75, B_BOX )
@ 6, 10 SAY "Entre numero de columna:" GET nCol PICTURE "@K"
READ
if nCol > 0 .and. nCol <= oTb:FieldCount()
uVal := oTb:FieldGet( nCol )
@ 7, 10 SAY "Entre valor buscado:" GET uVal PICTURE "@K"
READ
// Ojo cuando es tipo caracter (x)Harbour mete espacios hasta el final
// del ancho del campo
uVal := if( ValType( uVal ) == "C", AllTrim( uVal ), uVal )
lRet := oTb:FindLike( nCol, uVal, .t. )
else
lRet := .f.
Alert( "Emtre un n·mero de columna correcto" )
endif
return( lRet )
//----------------------------------------------------------------------------//