I tested a little... and came to the result it does not work as expected so I did not finish this to more functionality yet - has a couple of useless functions now, but shows what I was up to. Because no retrieving of type possible I just pass it as parameter on Create
The types get recognized and used correctly - but just once per script execution. Calling twice the same sub with a different type to use will always dim the type again that was dim'ed the very first time... The example is a little longer, for try out/ see what I mean just exchange the order of the Test-call at end of script
#MINVERSION 1.9.12.0.
Uses "console"
Type t_virtual_object
pData As DWord
sType As String
lSize As Long
Create As Function
Destroy As Function
End Type
Function t_virtual_object.Create(ByVal sType As String, Optional ByVal lNum As Long) As DWord
Local data Like sType
If lNum < 1 Then lNum = 1 ' = Ubound/Index
Me.pData = HEAP_Alloc(SizeOf(data) * lNum)
Me.sType = sType
Me.lSize = SizeOf(data) ' store size of one element, not to get too complicated
Return Me.pData
End Function
Function t_virtual_object.Destroy() As DWord
If HEAP_Size(Me.pData) Then HEAP_Free(Me.pData)
Me.pData = 0
Me.sType = ""
Return 0
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - -
Type t_vec3d
' some simple vector with a few functions for example
X As Double
Y As Double
Z As Double
GetProperties As Function
GetX As Function
GetY As Function
GetZ As Function
SetX As Function
SetY As Function
SetZ As Function
SetXYZ As Function
End Type
Function t_Vec3d.GetProperties() As String
Function = "t_Vec3d has X,Y and Z"
End Function
Function t_vec3d.GetX() As Double
Return Me.X
End Function
Function t_vec3d.GetY() As Double
Return Me.Y
End Function
Function t_vec3d.GetZ() As Double
Return Me.Z
End Function
Function t_vec3d.SetX(ByVal X As Double) As Double
Me.X = X
Return X
End Function
Function t_vec3d.SetY(ByVal Y As Double) As Double
Me.Y = Y
Return Y
End Function
Function t_vec3d.SetZ(ByVal Z As Double) As Double
Me.Z = Z
Return Z
End Function
Function t_vec3d.SetXYZ(ByVal X As Double, ByVal Y As Double, ByVal Z As Double) As Double
Me.X = X
Me.Y = Y
Me.Z = Z
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - -
Type t_RGB
' and some color-type with functions also
R As Byte
G As Byte
B As Byte
GetProperties As Function
GetR As Function
GetG As Function
GetB As Function
GetColor As Function
SetR As Function
SetG As Function
SetB As Function
SetRGB As Function
SetColor As Function
End Type
Function t_RGB.GetProperties() As String
Function = "t_RGB has R,G and B"
End Function
Function t_RGB.GetR() As Byte
Return Me.R
End Function
Function t_RGB.GetG() As Byte
Return Me.G
End Function
Function t_RGB.GetB() As Byte
Return Me.B
End Function
Function t_RGB.GetColor() As Long
Local lColor As Long
Memory_Copy( VarPtr(Me), VarPtr(lColor), 3)
Function = lColor
End Function
Function t_RGB.SetR(ByVal R As Byte) As Byte
Me.R = R
Return R
End Function
Function t_RGB.SetG(ByVal G As Byte) As Byte
Me.G = G
Return G
End Function
Function t_RGB.SetB(ByVal B As Byte) As Byte
Me.B = B
Return B
End Function
Function t_RGB.SetColor(ByVal lColor As Long) As Long
Memory_Copy(Varptr(lColor),Varptr(Me),3)
Function = lColor
End Function
' -------------------------------------------------------------
' three different types now
' have some global "objects":
Dim Colors As t_virtual_object
Dim Vectors As t_virtual_object
Vectors.Create("t_vec3d", 12) ' space for an array of 12 vecs
Colors.Create("t_RGB", 34) ' and some space for 34 colors
' now do the rest inside some subs/functions to keep the stuff "private"
Sub Test(what As t_virtual_object)
If HEAP_Size(what.pData) < 1 Then PrintL "Error- no data!": Exit Sub
Local data(HEAP_Size(what.pData)/what.lSize) Like what.sType At what.pData
PrintL data(1).GetProperties
End Sub
Test Colors
Test Vectors
PrintL "----------------------------"
PrintL "All done, press a key to end"
WaitKey
Bookmarks