CLASS SETGET INLINE Nil

[José M. C. Quintas]

I am creating a intermediary class

I would like to use INLINE on SETGET, and eventually receive NIL


CREATE CLASS _HmgAppClass STATIC
   METHOD SetGetSYSDATA( nData, xValue )
   METHOD aEventInfo( xValue )        SETGET
   METHOD ControlName( xValue )       SETGET
   METHOD ThisControlName( xValue )   SETGET
   METHOD ThisEventType( xValue )     SETGET
   METHOD ThisFormIndex( xValue )     SETGET
   METHOD ThisFormName( xValue )      SETGET
   METHOD ThisType( xValue )          SETGET
   METHOD InteractiveCloseStarted     SETGET
   ENDCLASS


METHOD ThisFormIndex( xValue )            CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 194, xValue )
METHOD ControlName( xValue )              CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 203, xValue )
METHOD ThisType( xValue )                 CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 231, xValue )
METHOD ThisEventType( xValue )            CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 232, xValue )
METHOD InteractiveCloseStarted( xValue )  CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 252, xValue )
METHOD ThisFormName( xValue )             CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 316, xValue )
METHOD ThisControlName( xValue )          CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 317, xValue )
METHOD aEventInfo( xValue )               CLASS _HmgAppClass; RETURN
::SetGetSYSDATA( 330, xValue )
METHOD SetGetSYSDATA( nData, xValue ) CLASS _HmgAppClass

   IF xValue != Nil
      _HMG_SYSDATA[ nData ] := xValue
   ENDIF

   RETURN _HMG_SYSDATA[ nData ]


I would like to use:

METHOD aEventInfo( xValue ) SETGET INLINE ::SetGetSYSDATA( 330, xValue )


And second situation:

Can't set value to Nil

PCount() is not valid for this situation

Add a third parameter will be more code

example:  ::SetGetSYSDATA( 194, xValue, PCount() == 1 )

There are too many options to add there.


Does anybody have any suggestion to reduce code ?


José M. C. Quintas

[Przemyslaw Czerpak]

Hi José,

Replace in your code "xValue" with "..." and then in SetGetSYSDATA() use:

   IF PCount() >= 2
      _HMG_SYSDATA[ nData ] := HB_PValue( 2 )
   ENDIF

best regards,
Przemek

W dniu 21.08.2025 o 00:49, José M. C. Quintas pisze:

[José M. C. Quintas]

Many thanks.

It solves my question.

José M. C. Quintas

[Alex Strickland]

Hi all

Can these SETGET METHODs be added programatically to a class?

I have an ORM table class, and when setting any one of the class VARs
which are holding the values of the fields in the underlying DBF file I
would like to set a "dirty" flag in addition to the new data.

I guess a METHOD for every VAR/field is kind of expensive, but Harbour
does not seem to care about my performance worries :).

--

Regards

Alex

[lai...@paysoft.com.br]

Alex, maybe it works for what you want.

#include "hbclass.ch"

function main()

local oClass := tdbf():new()

// get

? oClass:test

// set

? oClass:test := 123

return nil

class tdbf

method new() constructor

error handler onError( ... )

endclass

method new() class tdbf

return self

method onError( ... ) class tdbf

local aParams := hb_aParams()

local cField, uValue

if len( aParams ) == 0

cField := __getMessage()

uValue := cField + " value -> your_return"

elseif len( aParams ) == 1

cField := __getMessage()

cField := substr( cField, 2, len( cField ) )

uValue := cField + " new value -> " + hb_valtostr( aParams[ 1 ] )

endif

return uValue

[Francesco Perillo]

Teorically it is possible, since objects are defined at run time. There is a problem: all the instances of a object share the same structure so if the db object is created 3 times for 3 different dbf, adding a SETGET to obj1 also add it to the other 2.... no good...

The easy way is the onerror method.

I never invested time exploring alternatives like definining a derived class named after the dbf

--
You received this message because you are subscribed to the Google Groups "Harbour Users" group.
Unsubscribe: harbour-user...@googlegroups.com
Web: https://groups.google.com/group/harbour-users
---
You received this message because you are subscribed to the Google Groups "Harbour Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email to harbour-user...@googlegroups.com.
To view this discussion visit https://groups.google.com/d/msgid/harbour-users/9ba57163-d10a-4c81-99fc-ba19d323c486%40mweb.co.za.

[Alex Strickland]

Hi Francesco

That's a very good point, would not be much of an ORM with a side effect like that!

Thanks.

--

Regards

Alex

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/CADPHLr_JHkUDS1PiriHMD-mgAsTeN5CpfCWCe8zOEUG0r6zZyw%40mail.gmail.com.

[Alex Strickland]

Hi

Thank you. I'll pursue this idea, I guess it is qute inefficient but I already said that Harbour keeps surprising me on the upside so why worry.

--

Regards

Alex

--

You received this message because you are subscribed to the Google Groups "Harbour Users" group.
Unsubscribe: harbour-user...@googlegroups.com
Web: https://groups.google.com/group/harbour-users
---
You received this message because you are subscribed to the Google Groups "Harbour Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email to harbour-user...@googlegroups.com.

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/602c7edb-d6c3-42ae-ad0b-b0399ee64795n%40googlegroups.com.

[José M. C. Quintas]

if you think on a field with name like "cli cod", it will not be valid as a class member

Seems the best would be to use as HASH, same style as ADO recordset (fields( "name" ) ).

José M. C. Quintas

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/7a5b921b-90aa-41aa-b637-6a1c5fca6cbf%40mweb.co.za.

[Francesco Perillo]

Hi Alex

I spent some time thinking about this subject... I still think the on error method is the way to go.

There are 3 alternatives:

1. create a text variable with the code to create a class named after your table/db and inheriting from the base class and compile at runtime using hb_compileFromBuf - please note that, as far as I remember, this class is NOT LGPL so you should abide to GPL....

1 bis. create the text file, write to disk, invoke harbour compiler to create a hrb, load the hrb, use the class

2. list the definition for the table/db in a file and write an handler for hbmk2 to handle those files, in the handler convert to harbour class definition in .prg files and them in the build process. Have a look at hbqt handler.

3. using the -p and -p+ flags, see how the preprocessor translate class definitions to calls to rtl functions and try to replicate them at runtime. We do something similar in hbqt directly from c so it should be possibile somehow. In both cases (prg or c) you have to add functions known to the running code... I mean, methods code should be written somewhere and it is not in this case, so you should point to a generic function that does something really similar to what you'd do in the on error block, just saving a few cpu cycles.... 

unless you are running a HFT trading system or a overload system where a single cpu clock saved is a a welcome gift, I'd go for the on error way

Francesco

PS. from time to time I tried to write some code that may resemble a ORM with different goal, the main one was to isolate the code so that moving from dbf to something else (sql? netio? letodb(f) ?) could be easier. As you know, touching legacy working code is really dangerous....

 

[Giuseppe Bogetti]

Hi all,
my solution to the problem is as follow:

- I use an array for every table used by the app where every element is a subarray defining the name of the table,
  the structure of the record and the structure of the indexes associated with the table.

- In the function used to add the table to this "dictionary" I have this piece of code that
  - creates a new class using the name of the table prefixed with "DB" inheriting from a base common class.
  - defines set/get inline methods for every field of the table relying on the common class.
  - adds a protected class data containing the structure of the table and defines an inline method to retrieve this structure.
  - saves the handle of the class in the table structure array.

FUNCTION htDBTableDefine( paTable )
  LOCAL lRetval               AS LOGICAL
  LOCAL nPos, nLen              AS NUMERIC

  //----------------------------------------------------------------------------
  // Checks Table Structure
  //----------------------------------------------------------------------------
  IF ( lRetval := htDBTableCheckStructure( paTable ) )
    //--------------------------------------------------------------------------
    // Checks if Group exists
    //--------------------------------------------------------------------------
    IF ( lRetval := HB_HHasKey( shDBGroups, paTable[ DBTBL_GROUP ] ) )
      //------------------------------------------------------------------------
      // BUILD TABLE CLASS
      //------------------------------------------------------------------------
      WITH OBJECT HBClass()
        :New( ( "DB" + paTable[ DBTBL_NAME ] ), "TDbfServer" )
        nLen                              := Len( paTable[ DBTBL_FIELDS ] )
        FOR nPos := 1 TO nLen
          :AddInline( paTable[ DBTBL_FIELDS, nPos, DBS_NAME ],                                                          ;
                      htBlockBuild( ( "Self:FieldGet( " + htASTR( nPos ) + " )" ), "Self" ) )
          :AddInline( ( "_" + paTable[ DBTBL_FIELDS, nPos, DBS_NAME ] ),                                                ;
                      htBlockBuild( ( "Self:FieldPut( " + htASTR( nPos ) + ", value )" ), "Self, value" ) )
        NEXT
        :AddClassData( "aFields", AClone( paTable[ DBTBL_FIELDS ] ), htARRAY, HB_OO_CLSTP_PROTECTED )
        :AddInline( "aStruct" , {|Self| AClone( Self:aFields ) } )

        /* Optional code used by the common base class to initialize the object */
        :AddInline( "New", {|Self, c|
                              ::cAlias  := c
                              ::oStatus := TStack():new()
                              ::InternalSetup()
                              RETURN Self
                           } )
        :Create()
        paTable[ DBTBL_SVRHNDL ]          := :hClass
      END WITH
      //------------------------------------------------------------------------
      // Update Dictionary
      //------------------------------------------------------------------------
      shDBTables[ paTable[ DBTBL_NAME ] ] := AClone( paTable )
    ENDIF
  ENDIF

RETURN lRetval


When I need to create a new table server I use the following function which checks it the table is defined in the
"dictionary" and if found use the specialized class handle to build a new object.

FUNCTION htDBTableGetServer( pcTable, pcAlias, paStruct, pcIndex )
  LOCAL oServer               AS OBJECT

  IF ( HB_IsArray( paStruct ) .AND. htDBTableCheckFieldsStructure( paStruct ) )
    oServer     := TDbfServer():New( pcTable, paStruct )
  ELSE
    IF htDBTableExist( @pcTable )
      //------------------------------------------------------------------------
      // Check alias
      //------------------------------------------------------------------------
      CHECK pcAlias     AS STRING DEFAULT pcTable
      //------------------------------------------------------------------------
      // Build Server Object
      //------------------------------------------------------------------------
      oServer := __clsInst( shDBTables[ pcTable ] [ DBTBL_SVRHNDL ] )
      oServer:New( AllTrim( pcAlias ) )
      IF htIsString( pcIndex )
        oServer:OrdSetFocus( pcIndex )
      ENDIF
    ELSE
      IF htStringIsNullOrEmpty( pcTable )
        htThrowError( "Invalid parameters", "htDBTableGetServer", 1001 )
      ELSE
        htThrowError( ( "Database table " + pcTable + " not defined." ), "htDBTableGetServer", 1002 )
      ENDIF
    ENDIF
  ENDIF

RETURN oServer

P.S. All functions starting with "ht" prefix are utility functions from my internal library.

HTH. Regards Giuseppe

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/CADPHLr-FsosPY65e6Omoqje5A-CL-C2Ah8bkUVScz-up%3DCpEGA%40mail.gmail.com.

[Francesco Perillo]

Hi Giuseppe,

thank you for your post ! Great example !

You confirm, with the code, that it is possible to create at runtime new classes and instances of those classes.

It clearly shows that we have a common ancestor to all classes (hbclass()) and that the class is an object itself. It also shows the two methods needed for SETGET, one only with the method name for the GET and one with a _ prefix for the SET

Again,

thank you

Francesco

PS: I'm curios to know why this thin layer over DBF access and if you ever compared your code to the on error style

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/CANXTJ3N7T6188Lq93stU0cimcG8kM6%3Dec-Ag-74O1s5E9dJxLg%40mail.gmail.com.

[Giuseppe Bogetti]

Hi Francesco,
thank you for the kind words.

To tell you the truth I started using the code I presented when converting from Clipper when I was still learning Harbour
and its added functionalities. I didn't know the existence of the OnError functionality. Later on I have introduced it
in the base class to be able to use tables which are not defined in the dictionary of the app by dinamically loading the
structure of the table when opened.

I haven't done any test so I don't know which of the two types of set/get management is more performant.

Regards Giuseppe

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/CADPHLr-qH%2Bgpm9Qak2WC%3DMNOQuSVTPyGtRJz4kwzr8SP9L6xtg%40mail.gmail.com.

[Alex Strickland]

Hi Francesco

Thank you, I really appreciate your thoughtful reply. There are some very creative ideas there!

--

Regards

Alex

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/CADPHLr-FsosPY65e6Omoqje5A-CL-C2Ah8bkUVScz-up%3DCpEGA%40mail.gmail.com.

[Alex Strickland]

Hi Giuseppe

That looks like it could work well for me.

I assume the the second parameter to htBlockBuild() is the parameter list for the codeblock you build?

Thank you.

--

Regards

Alex

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/CANXTJ3N7T6188Lq93stU0cimcG8kM6%3Dec-Ag-74O1s5E9dJxLg%40mail.gmail.com.

[Giuseppe Bogetti]

Hi Alex,

yes you guessed right. I attach the full code for your reference.

FUNCTION htBlockBuild( pcBlock, pcParams )

  LOCAL oErr                  AS OBJECT

  LOCAL bRetval               AS BLOCK

  TRY

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

    // Checks Parameter

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

    CHECK pcBlock   AS STRING DEFAULT ""

    CHECK pcParams  AS STRING DEFAULT ""

    IF htStringIsNullOrEmpty( pcBlock )

      BREAK

    ELSE

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

      // Look for Expression Type

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

      pcBlock       := AllTrim( pcBlock )

      IF !( Left( pcBlock, 1 ) == "{" )

        IF ( Left( pcBlock, 1 ) == "|" )

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

          // Parameters Present

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

          IF ( At( "|", SubStr( pcBlock, 2 ) ) > 0 )

            pcBlock := ( "{" + pcBlock )

          ELSE

            BREAK

          ENDIF

        ELSE

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

          // Look for Parameter Separator

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

          IF ( At( "|", SubStr( pcBlock, 1 ) ) > 0 )

            pcBlock := ( "{|" + pcBlock )

          ELSE

            pcBlock := ( "{|" + AllTrim( pcParams ) + "| " + pcBlock )

          ENDIF

        ENDIF

      ENDIF

      IF !( Right( pcBlock, 1 ) == "}" )

        pcBlock     += " }"

      ENDIF

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

      // Evaluate macro

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

      bRetval       := &pcBlock

    ENDIF

  CATCH oErr

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

    // Log Error

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

    htLogError( oErr, "CODEBLOCKS" )

    bRetval         := Nil

  END TRY

RETURN bRetval

Regards Giuseppe

To view this discussion visit https://groups.google.com/d/msgid/harbour-users/28baf889-3607-4a28-9c91-f0a2c1d19d71%40mweb.co.za.