• Welcome to Theos PowerBasic Museum 2017.

Dynamic strings in structures

Started by José Roca, September 24, 2007, 06:41:35 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Edwin Knoppert

Here is a version which does not require the 2nd var:

Type pvTableInfo

    pSelf               As Dword
    lParam              As Long '[-2]
    nAddref             As Long '[-1]
   
    ' Object.. don't change from here
    pObject             As Dword Ptr
    QueryInterface      As Dword
    AddRef              As Dword
    Release             As Dword

End Type                         

Declare Function AddRef( ByVal pThis As Dword Ptr ) As Long

Function CreatevTableObject( ByRef v As Variant, ByVal lParam As Dword ) As Long
    Local lpvObj As VARIANTAPI Ptr
    Local pvTable As pvTableInfo Ptr
    pvTable                 = HeapAlloc( GetProcessHeap(), %HEAP_ZERO_MEMORY, SizeOf( pvTableInfo ) )
    @pvTable.pSelf          = pvTable
    @pvTable.QueryInterface = 0
    @pvTable.AddRef         = CodePtr( AddRef )
    @pvTable.Release        = CodePtr( Release )
    @pvTable.pObject        = VarPtr( @pvTable.QueryInterface )
    @pvTable.lParam         = lParam
    lpvObj                  = VarPtr( v )
    @lpvObj.vt              = %VT_Unknown
    @lpvObj.vd.pdispVal     = VarPtr( @pvTable.pObject )
    Call Dword @pvTable.@pObject[1] Using AddRef( ByVal VarPtr( @pvTable.pObject ) )
End Function

Function AddRef( ByVal pThis As Dword Ptr ) As Long
    Incr @pThis[-1]
    MsgBox "AddRef " & Format$( @pThis[-1] ), %MB_TASKMODAL
End Function

Function Release( ByVal pThis As Dword Ptr ) As Long
    Decr @pThis[-1]

    MsgBox "Release " & Str$( @pThis[-1] ) & ", Data: " & Str$( @pThis[-2] ), %MB_TASKMODAL

    If @pThis[-1] = 0 Then

        ' free custom class data here
        '....
       
        ' Free the object from memory.
        HeapFree( GetProcessHeap(), 0, ByVal @pThis[-3] )
   
    End If   

End Function




Function Test() As Long

    ' The object which will inform you when it get's destructed using the Release() call.
    Local vObject As Variant

    ' Create the object and set custom data, this could also be a pointer to class data.
    CreateVTableObject( vObject, 123 )

    ' Create another copy
    Local v2 As Variant
    v2 = vObject
   
    ' The procedure is about to exit, PB will destroy the interface when getting out of scope.
    ' The Release() call is executed.

End Function



José Roca

#16
 

Very interesting. Thanks for sharing. It proves that classes don't need to be bloated. But the problem is not to create a class, but to store, manage and retrieve the data when you deal with strings, arrays, udts, variants... What I want to see in a future version fo the compiler is something like:


CLASS MyClass

   DIM s AS STRING
   DIM v AS VARIANT
   ' More dims - this will be static data

   INTERFACE MyInterface

   ' Methods to manage the data
   MyMethod (params...)
      LOCAL p as LONG
      ' More local variables if needed
      ' Code
   END METHOD

   ' More methods

   END INTERFACE

END CLASS

DIM pObj AS MyInterface
pObj = NEW MyClass

pObj.MyMethod (...)


Edwin Knoppert

Hah! you see..?
You make it complex right away. ( :) )
Like i said, this is the reason no one really prepared classes for pb.. since it 'must' look a la com.
This is PB, you'll never get the correct syntax, i was able to ~do as you suggest with PwrDev, i had classes in a module and when the code got generated it converted certain parts.

No my main issue was that we finally have a system which is cleaned up by the compiler for you, a deconstructer is the first one needs.
I left calling custom functions out but i had to go zzzz, i will write a better and modular class system and post it on the PB forum.
I'll try to keep it simple but it will never look like com (object.blabla)

The PwrDev classes *where* com since it bloathed it with a dispatch handler.
(Name > memberid's and so)
For PwrDev users: i never published this part since i was not satisfied with it, still to complex to work with.

For this new stuff, my methods will look like:
TheClassfunction( vObject, [other params] )

This is not an issue imo.
:)

(The lparam as i showed on creation will be removed then, a simple createobject() call would be needed)

Edwin Knoppert

#18
Here is a simple example:


Macro vthisconv = Local pThis As Dword Ptr: pThis = Variant#( vThis ): If pThis = 0 Then Exit Function

Function SetParam( ByRef vThis As Variant, ByVal Value As Long ) As Long
    vthisconv
    @pThis[-2] = Value
End Function

Function GetParam( ByRef vThis As Variant ) As Long
    vthisconv
    Function = @pThis[-2]
End Function


Called with:

SetParam( vObject, 234 )


There really seems a future with this one..

Theo Gottwald

Jose,

your example reminds me of VB.NET.

If we would really get this thing, it would be possible to represent all sorts of "real world" datastructures without workarounds directly into PB representatives.



Edwin Knoppert

I worked a few hours on this today and came up with the following.
This is the custom part iow a construction to create 'class1'
The VarClass code is uniform and does not need any attention, it's just a simple include.
The destructor might be helpful for 'your' dynamic strings issue.
I'll post this code within a few hours on the pb site.



'-----------------------------------------------------------------------
' The class's public data, there is no private data
'-----------------------------------------------------------------------

Type Class1_PublicData

    lParam              As Long
    szText              As Asciiz * 10

End Type                         

'-----------------------------------------------------------------------
' Wrapper to instantiate this class more easily
'-----------------------------------------------------------------------
Function Class1_Create( ByRef vNewObject As Variant ) As Long
    VarClass_CreateObject( vNewObject, Class1_PublicData, CodePtr( Class1_Constructor ), CodePtr( Class1_Destructor ) )
End Function

'-----------------------------------------------------------------------
' The class's contructor and destructor, these are optional.
' A destructor is useful to free memory like when using pointers in the public data and so.
'-----------------------------------------------------------------------
Function Class1_Constructor( ByVal pThis As Dword Ptr ) As Long

    MsgBox "Class1_Constructor", %MB_TASKMODAL

End Function

Function Class1_Destructor( ByVal pThis As Dword Ptr ) As Long

    MsgBox "Class1_Destructor", %MB_TASKMODAL

End Function

'-----------------------------------------------------------------------
' The class's parameters, just pass the variant object.
'-----------------------------------------------------------------------
Function Class1_SetParam( ByRef vThis As Variant, ByVal Value As Long ) As Long
    VarClass_VariantToPublicData( Class1_PublicData )
    @PublicData.lParam = Value
End Function

Function Class1_GetParam( ByRef vThis As Variant ) As Long
    VarClass_VariantToPublicData( Class1_PublicData )
    Function = @PublicData.lParam
End Function

Function Class1_SetText( ByRef vThis As Variant, szText As Asciiz ) As Long
    VarClass_VariantToPublicData( Class1_PublicData )
    @PublicData.szText = szText
End Function

Function Class1_GetText( ByRef vThis As Variant ) As String
    VarClass_VariantToPublicData( Class1_PublicData )
    Function = @PublicData.szText
End Function



Test function used.


'-----------------------------------------------------------------------
' Test function, shows how to create an instance of class1.
' It also shows how to create another reference to the same object (v2)
'-----------------------------------------------------------------------

Function Test() As Long

    ' The object which will inform you when it get's destructed using the Release() call.
    Local vObject As Variant

    ' Create the object and set custom data, this could also be a pointer to class data.
    Class1_Create( vObject )

    ' Create another reference to vObject.
    Local v2 As Variant
    v2 = vObject
    Class1_SetParam( vObject, 234 )
    Class1_SetText( vObject, Time$ )
   
    Local lParam As Long
    Local sText  As String
    lParam = Class1_GetParam( v2 )
    sText  = Class1_GetText( v2 )
    MsgBox Str$( lParam ) & ", " & sText
   
    ' The procedure is about to exit, PB will destroy the interface when getting out of scope.
    ' The Release() call is executed.

End Function


Edwin Knoppert