//----------------------------------------------------------------------------//
// AUTOR.....: Manuel Expósito Suárez Soft4U 2002-2006 //
// eMail.....:
manuexposito@... //
// CLASE.....: Pt03.prg //
// FECHA MOD.: 11/12/2006 //
// VERSION...: 5.02 //
// PROPOSITO.: Ejemplo de mantenimiento simple de una tabla //
//----------------------------------------------------------------------------//
//-- 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"
//-- Modulo principal --------------------------------------------------------//
procedure main()
local cHost := "127.0.0.1"
local cUser := "root"
local cPwd := "root"
local cDb := "E1Prueba"
local cTable := "Test"
local oCon, oTb
local aStruct := { ;
{ "FIRST", "C", 20, 00 },;
{ "LAST", "C", 20, 00 },;
{ "STREET", "C", 30, 00 },;
{ "CITY", "C", 30, 00 },;
{ "STATE", "C", 02, 00 },;
{ "ZIP", "C", 10, 00 },;
{ "HIREDATE", "D", 08, 00 },;
{ "MARRIED", "L", 01, 00 },;
{ "AGE", "N", 02, 00 },;
{ "SALARY", "N", 06, 00 },;
{ "NOTES", "C", 70, 00 } ;
}
SET DATE FORMAT TO "DD/MM/YYYY"
cls
// Creamos objeto conexion
oCon := TMSConnect():New()
// Intentamos la conexion
if oCon:Connect( cHost, cUser, cPwd )
// Comprobamos si ya existe la DB
if oCon:ExistDataBase( cDb )
Alert( "Ya existe la DB: " + AllTrim( cDb ) )
else
oCon:CreateDataBase( cDb )
endif
oCon:SelectDataBase( cDb )
/*
if oCon:SetCharacterSet( "utf8" )
Alert( "Se activó el juego de caracteres UTF8" )
else
Alert( "No se pudo activar el juego de caracteres UTF8" )
endif
*/
// Creo el objeto Tabla con DataField
oTb := TMyTable( cTable ):New( oCon, cTable )
// Establezco el relleno de espacios (menos optimo)
if oCon:oDataBase:ExistTable( oTb:cName )
Alert( "Ya existe la tabla: " + oTb:cName )
else
// Creamos la tabla
if !oTb:CreateTable( aStruct )
Alert( "Error al crear la tabla " + oTb:cName )
oTb:Free()
oCon:Free()
return
else
Alert( "Se ha creado la tabla..." )
endif
endif
oTb:SetReadPADAll( .t. )
// Abro la tabla
if oTb:Open()
; Alert( "Se abrió" )
// Si no hay registros insertamos uno para que funcione el Browse
if ( oTb:RecCount() == 0 )
; Alert( "reccount == 0" )
// Si no hay datos al meno introducimos uno...
// Llenamos el buffer con los valores
oTb:aBuffer := { "Manu", ;
"Exposito", ;
"Formentera", ;
"SE", ;
"SP", ;
"41700", ;
date(), ;
.t., ;
42, ;
150000, ;
"Mi priemer registro..." }
// Inserto el registro y traigo el resultado al cliente
oTb:Insert( .t. )
endif
// Abrimos el Browse
GestBrw( oTb )
endif
// Liberamos la memoria ocupada por el objeto tabla
oTb:Free()
endif
// Liberamos la memoria de la conexion
oCon:Free()
return
//-- Modulos auxiliares ------------------------------------------------------//
//----------------------------------------------------------------------------//
// Gestion completa de una tabla MySQL
static procedure GestBrw( oTb )
local oBrw, oCol
local lEnd := .f.
local nKey, n, nFld
oBrw := TBrowseNew( 1, 0, MaxRow() - 1, MaxCol() )
oBrw:colorSpec := "W+/B, N/BG"
oBrw:ColSep := " ³ "
oBrw:HeadSep := "ÄÅÄ"
oBrw:FootSep := "ÄÁÄ"
// Asignamos los bloques de codigo de movimientos del cursor
// de datos
MySetBrowse( oBrw, oTb )
nFld := oTb:FieldCount()
FOR n := 1 TO nFld
oBrw:AddColumn( TBColumnNew( oTb:FieldName( n ), GenCB( oTb, n ) ) )
NEXT
cls
@ 0, 0 SAY PadC( "Ojeando la tabla: " + ;
upper( oTb:cName ), 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_DOWN // Fila siguiente
oBrw:Down()
case nKey == K_F3
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( "Encontrado..." )
else
Alert( "Valor no encontrado..." )
oTb:GoTop()
endif
oBrw:RefreshAll()
case nKey == K_F6 // Busca siguiente columna
if oTb:FindNext()
Alert( "Encontrado..." )
else
Alert( "Valor no encontrado..." )
oTb:GoTop()
endif
oBrw:RefreshAll()
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( oTb, oBrw )
case nKey = K_INS // Inserta columna
Insertar( oTb, oBrw )
case nKey = K_ENTER // Modifica columna
Modificar( oTb, oBrw )
case nKey == K_F1 // Algunos datos
Alert( "Datos de la tabla " + oTb:cName + ";" + ;
";Registro actual......: " + Str( oTb:RecNo() ) + ;
";Total de registros...: " + Str( oTb:RecCount() ) + ;
";Total de columnas....: " + Str( oTb:FieldCount() ) )
endcase
end
return
//----------------------------------------------------------------------------//
// Crea los codeblock SETGET de las columnas del browse
static function GenCB( oTb, n )
return( { || oTb:FieldGet( n ) } )
//----------------------------------------------------------------------------//
// Pantalla de datos de la tabla
static function PantMuestra( oTb, 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( oTb:Id )
end
SET CURSOR ON
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY cTipo + " registro en tabla " + oTb:cName + " - Numero: " + cId
@ 06, 03 SAY "First....:" GET oTb:First PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET oTb:Last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET oTb:Street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET oTb:City PICTURE "@K"
@ 10, 03 SAY "State....:" GET oTb:State PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET oTb:Zip PICTURE "@K"
@ 12, 03 SAY "Hiredate.:" GET oTb:Hiredate PICTURE "@K"
@ 13, 03 SAY "Married..:" GET oTb:Married PICTURE "@K"
@ 14, 03 SAY "Age......:" GET oTb:Age PICTURE "@K"
@ 15, 03 SAY "Salary...:" GET oTb:Salary PICTURE "@K"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET oTb:Notes PICTURE "@K"
return( GetList )
//----------------------------------------------------------------------------//
// Inserta una fila
static procedure Insertar( oTb, oBrw )
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
oTb:Blank()
GetList := PantMuestra( oTb, ID_ALTA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if oTb:Insert()
Alert( "Tupla insertada" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oBrw:goBottom()
oBrw:RefreshAll()
endif
endif
endif
return
//----------------------------------------------------------------------------//
// Modifica la fila actual
static procedure Modificar(oTb,oBrw )
local GetList := {}
local nRecNo := oTb:RecNo()
local cPant := SaveScreen( 3, 2, 18, 74 )
oTb:Load()
GetList := PantMuestra( oTb, ID_MODIFICA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if oTb:Update()
Alert( "Tupla modificada" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
endif
return
//----------------------------------------------------------------------------//
// Borra la fila actual
static procedure Borrar( oTb, oBrw )
local nRecNo := oTb:RecNo()
if Alert( "Realmente quieres borrar el registro?", { "Si", "No" } ) == 1
if oTb:Delete( , 1 )
Alert( "Borrado en el servidor" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
else
Alert( "Mo 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:SetOrder( i )
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
uVal := oTb:FieldGet( nCol )
@ 7, 10 SAY "Entre valor buscado:" GET uVal PICTURE "@K"
READ
lRet := oTb:Find( nCol, uVal, .t. )
return( lRet )
//----------------------------------------------------------------------------//
Sin conexión 
Enviar mensaje