FiveTech Software tech support forums

//------------------------------------------------------------------------------
// Generador de clases dinamicas funciona como una metaclase.
// Con control de referencias.

static function myGenClass( cClsName, cSuperClsName )

    static s__aClassH := {}
    local n, __nClassH, __oDb

    if Hb_IsString( cClsName )
        cClsName := Upper( Alltrim( cClsName ) )
    else
        cClsName := "THDOTABLE" + Hb_NToS( Len( s__aClassH ) )
    endif

    if ( n := AScan( s__aClassH, { | aClass | aClass[ 1 ] == cClsName } ) ) == 0
        _HB_CLASS cClsName
        __oDb := HBClass():New( cClsName, cSuperClsName )
        __oDb:Create()
        __nClassH := __oDb:hClass
        AAdd( s__aClassH, { cClsName, __nClassH } )
    else
        __nClassH := s__aClassH[ n, 2 ]
    endif

return( __clsInst( __nClassH ) )

//------------------------------------------------------------------------------
 

/*
 * Proyecto: hdo_general
 * Fichero: hdodynclass.prg
 * Descripción:  Gestión clases y datas dinamicas
 * Autor: Manu Exposito 2014-21
 * Fecha: 05/02/2021
 */
//------------------------------------------------------------------------------

#include "hdotable.ch"

//------------------------------------------------------------------------------
// Funcion de clase. Genera clases derivadas de THDOVTable

function THDOFTable( cClsName )
return myGenClass( cClsName, "THDOVTABLE" )

//------------------------------------------------------------------------------
// Meta-clase derivada de THDOTable especializada en crear DataFields

CLASS THDOVTable FROM THDOTable

    DATA lGenDataField INIT .t.     // Crea DataFields?

    METHOD genDataFields()
    METHOD genDataField( cName )

    METHOD load()                   // Sobrecribe load para creacion de DataFields
    MESSAGE open() METHOD load()

ENDCLASS

//------------------------------------------------------------------------------
// Metodo apertura/carga de datos de la tabla

METHOD load() CLASS THDOVTable

    local lRet := ::Super:Open()

    if lRet .and. ::lGenDataField
        ::genDataFields()
        ::lGenDataField := .f.
    endif

return( lRet )

//------------------------------------------------------------------------------
// Genera todas las DataFields de un objeto derivado de TMSTable especializada

procedure genDataFields() CLASS THDOVTable

    local cDataFieldName

    for each cDataFieldName in ::aColumnNames
        ::genDataField( cDataFieldName )
    next

return

//------------------------------------------------------------------------------
// Generador de DataField dinamicas

procedure genDataField( cName ) CLASS THDOVTable

    __clsAddMsg( ::ClassH, cName, { | self | ::bufferGet( cName ) }, HB_OO_MSG_INLINE )
    __clsAddMsg( ::ClassH, "_" + cName, { | self, Val | ::bufferPut( cName, Val ) }, HB_OO_MSG_INLINE )

return

//------------------------------------------------------------------------------
// Generador de clases dinamicas funciona como una metaclase.
// Con control de referencias.

static function myGenClass( cClsName, cSuperClsName )

    static s__aClassH := {}
    local n, __nClassH, __oDb

    if Hb_IsString( cClsName )
        cClsName := Upper( Alltrim( cClsName ) )
    else
        cClsName := "THDOTABLE" + Hb_NToS( Len( s__aClassH ) )
    endif

    if ( n := AScan( s__aClassH, { | aClass | aClass[ 1 ] == cClsName } ) ) == 0
        _HB_CLASS cClsName
        __oDb := HBClass():New( cClsName, cSuperClsName )
        __oDb:Create()
        __nClassH := __oDb:hClass
        AAdd( s__aClassH, { cClsName, __nClassH } )
    else
        __nClassH := s__aClassH[ n, 2 ]
    endif

return( __clsInst( __nClassH ) )

//------------------------------------------------------------------------------