www.FiveTechSoft.com
https://forums.fivetechsoft.com/
Code: Select all
//
//Designed by: Daniel Garcia-Gil [ danielgarciagil@gmail.com ]
//
//Class TPublic
//Create dynamically Datas
//Create "in fly" new methods
#include "hbclass.ch"
function Main
local oPublic
oPublic = TPublic():New( )
oPublic:AddMethod( "Msg", @Ok() )
oPublic:cTest = "Testing"
oPublic:nTest = 12345
oPublic:lTest = .T.
MsgInfo( oPublic:SendMsg( "lTest" ) )
oPublic:Msg( oPublic:cTest )
oPublic:Msg( oPublic:nTest )
oPublic:Msg( oPublic:lTest )
MsgInfo( "i'll change cTest Value'" )
//sending messages
oPublic:SendMsg( "_cTest", "value changed succeful by SendMsg" )
MsgInfo( oPublic:cTest )
MsgInfo( oPublic:SendMsg( "cTest" ), "Retrieve Value by SendMsg" )
oPublic:cTest = "New Value Again by inline assignment"
MsgInfo( oPublic:cTest )
oPublic:Msg( "Parameters", oPublic:cTest, oPublic:nTest, oPublic:lTest, Date(), Time() )
return nil
//------------------------------------------------//
function Ok( ... )
local aParams := hb_aParams()
local cList := "", n
for n = 1 to Len ( aParams )
cList += cValToChar( aParams[ n ] ) + Chr( 13 ) + Chr( 10 )
next
MsgInfo( cList, "Parametros:" + Str( Len( aParams ), 2 ) )
return nil
//------------------------------------------------//
CLASS TPublic
METHOD New()
METHOD AddData( cData )
METHOD AddMethod( cMethod )
METHOD DelData( cData )
METHOD DelMethod( cMethod )
METHOD SendMsg()
ERROR HANDLER ONERROR()
ENDCLASS
//------------------------------------------------//
METHOD New( ) CLASS TPublic
return Self
//------------------------------------------------//
METHOD AddData( cData ) CLASS TPublic
if ! __objHasData( Self, cData )
__objAddData( Self, cData )
endif
return nil
//------------------------------------------------//
METHOD AddMethod( cMethod, pFunc )
if ! __objHasMethod( Self, cMethod )
__objAddMethod( Self, cMethod, pFunc )
endif
return nil
//------------------------------------------------//
METHOD DelData( cData ) CLASS TPublic
if ! __objHasData( Self, cData )
__objDelMethod( Self, cData )
endif
return nil
//------------------------------------------------//
METHOD DelMethod( cMethod, pFunc ) CLASS TPublic
if ! __objHasMethod( Self, cMethod )
__objDelMethod( Self, cMethod )
endif
return nil
//------------------------------------------------//
#ifndef __XHARBOUR__
METHOD SendMsg( cMsg, ... ) CLASS TPublic
if "(" $ cMsg
cMsg = StrTran( cMsg, "()", "" )
endif
return __ObjSendMsg( Self, cMsg, ... )
#else
METHOD SendMsg( ... ) CLASS TPublic
local aParams := hb_aParams()
if "(" $ aParams[ 1 ]
aParams[ 1 ] = StrTran( aParams[ 1 ], "()", "" )
endif
ASize( aParams, Len( aParams ) + 1 )
AIns( aParams, 1 )
aParams[ 1 ] = Self
return hb_execFromArray( aParams )
#endif
//------------------------------------------------//
METHOD ONERROR( uParam1 ) CLASS TPublic
local cCol := __GetMessage()
local uRet
if Left( cCol, 1 ) == "_"
cCol = Right( cCol, Len( cCol ) - 1 )
endif
if ! __objHasData( Self, cCol )
::AddData( cCol )
endif
#ifndef __XHARBOUR__
if uParam1 == nil
uRet = __ObjSendMsg( Self, cCol )
else
uRet = __ObjSendMsg( Self, "_" + cCol, uParam1 )
endif
#else
if uParam1 == nil
uRet = hb_execFromArray( Self, cCol )
else
uRet = hb_execFromArray( Self, cCol, { uParam1 } )
endif
#endif
RETURN uRet
Code: Select all
/* -----------------------------------------------------------------------------
* TPublic()
* Clase para el reemplazo de Variables Publicas
* Version 5.2b - 01/04/2006
*
* _ Chacon
* ventas@busmatic.com
* http://www.busmatic.com
*
* Aportes: [ER] Ray Islas
* DATAS
* -----------------------------------------------------------------------------
* aVars - Arreglo de variables
* cName - Nombre ultima variable accedida
* nPos - Valor ultimo variable accedida
* automata - Asignación automatica, por defecto TRUE [WA]
*
* METODOS
* -----------------------------------------------------------------------------
* New() - Contructor
* Add() - Agrega/define nueva variable
* Del() - Borra variable
* Get() - Accede a una veriable directamente
* Set() - Define nuevo valor directamente
* GetPos() - Obtener la posición en el array
* Release() - Borra todas las variables
* IsDef() - Chequea si una variable fue definida
* Clone() - Clona la DATA aVars
* nCount() - Devuelve cantidad de variables definidas
* Save() - Salva DATA aVars
* Restore() - Restaura DATA aVars
*
* NOTA
* -----------------------------------------------------------------------------
* Para acceder al valor de una variable, se puede hacer de 2 formas,
* una directa usando oPub:Get("Codigo") o por Prueba/Error oPub:Codigo,
* este último es mas simple de usar pero más lento.
*
* Para definir un nuevo valor a una variable tambien puede ser por 2 formas,
* directamente por oPub:Set("Codigo", "ABC" ), o por Prueba/Error
* oPub:Codigo := "ABC".
*
* Atencion: Los metodos Get() y Set() no controlan si la variable existe,
* para ganar en velocidad.
*
* Las variables definidas NO son case sensitive.
*
* MODIFICACIONES Y AGREGADOS
* -----------------------------------------------------------------------------
* 2.2b Correción Bug en metodo Add() sobre FWH.
* 2.2a Modificado para não restringir o número de variáveis em [x]Harbour [WA]
* 2.2 Modificada para funcionar en [x]Harbour
*
* 2.1 Se guarda el Nombre y Posición de la última variable accedida para incrementar
* la velocidad. (Implementado por Eduardo Rizzolo)
*
* EJEMPLO
* -----------------------------------------------------------------------------
* FUNCTION Test()
* local oP := TPublic():New(), aSave, nPos
*
* oP:Add("Codigo") // Defino variable sin valor inicial
* oP:Add("Precio", 1.15) // Defino variable con valor inicial
* oP:Add("Cantidad", 10 )
* oP:Add("TOTAL" )
*
* // Acceso a variables por prueba/error
* oP:Total := oP:Precio * oP:Cantidad
*
* // Definicion y Acceso a variables directamente
* oP:Set("Total", oP:Get("precio") * oP:Get("CANTIDAD") )
*
* oP:Del("Total") // Borro una variable
* ? oP:IsDef("TOTAL") // Varifico si existe una variable
*
* nPos := oP:GetPos("Total") // Obtengo la posición en el array
* oP:aVars[nPos,2] := 0 // Modifico el Valor en el array directo
*
* aSave := oP:Save() // Guardo las Variables
* oP:Release() // Borro TODAS las variables
* oP:Restore( aSave ) // Restauro las variables
*
* oP:End() // Termino
*
* RETURN NIL
*
* EXEMPLO (Asignación Automática)
*
* FUNCTION MAIN()
* LOCAL oP:=TPublic():New(.T.)
*
* op:nome := "Wilson Alves"
* op:Endereco := "Rua dos Cravos,75"
* op:Cidade := "Londrina-PR"
* op:Celular := "9112-5495"
* op:Empresa := "WCW Software"
*
* ? op:Nome,op:Endereco,op:Cidade,op:celular,op:empresa
*
* op:End()
* RETURN NIL
*
*/
# include "FiveWin.ch"
#ifdef __xHARBOUR__
# xtranslate BYNAME <V> [, <VN> ] => ::<V> := <V> [; ::<VN> := <VN> ]
# xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>
# xtranslate BYNAME <V> IFNONIL => if <V> != NIL ; ::<V> := <V> ; endif
# xtranslate BYDEFAULT <V>, <Val> => if( <V> == NIL, <Val>, <V> )
#endif
/*
* TPublic()
*/
CLASS TPublic
DATA automata AS LOGICAL INIT .T. // [WA]
DATA aVars AS ARRAY INIT NIL
DATA nPos AS NUMERIC INIT 0 READONLY // [ER]
DATA cName AS CHARACTER INIT "" READONLY // [ER]
METHOD New( automata )
METHOD End() INLINE ::Release()
METHOD Add( cName, xValue )
METHOD Del( cName )
METHOD Get( cName )
METHOD Set( cName, xValue )
METHOD GetPos( cName )
METHOD Release()
METHOD IsDef( cName )
METHOD Clone() INLINE aClone( ::aClone )
METHOD nCount() INLINE Len( ::aVars )
METHOD Save() INLINE aClone( ::aVars )
METHOD Restore( aVars ) INLINE ::aVars := aClone( aVars )
#ifdef __HARBOUR__
ERROR HANDLER OnError( uParam1 )
#else
ERROR HANDLER OnError( cMsg, nError )
#endif
ENDCLASS
/*
* TPublic:New()
*/
METHOD New( automata ) CLASS TPublic // [WA]
::aVars := {}
* BYNAME automata DEFAULT .T. // [WA]
RETURN Self
/*
* TPublic:Add()
*/
METHOD Add( cName, xValue ) CLASS TPublic // [ER]
if cName != NIL
if (::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
::aVars[::nPos,2] := xValue
#ifndef __HARBOUR__ // [WA]
elseif Len(::aVars) < 4000 // [JJMG]
aAdd( ::aVars, { AllTrim(Upper(cName)), xValue } )
::nPos := Len(::aVars)
else
MsgAlert("Demasiadas variables definidas para la Clase TPublic()")
#else
else
aAdd( ::aVars, { AllTrim(Upper(cName)), xValue } )
::nPos := Len(::aVars)
#endif // [WA]
endif
::cName := cName
endif
RETURN Self
/*
* TPublic:Del()
*/
METHOD Del( cName ) CLASS TPublic
local nPos
if cName != NIL
if (nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
aDel( ::aVars, nPos )
::aVars := aSize( ::aVars, Len(::aVars) - 1 )
::nPos := 0
::cName := ""
endif
endif
RETURN Self
/*
* TPublic:Get()
*/
METHOD Get( cName ) CLASS TPublic // [by ER]
if cName != ::cName
::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
::cName := cName
endif
RETURN ::aVars[::nPos,2]
/*
* TPublic:Set()
*/
METHOD Set( cName, xValue ) CLASS TPublic // [by ER]
if cName != ::cName
::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
::cName := cName
endif
::aVars[::nPos,2] := xValue
RETURN Self
/*
* TPublic:GetPos() // [by ER]
*/
METHOD GetPos( cName ) CLASS TPublic
::cName := cName
RETURN ::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
/*
* TPublic:Release()
*/
METHOD Release() CLASS TPublic
ASIZE(::aVars,0)
::cName := ""
::nPos := 0
RETURN Self
/*
* TPublic:IsDef()
*/
METHOD IsDef( cName ) CLASS TPublic // [by ER]
local lOk := .F.
if cName != NIL
if (::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
::cName := cName
lOk := .T.
endif
endif
RETURN lOk
/*
* OnError()
*/
#ifdef __HARBOUR__
METHOD OnError( uParam1 ) CLASS TPublic
local cMsg := __GetMessage()
local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
#else
METHOD OnError( cMsg, nError ) CLASS TPublic
local uParam1 := GetParam( 1, 1 )
#endif
cMsg := Upper( AllTrim( cMsg ))
if SubStr( cMsg, 1, 1 ) == "_"
cMsg := SubStr( cMsg, 2 )
if cMsg == Upper(::cName)
::aVars[::nPos,2] := uParam1
elseif ( ::nPos := aScan( ::aVars, { |e,n| e[1] == cMsg } ) ) != 0
::cName := cMsg
::aVars[::nPos,2] := uParam1
else
if !::automata // [WA]
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
::cName := ""
::nPos := 0
else
::add(cmsg)
::aVars[::nPos,2] := uParam1
endif
endif
else
if cMsg == Upper(::cName) // [by ER]
RETURN ::aVars[::nPos,2]
elseif ( ::nPos := aScan( ::aVars, { |e,n| e[1] == cMsg } ) ) != 0
::cName := cMsg
RETURN ::aVars[::nPos,2]
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
::cName := ""
::nPos := 0
endif
endif
RETURN NIL
// Andrade Daniel (2001-2003)
Code: Select all
//
//Designed by: Daniel Garcia-Gil [ danielgarciagil@gmail.com ]
//
//Class TPublic
//Create dynamically Datas
//Create "in fly" new methods
#include "hbclass.ch"
//------------------------------------------------//
CLASS TPublic
DATA __hVar__
METHOD New()
METHOD AddData( cData )
METHOD AddMethod( cMethod )
METHOD DelData( cData )
METHOD DelMethod( cMethod )
METHOD IsDefData( cData ) INLINE __objHasData( Self, cData )
METHOD IsDefMethod( cMethod ) INLINE __objHasMethod( Self, cMethod )
METHOD Restore()
METHOD Save()
METHOD SendMsg()
ERROR HANDLER ONERROR()
ENDCLASS
//------------------------------------------------//
METHOD New( ) CLASS TPublic
::__hVar__ = {=>}
return Self
//------------------------------------------------//
METHOD AddData( cData ) CLASS TPublic
if ! __objHasData( Self, cData )
__objAddData( Self, cData )
endif
return nil
//------------------------------------------------//
METHOD AddMethod( cMethod, pFunc )
if ! __objHasMethod( Self, cMethod )
__objAddMethod( Self, cMethod, pFunc )
endif
return nil
//------------------------------------------------//
METHOD DelData( cData ) CLASS TPublic
if ! __objHasData( Self, cData )
__objDelMethod( Self, cData )
endif
return nil
//------------------------------------------------//
METHOD DelMethod( cMethod, pFunc ) CLASS TPublic
if ! __objHasMethod( Self, cMethod )
__objDelMethod( Self, cMethod )
endif
return nil
//------------------------------------------------//
//Return a Array with current data values
METHOD Restore() CLASS TPublic
local b := {| cKey, uValue | ::SendMsg( "_" + cKey, uValue ) }
local aOld := __objGetValueList( Self, HB_OO_DATA_SYMBOL )
#ifndef __XHARBOUR__
hb_HEVAL( ::__hVar__, b )
#else
HEVAL( ::__hVar__, b )
#endif
return aOld
//------------------------------------------------//
METHOD Save() CLASS TPublic
local aDatas
local a, cData
aDatas = __objGetValueList( Self, HB_OO_DATA_SYMBOL )
for each a in aDatas
cData = Upper( a[ 1 ] )
if cData != "__HVAR__"
::__hVar__[ cData ] = a[ 2 ]
endif
next
RETURN NIL
//------------------------------------------------//
#ifndef __XHARBOUR__
METHOD SendMsg( cMsg, ... ) CLASS TPublic
if "(" $ cMsg
cMsg = StrTran( cMsg, "()", "" )
endif
return __ObjSendMsg( Self, cMsg, ... )
#else
METHOD SendMsg( ... ) CLASS TPublic
local aParams := hb_aParams()
if "(" $ aParams[ 1 ]
aParams[ 1 ] = StrTran( aParams[ 1 ], "()", "" )
endif
ASize( aParams, Len( aParams ) + 1 )
AIns( aParams, 1 )
aParams[ 1 ] = Self
return hb_execFromArray( aParams )
#endif
//------------------------------------------------//
METHOD ONERROR( uParam1 ) CLASS TPublic
local cCol := __GetMessage()
local uRet
if Left( cCol, 1 ) == "_"
cCol = Right( cCol, Len( cCol ) - 1 )
endif
if ! __objHasData( Self, cCol )
::AddData( cCol )
endif
#ifndef __XHARBOUR__
if uParam1 == nil
uRet = __ObjSendMsg( Self, cCol )
else
uRet = __ObjSendMsg( Self, "_" + cCol, uParam1 )
endif
#else
if uParam1 == nil
uRet = hb_execFromArray( Self, cCol )
else
uRet = hb_execFromArray( Self, cCol, { uParam1 } )
endif
#endif
RETURN uRet
Code: Select all
#Include "FiveWin.ch"
#ifdef __CDXAX__
#include "ads.ch"
#endif
#ifdef __HARBOUR__
# xtranslate BYNAME <V> [, <VN> ] => ::<V> := <V> [; ::<VN> := <VN> ]
# xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>
# xtranslate BYNAME <V> IFNONIL => if <V> != NIL ; ::<V> := <V> ; endif
# xtranslate BYDEFAULT <V>, <Val> => if( <V> == NIL, <Val>, <V> )
#endif
#ifdef __CDXAX__
#define DRIVER "ADS"
#else
#define DRIVER "DBFCDX"
#endif
#define VARNAME 1
#define VARVALUE 2
FIELD Name
//----------------------------------------------------------------------------//
CLASS TDBPublic FROM TPublic
DATA cPath, cFile, oDBVariables
#ifdef __CDXAX__
DATA cFileDD, nServerType, nConnection
#endif
#ifdef __CDXAX__
METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile, cFileDD, nServerType, nConnection ) CONSTRUCTOR
#else
METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile ) CONSTRUCTOR
#endif
METHOD Reindex( ) VIRTUAL //esto ya no va porque se realiza un mantenimiento automatico
METHOD Read( cName, uDefault ) //Recupera una Variable, si no esta en ::aVars la busca en oDBVariables = "Tabla Variable"
METHOD Save( cName, uValue ) //Establece una Variable en ::aVars y en oDBVariables = "Tabla Variable"
ENDCLASS
//----------------------------------------------------------------------------//
#ifdef __CDXAX__
METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile, cFileDD, nServerType, nConnection ) CLASS TDBPublic
LOCAL nConnect
#else
METHOD New( cPath, lQuick, lRebuild, nLenVarName, lAutomatic, cFile ) CLASS TDBPublic
#endif
local cFileName,;
nAreaAnterior := Select()
Super:New( nLenVarName, lAutomatic )
DEFAULT lQuick := .T.,;
lRebuild := .F.,;
cFile := "Variable",;
cPath := SET( _SET_DEFAULT )
cPath := TRUENAME( cPath )
::cFile := cFile
::cPath := cPath
#ifdef __CDXAX__
DEFAULT cFileDD := "",;
nServerType := 0,;
nConnection := 0
::cFileDD := cFileDD
::nServerType := nServerType
::nConnection := nConnection
if nConnection > 0
AdsConnection( nConnection ) //Cambiamos la conexion a nConnection
endif
#endif
//Verificamos si se hara el Rebuild
IF lRebuild .AND.;
!MsgNoYes("Se reconstruira la tabla de VARIABLES. Usted es el unico usuario activo?","TDBVariable:New(..)")
lRebuild := .F. //si se responde que no a la pregunta, no se hace el Rebuild
ENDIF
#ifdef __CDXAX__
cFileName := cFile
#else
cFileName := cPath + "\" + cFile
#endif
#ifdef __CDXAX__
IF ( !lQuick .OR. lRebuild ) .AND. nServerType < ADS_AIS_SERVER
#else
IF ( !lQuick .OR. lRebuild )
#endif
#ifdef __CDXAX__
IF !_AdsIsTablePresent( cFile ) .OR. lRebuild
if nServerType>0
_AdsDDDecriptTable( cFile )
endif
#else
IF ! File( cFileName + ".dbf" ) .OR. lRebuild
#endif
Rebuild( cFile, cPath,;
{ { "NAME", "C", nLenVarName, 0 },;
{ "TYPE", "C", 1, 0 },;
{ "VALUE", "C", 256, 0 } }, DRIVER )
USE ( cFileName ) NEW EXCLUSIVE
INDEX ON UPPER(FIELD->NAME) TAG "NAME" TO ( cFileName ) FOR ! Deleted() UNIQUE
USE
ENDIF
ENDIF //End lQuick
#ifdef __CDXAX__
//Mantenimiento de la tabla
//OJO!!!! Falta: Elim. duplicados y reindexar
//REOJO!!!!!: al tener el valor UNIQUE el indice de la tabla, y reindexarla, no es necesario borrar lo registros duplicados
if nServerType < ADS_AIS_SERVER .AND. SELECT( cFile ) = 0
TRY
USE ( cFileName ) NEW EXCLUSIVE
PACK //tb se reindexa, y al tener el valor UNIQUE en el indice de la tabla, y ahora reindexarla, no es necesario borrar lo registros duplicados
//REINDEX //al tener el valor UNIQUE en el indice de la tabla, y ahora reindexarla, no es necesario borrar lo registros duplicados
//Verificamos si la Longitud de los nombres de Variable es la correcta...
//si no es asi, colocamos la señal para que mas tarde se haga el ReBuild()
lRebuild := .F.
IF .NOT. (LEN(FIELD->NAME) = ::nLenVarName)
lRebuild := .T.
ENDIF
USE
//para hacer el Rebuild(), primero hemos cerrado el area de trabajo
IF lRebuild
if nServerType>0
_AdsDDDecriptTable( cFile )
endif
Rebuild( cFile, cPath,;
{ { "NAME", "C", ::nLenVarName, 0 },;
{ "TYPE", "C", 1, 0 },;
{ "VALUE", "C", 256, 0 } }, DRIVER )
USE ( cFileName ) NEW EXCLUSIVE
INDEX ON UPPER(FIELD->NAME) TAG "NAME" TO ( cFileName ) FOR ! Deleted() UNIQUE
USE
ENDIF
CATCH
END TRY
endif
TRY
USE ( cFileName ) NEW SHARED
CATCH
if nServerType < ADS_AIS_SERVER .AND.;
!EMPTY(cFileDD) .AND.;
nConnection > 0 .AND.;
AdsDDAddTable( cFile, cPath + "\" + cFile + ".dbf", cPath + "\" + cFile + OrdBagExt(), nConnection ) //Enlazamos a un AdsDD si se puede
USE ( cFileName ) NEW SHARED
else
MsgStop("No se pudo abrir la tabla: " + cPath +"\"+ cFile + ".Dbf", "TDBVariable(..)")
DBSELECTAREA( nAreaAnterior )
return nil
endif
END TRY
#else
//Mantenimiento de la tabla
//OJO!!!! Falta: Elim. duplicados y reindexar
//REOJO!!!!!: al tener el valor UNIQUE el indice de la tabla, y reindexarla, no es necesario borrar lo registros duplicados
if SELECT( cFile ) = 0
TRY
USE ( cFileName ) NEW EXCLUSIVE
PACK
//REINDEX //al tener el valor UNIQUE en el indice de la tabla, y ahora reindexarla, no es necesario borrar lo registros duplicados
//Verificamos si la Longitud de los nombres de Variable es la correcta...
//si no es asi, colocamos la señal para que mas tarde se haga el ReBuild()
IF .NOT. LEN(FIELD->NAME) = ::nLenVarName
lRebuild := .T.
ENDIF
USE
IF lRebuild
Rebuild( cFile, cPath,;
{ { "NAME", "C", ::nLenVarName, 0 },;
{ "TYPE", "C", 1, 0 },;
{ "VALUE", "C", 256, 0 } }, DRIVER )
USE ( cFileName ) NEW EXCLUSIVE
INDEX ON UPPER(FIELD->NAME) TAG "NAME" TO ( cFileName ) FOR ! Deleted() UNIQUE
USE
ENDIF
CATCH
END TRY
endif
USE ( cFileName ) NEW SHARED
#endif
SET ORDER TO 1
DATABASE ::oDBVariables
::oDBVariables:bEoF = nil
DBSELECTAREA( nAreaAnterior )
return Self
//------------------------------------//
//Read(cVar, uDefault) Read Variable, retorna el valor de la variable establecida en la tabla VARIABLES
METHOD Read( cName, uDefault ) CLASS TDBPublic
LOCAL uValue
cName := AllTrim(Upper(cName))
IF ::Get( cName ) = NIL
//Recuperar del archivos de variables
::oDBVariables:SetOrder( "NAME" )
IF ::oDBVariables:Seek( cName, .F. )
IF uDefault <> NIL .AND. ValType(uDefault) <> ::oDBVariables:Type
::oDBVariables:Type := ValType(uDefault)
::oDBVariables:Save()
ENDIF
DO CASE
CASE ::oDBVariables:Type $ "CM"
uValue := RTRIM(::oDBVariables:Value) //en el caso de las variables caracter/memo se les quita los blancos de la derecha
CASE ::oDBVariables:Type = "N"
uValue := VAL(RTRIM(::oDBVariables:Value))
CASE ::oDBVariables:Type = "D"
uValue := CTOD(::oDBVariables:Value)
CASE ::oDBVariables:Type = "L"
uValue := UPPER(RTRIM(::oDBVariables:Value))=".T."
CASE ::oDBVariables:Type = "A"
uValue:=ARRAY(VAL( SubStr(::oDBVariables:Value,AT("[",::oDBVariables:Value)+1,AT("]",::oDBVariables:Value)-AT("[",::oDBVariables:Value)-1) ))
AEVAL(uValue, {|x,i| uValue[i] := ::Read("{"+cValToChar(i)+"}"+cName) } )
CASE ::oDBVariables:Type $ "UO"
uValue := NIL
CASE ::oDBVariables:Type = "B" //Los CodeBlock solo se los puede restaurar. !No se los puede salvar!.
//La edicion de estas variables es direcctamente en la tabla
//uValue := GenBlock( ::oDBVariables:Value )
END CASE
if AT("{",cName)>0 .AND. AT("}",cName)>0
RETURN uValue
else
::nPos := ASCAN( ::aVars, {|aVal| aVal[ VARNAME ] == cName } )
::aVars[::nPos, VARVALUE] := uValue
endif
ELSE
Return ::Save( cName, uDefault )
ENDIF
endif
RETURN ::aVars[::nPos, VARVALUE]
//----------------------------------------------------------------//
//Save(cName, uValue ) Salva el valor de Variable en el arreglo ::aVars y la graba a la tabla Variables
METHOD Save( cName, uValue ) CLASS TDBPublic
cName := AllTrim(Upper(cName))
DEFAULT uValue := ::Get(cName)
::Set( cName, uValue )
IF !( cName == ::oDBVariables:NAME)
::oDBVariables:SetOrder( "NAME" )
IF ! ::oDBVariables:Seek( cName, .F. )
::oDBVariables:APPEND()
::oDBVariables:NAME := cName
ENDIF
ENDIF
::oDBVariables:TYPE := ValType(uValue)
IF ::oDBVariables:TYPE="A" //para grabar arreglos
::oDBVariables:VALUE := cValToChar(uValue)+"["+cValToChar(LEN(uValue))+"]"
::oDBVariables:Save()
AEVAL(uValue, {|uValue,i| ::Save("{"+cValToChar(i)+"}"+cName, uValue) } )
else
::oDBVariables:VALUE := cValToChar(uValue)
::oDBVariables:Save()
ENDIF
return uValue
La guarda temporalmente en un hash y las restaura en los valores de sus datasRSalazarU wrote:La pregunta es ¿donde se graban los valores con el método Save() y de donde los recupera Restore()?
es una de las ventajas que tiene la clase, puede crear metodos dinamicamente y si quieres que los guarde los valores, fisicamente puedes crear la funcion y asignarla como un metodo o simplemete modificar la claseRSalazarU wrote:La idea es que las variables puedan ser compartidas, sobre todo si son de configuración.
Hola Daniel/ArmandoDaniel Garcia-Gil wrote:Les dejo una nueva version con nuevas funcionalidades
agregados metodos IsDefData, IsDefMethod, Save, Restore
Code: Select all
// //Designed by: Daniel Garcia-Gil [ danielgarciagil@gmail.com ] // //Class TPublic //Create dynamically Datas //Create "in fly" new methods #include "hbclass.ch" //------------------------------------------------// CLASS TPublic DATA __hVar__ METHOD New() METHOD AddData( cData ) METHOD AddMethod( cMethod ) METHOD DelData( cData ) METHOD DelMethod( cMethod ) METHOD IsDefData( cData ) INLINE __objHasData( Self, cData ) METHOD IsDefMethod( cMethod ) INLINE __objHasMethod( Self, cMethod ) METHOD Restore() METHOD Save() METHOD SendMsg() ERROR HANDLER ONERROR() ENDCLASS //------------------------------------------------// METHOD New( ) CLASS TPublic ::__hVar__ = {=>} return Self //------------------------------------------------// METHOD AddData( cData ) CLASS TPublic if ! __objHasData( Self, cData ) __objAddData( Self, cData ) endif return nil //------------------------------------------------// METHOD AddMethod( cMethod, pFunc ) if ! __objHasMethod( Self, cMethod ) __objAddMethod( Self, cMethod, pFunc ) endif return nil //------------------------------------------------// METHOD DelData( cData ) CLASS TPublic if ! __objHasData( Self, cData ) __objDelMethod( Self, cData ) endif return nil //------------------------------------------------// METHOD DelMethod( cMethod, pFunc ) CLASS TPublic if ! __objHasMethod( Self, cMethod ) __objDelMethod( Self, cMethod ) endif return nil //------------------------------------------------// //Return a Array with current data values METHOD Restore() CLASS TPublic local b := {| cKey, uValue | ::SendMsg( "_" + cKey, uValue ) } local aOld := __objGetValueList( Self, HB_OO_DATA_SYMBOL ) #ifndef __XHARBOUR__ hb_HEVAL( ::__hVar__, b ) #else HEVAL( ::__hVar__, b ) #endif return aOld //------------------------------------------------// METHOD Save() CLASS TPublic local aDatas local a, cData aDatas = __objGetValueList( Self, HB_OO_DATA_SYMBOL ) for each a in aDatas cData = Upper( a[ 1 ] ) if cData != "__HVAR__" ::__hVar__[ cData ] = a[ 2 ] endif next RETURN NIL //------------------------------------------------// #ifndef __XHARBOUR__ METHOD SendMsg( cMsg, ... ) CLASS TPublic if "(" $ cMsg cMsg = StrTran( cMsg, "()", "" ) endif return __ObjSendMsg( Self, cMsg, ... ) #else METHOD SendMsg( ... ) CLASS TPublic local aParams := hb_aParams() if "(" $ aParams[ 1 ] aParams[ 1 ] = StrTran( aParams[ 1 ], "()", "" ) endif ASize( aParams, Len( aParams ) + 1 ) AIns( aParams, 1 ) aParams[ 1 ] = Self return hb_execFromArray( aParams ) #endif //------------------------------------------------// METHOD ONERROR( uParam1 ) CLASS TPublic local cCol := __GetMessage() local uRet if Left( cCol, 1 ) == "_" cCol = Right( cCol, Len( cCol ) - 1 ) endif if ! __objHasData( Self, cCol ) ::AddData( cCol ) endif #ifndef __XHARBOUR__ if uParam1 == nil uRet = __ObjSendMsg( Self, cCol ) else uRet = __ObjSendMsg( Self, "_" + cCol, uParam1 ) endif #else if uParam1 == nil uRet = hb_execFromArray( Self, cCol ) else uRet = hb_execFromArray( Self, cCol, { uParam1 } ) endif #endif RETURN uRet
Hola, la usas con Harbour ?Busmatic_wpb wrote:Buenas Listeros
Yo he usado de la Daniel y trabaja exelente muy buena la aportacion del compañero.
Gracias por compartir .