//----------------------------------------------------------------------------//
// 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 )
//----------------------------------------------------------------------------//
hmpaquito wrote:1) "Teniendo en cuenta que (como seguramente tarde o temprano sucede) la aplicación de escritorio compartirá datos con aplicaciones web"... "Solo si nuestra aplicación vive aislada se pueden utilizar con esas particularidades"... eso no es cierto... una aplicación puede usar dos motores de datos: uno RDD y otro SQL. El SQL se utilizará para los datos remotos.
hmpaquito wrote:2) "Infinidad de herramientas de migración 'automágicas'" No estoy de acuerdo pq algunas de esas herramientas permitían una programación híbrida text GUI/ graphica GUI y eso facilitaba muchisimo la migracion de los programas. Y por no decir que lastima que entonces no hubiera existido el hbQTWidgets de Pritpal Bedi que se "come" todo el codigo Clipper y genera una aplicacion "Windows's style like".
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 46 guests