FiveTech Software tech support forums

by **Compuin** » Wed Jan 04, 2012 2:21 pm

Buenos dias,

Alguien tiene la clase TPUBLIC para que me la envie por email? wbguerrero@gmail.com

Saludos

by **Armando** » Wed Jan 04, 2012 2:57 pm

Wilmer:

Ya debe estar en tu buzon.

Saludos

by **Compuin** » Wed Jan 04, 2012 3:06 pm

Gracias Armando

by **Antonio Linares** » Wed Jan 04, 2012 3:10 pm

Armando,

Serias tan amable de publicar su código aqui ? gracias :-)

by **Daniel Garcia-Gil** » Wed Jan 04, 2012 3:33 pm

Saludos

esta es una clase TPublic que diseñe hace un tiempo, es muy simple y corta, pero creo que abarca lo suficiente para satisfacer algunas necesidades

Code: Select all Expand view: // //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

by **Armando** » Wed Jan 04, 2012 3:39 pm

Antonio, Daniel:

No se si se trata de la misma clase, algun día alguien me la compartió, en los remarks se observan varios
nombres de los autores. honor a quíen honor merece.

Code: Select all Expand view: /* ----------------------------------------------------------------------------- * TPublic() * Clase para el reemplazo de Variables Publicas * Version 5.2b - 01/04/2006 * * Oscar 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)

Servido master, espero no infringir ningun derecho de autor.

by **Antonio Linares** » Wed Jan 04, 2012 3:49 pm

Daniel, Armando,

Gracias! :-)

by **Daniel Garcia-Gil** » Wed Jan 04, 2012 3:51 pm

Armando

No es la misma clase, esa que has publicado usa un array para el control de variables, la que diseñe crea dinamicamente Datas y Metodos directamente en la clase, lo que la hace un poco mas rapida, se le podrian añadir mas funcionalidades esta bastante "basica" y a mi criterio muy util y funcional

by **Armando** » Wed Jan 04, 2012 4:05 pm

Daniel:

Efectivamente no es la misma clase, ahora hay más tela de donde cortar, te comento que hasta hoy la clase que compartí
ha llenado mis necesidades y funciona muy bien.

Saludos

by **Daniel Garcia-Gil** » Wed Jan 04, 2012 4:30 pm

Les dejo una nueva version con nuevas funcionalidades

agregados metodos IsDefData, IsDefMethod, Save, Restore

Code: Select all Expand view: // //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

by **RSalazarU** » Thu Jan 05, 2012 12:56 am

Hola Amigos:

Muy buenas las dos clases:

Yo manejo una modificada, y con buenos resultados.

La pregunta es ¿donde se graban los valores con el método Save() y de donde los recupera Restore()?

Acá le dejo una clase adicional que graba los valores en una tabla DBF.

La idea es que las variables puedan ser compartidas, sobre todo si son de configuración.

Code: Select all Expand view: #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

Atentamente,

Rolando

Desde Cochabamba, Bolivia.

by **Daniel Garcia-Gil** » Thu Jan 05, 2012 1:12 am

Hola

RSalazarU wrote:La pregunta es ¿donde se graban los valores con el método Save() y de donde los recupera Restore()?

La guarda temporalmente en un hash y las restaura en los valores de sus datas

RSalazarU wrote:La idea es que las variables puedan ser compartidas, sobre todo si son de configuración.

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 clase

by **Compuin** » Thu Oct 04, 2018 12:05 am

Daniel Garcia-Gil wrote:Les dejo una nueva version con nuevas funcionalidades

agregados metodos IsDefData, IsDefMethod, Save, Restore

Code: Select all Expand view
// //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 Daniel/Armando

Esta TPublic podria ser funcional para Harbour tambien ?

Se le pueden agregar los metodos Get y Set ?

Gracias

by **Busmatic_wpb** » Thu Oct 04, 2018 1:01 am

Buenas Listeros
Yo he usado de la Daniel y trabaja exelente muy buena la aportacion del compañero.
Gracias por compartir .

by **Compuin** » Thu Oct 04, 2018 1:09 am

Busmatic_wpb wrote:Buenas Listeros
Yo he usado de la Daniel y trabaja exelente muy buena la aportacion del compañero.
Gracias por compartir .

Hola, la usas con Harbour ?

FiveTech Software tech support forums

Clase TPUBLIC

Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Re: Clase TPUBLIC

Who is online