Hi all,
I store my UDT variable to a pointer with Varptr function. I then retrieve it with GetWindowLong function. So far so good. I got the same number here. But how do i convert this pointer (or number) to my udt variable ?
Here are the code lines for clarity.
SetWindowLong(me.mHandle, -21, Varptr(Me)) '// After creating window, I store my type here.
Function WndProc(hwnd As DWord, message As DWord, wParam As DWord, lParam As Long) As DWord
Dim t = GetWindowLong(hwnd, -21) '// Here i got the number.
Dim myWin As TWindow = t '// Won't work.
... '// Function continues
ErosOlmi
09-04-2021, 19:21
I post an example with some comments hoping it can help you a bit
Pointers in thinBasic can be done in many ways and maybe I can improve it again.
uses "console"
Type TMyUdt
ALong as Long
aExt as ext
AString as String
'-----------------------------
' Automatically called when an UDT of TMyUdt is created
'-----------------------------
function _Create() as Long
'-----------------------------
Printl "A tMyUDt variable has been created"
printl " Fill some data:"
me.ALong = 1234
me.aExt = 1234.56789
me.AString = "This is a dynamic string inside an UDT"
printl " me.ALong :", me.ALong
printl " me.aExt :", me.aExt
printl " me.AString :", me.AString
end Function
'-----------------------------
' Automatically called when an UDT of TMyUdt is destroyed
'-----------------------------
function _Destroy() as Long
'-----------------------------
'---Do something, if needed
Printl "A tMyUDt variable has been destroyed"
end Function
'-----------------------------
function ToString() as string
'-----------------------------
function = "ALong: '" + me.ALong + "', aExt: '" + me.aExt + "', AString: '" + me.AString + "'"
end Function
end Type
'---Create a new UDT variable and allocate in global memory space so it is available everywhere
global MyUdt as tMyUdt
'---Now create a pointer to a MyUdt variable and assign it a pointer to the first byte of MyUdt variable
local pMyUdt as tMyUdt Ptr
pMyUdt = varptr(MyUdt)
'---From now on, using pMyUdt is like using MyUdt
printl " pMyUdt.ALong :", pMyUdt.ALong
printl " pMyUdt.aExt :", pMyUdt.aExt
printl " pMyUdt.AString :", pMyUdt.AString
printl " pMyUdt.ToString :", pMyUdt.ToString
'---You can pass the pointer to a function and access the same global UDT
function MyUdtUsingAPtrToMyUdtInAFunction(byval p as long) as long
'---Create a local pointer usinf to a tMyUdt type and point it to p
'---'At' declare a virtual variable that in reality is a pointer that point to memory area
'---You can point immediately At ... some memory or set it 'At 0' and use SetAt(...) later when needed
local lMyUdt as tMyUdt at p
printl
printl " MyUdt Data inside function:", lMyUdt.ToString
end Function
'---Call the function and pass the pointer using GetAt. GetAt accept a pointer and retunr the memory area where the pointer points
MyUdtUsingAPtrToMyUdtInAFunction(getat(pMyUdt))
PrintL
printl "---All done---" in %CCOLOR_BLIGHTCYAN
WaitKey
@ErosOlmi,
Thanks for the detaild reply. It seems that pointers in thinbasic is pretty easy and straight forward. Before you posting the reply, I've managed to find a way with "At" keyword. Petr helped me. With this knowledge, I am going to re-arrange my code. I hope I can come up with a better result.
ReneMiner
10-04-2021, 04:12
lets say this is my udt, ...it can give you the name of the variable that was defined at the varptr.if the name is of use for you...
script :
'---Script created on 04-09-2021 23:44:27 by RM
uses "console"
' "abusing" the sdk-functions here
' to obtain a list of dimensioned variable names:
Declare Function thinBasic_VariableGetList _
LIB "thinCore.DLL" _
Alias "thinBasic_VariableGetList" _
( _
Optional _
ByVal lStackLevel As Long , _
ByVal sSep As String _
) As String
' to find out the variables name that has equal varptr :
declare function thinBasic_VariableGetInfoEX _
lib "thinCore.DLL" _
alias "thinBasic_VariableGetInfoEX" _
( _
byval SearchKey as string , _
byref MainType as long , _ '---ATTENTION: parameter passed BYREF will return info
byref SubType as long , _ '---ATTENTION: parameter passed BYREF will return info
byref IsArray as long , _ '---ATTENTION: parameter passed BYREF will return info
byref DataPtr as long , _ '---ATTENTION: parameter passed BYREF will return info
ByRef nElements As Long , _ '---ATTENTION: parameter passed BYREF will return info
Optional _
ByVal WhichLevel As Long _
) As Long
' arbitrary udts:
type tTestUDT1
X as Byte
end Type
type tTestUDT2
y as Long
end type
' global scope (1)
Global testglobal1 as tTestUDT1
global testglobal2 as tTestUDT2
function getVariableNameFromPtr( byval udtPtr as Dword,
byRef varName$ As String,
optional byval scope as Long = 3 ) as Long
' expected varptr of a dimensioned udt or variable
' provide dimensioned string-variable to receive the variables name
' scope should be 1= global only ,
' 2 =local only
' 3= check both
' will return the scope where it was found or 0 if not found
' so you know if the provided string contains any information
String sList, sName()
Long nNames, Maintype, SubType, IsArray, DataPtr, nElements
long lResult, lRetVal
scope = minmax(scope, 1, 3)
lResult = scope
do
if (lResult and 2) then
sList = thinBasic_VariableGetList( 2, crlf)
scope = 2
elseif (lResult and 1) then
sList = thinBasic_VariableGetList( 1, crlf)
scope = 1
EndIf
nNames = parse sList, sName, CRLF
while nNames
' search backwards to find latest dimensioned variables as first
lRetVal = thinBasic_VariableGetInfoEX( sName(nNames),
MainType, SubType,
IsArray,
DataPtr,
nElements,
scope)
if DataPtr = udtPtr Then
varname$ = sName(nNames)
return scope
endif
decr nNames
Wend
lResult = iif(lResult and 2, lResult - 2, 0)
loop until lResult = 0
end function
'#############################################################
' (just helper/function to make the printout structured and tbMain more readable)
function WaitNext( byval sOutput as string ) as String
printl
printl repeat$(30, "=-") in %ccolor_fyellow
if sOutput <> "" then
printl String$(5, $tab) & "press [esc] to abort" in %CCOLOR_FlightCYAN
printl String$(5, $tab) & "any other key to continue with " & sOutput in %ccolor_flightcyan
else
printl String$(5, $tab) & "press any key to end" in %ccolor_flightcyan
endif
select case Waitkey()
case "[ESC]"
Stop
case Else
if sOutput = "" then stop
function = selectexpression
end select
PrintL
end function
function tbmain()
' local scope = 2
local testLocal1 as tTestUDT1
local testLocal2 as tTestUDT2
dword theVarPtr
string theName
Long scope
printl "there are 4 variables dimensioned. For you to see" in %ccolor_flightred
printl "their names tell if globally or locally. For the engine" in %ccolor_flightred
printl "the names do not mean anything." in %ccolor_flightred
printl
printl string$(5, $tab) & "starting with test 1" in %ccolor_flightcyan
printl
printl "theVarptr = varptr(testGlobal2)" in %ccolor_fintensewhite
theVarptr = varptr(testGlobal2)
printl
printl "calling now"
printl "scope = GetVariablenameFromPtr(theVarPtr, theName)"
scope = GetVariablenameFromPtr(theVarPtr, theName)
printl "received scope = " & tstr$(scope)
printl " (0= n.a., 1 = global, 2 = local )"
print "theName: "
printl theName in %ccolor_fintensewhite
printl
WaitNext( "test 2")
theName = ""
scope = 0
printl "(variables cleared)" in %ccolor_flightGreen
printl
printl "theVarptr = varptr(testLocal1)" in %ccolor_fintensewhite
theVarptr = varptr(testLocal1)
printl
printl "calling now"
printl "scope = GetVariablenameFromPtr(theVarPtr, theName)"
scope = GetVariablenameFromPtr(theVarPtr, theName)
printl "received scope = " & tstr$(scope)
printl " (0 = n.a., 1 = global, 2 = local )"
print "theName: "
printl theName in %ccolor_fintensewhite
printl
WaitNext( "test 3")
theName = ""
scope = 0
printl "(variables cleared)" in %ccolor_flightGreen
printl
printl "theVarptr = varptr(testLocal2)" in %ccolor_fintensewhite
theVarptr = varptr(testLocal2)
printl
printl "calling now"
printl "scope = GetVariablenameFromPtr(theVarPtr, theName)"
scope = GetVariablenameFromPtr(theVarPtr, theName)
printl "received scope = " & tstr$(scope)
printl " (0 = n.a., 1 = global, 2 = local )"
print "theName: "
printl theName in %ccolor_fintensewhite
printl
WaitNext( "test 4")
theName = ""
scope = 0
printl "(variables cleared)" in %ccolor_flightGreen
printl
printl "theVarptr = varptr(testglobal1)" in %ccolor_fintensewhite
theVarptr = varptr(testglobal1)
printl
printl "calling now"
printl "scope = GetVariablenameFromPtr(theVarPtr, theName)"
scope = GetVariablenameFromPtr(theVarPtr, theName)
printl "received scope = " & tstr$(scope)
printl " (0 = n.a., 1 = global, 2 = local )"
print "theName: "
printl theName in %ccolor_fintensewhite
printl
waitNext("")
End Function
you can as well keep track on your variables if you create 2 corresponding arrays. i.e. 2 Arrays where the element(1) of the first array is related to element(1) of the second array. In your case you want to store varType and varPtr...
since you can use Dim ... Like ... At ... -syntax it's very simple to create a variable from a typename stored to a string at any position in memory. If you know what type was created at the address you can dim something there that equals the original.
Its a "virtual" variable / just a named memory address but lets you access it as if it were a variable of the type you assign / and does not occupy any additional memory.
Lets have an example:
'---Script created on 04-10/2021 very early by RM
uses "console"
' an udt that will keep track of variables and handle the
' storage of type and associated varptr
'#############################################################
type tVarTypeStore
pVarptrs as String ' these are actually dynamic arrays of dwords
pTypenames as String ' (a matter of interpretation)
' saves us the repeated redim if just append
' new elements to both strings
'=============================================================
Function AddVar(byref theVariable as anytype) as dword
' determine the variables type and pointer
string sType, sPart()
long nParts
Dword pType
sType = typeOf(theVariable) ' returns like "UDT.theName" or "Number.Long"
' we only need the part after the dot so split up
nParts = parse sType, sPart, "."
' and take the last part that we store to a list where each typename will be
' stored once only. that will save unnecessary allocation of memory and
' allows to compare the typename-pointers : same pointer = same typename
pType = Me.GetTypePtr( sPart(nParts) )
' after the function below took care of storing the name and giving us
' the pointer to the storage location we can save the varptr and the typename
' to be equal indexed array-elements
me.pVarptrs &= MKDWD$(varptr(theVariable))
me.pTypenames &= MKDWD$(pType)
' Mkdwd$ will make a dword variable to appear as 4 bytes string (=32bit)
' means all items in those 2 strings have a length of 4 bytes.
' to retrieve a type look down to Function TypeByPtr$()
function = pType
end function
'=============================================================
function GetTypePtr(byval sType as string,
optional byval onlyTest as boolean ) as DWord
' this will check if the name was already stored. If you pass true for onlyTest
' then it will return 0 if the type was not stored yet.
' if onlyTest = 0 | False it will store the types name
' and returns where to read the types name using Heap_Get()
static pAllTypes as Dword
' the function will memorize all pointers where the typenames are stored
' and keep the pointer of that pointer-list in this local static variable
dword pType ' will hold where the typename is stored
long idx ' might indicate if the type was stored already
If HEAP_Size(pAllTypes) Then ' are there any pointers already?
' place virtual Dword-array upon the pointer-list:
Local vPtr(HEAP_Size(pAllTypes)/4) As DWord At pAllTypes
' scan if any of the list points the requested type-name
' (Array Scan x Ptr only works upon pointer-arrays of Type DWord)
idx = Array Scan vPtr Ptr, = sType
' idx holds now the index or 0 if not found
'if found, return the pointer that is stored at position idx
If Idx Then Return vPtr(idx)
EndIf
' if not found and only test then reply no, not available:
if onlyTest then return 0
' sType is new, we store it
pType = HEAP_AllocByStr(sType)
' append the new pointer to function-static pAllTypes
' heap_Set will free and reallocate the memory in one go
' requires to provide a dword-variable that holds the actual pointer
' and will be updated with the new pointer
' set the content to be the previous content and append the binary representation
' of a DWord-Variable. To convert the Dword into binary string use MkDwd$
Heap_Set(pAllTypes, HeAP_Get(pAllTypes) & MKDWD$(pType))
' the counter/operation for all MK...$ is CV... (see help)
' MK...$( will, also, accept, plenty, of, params, ... )
' now the new type was stored, its pointer is stored in
' a list and the pointer to that list is contained in pAllTypes
' any other variable of the same type can receive the same number now
' finally return where the name is stored:
Function = pType
end function
'=============================================================
function TypeByPtr$(byval pVariable as dword) as string
long lPos
if lenf(me.pVarptrs) = 0 Then
msgbox("ERROR, there are no variables stored here", %mb_iconerror, function_name)
Stop
endif
' now tell the interpreter to interpret the strings as dword-arrays
local vPtr(lenf(me.pVarptrs)/sizeof(Dword)) as Dword At strptr(me.pVarptrs)
' now a virtual array of pointers covers the string
' scan the array now for the member thats pointer is equal to passed pVariable
lPos = array scan vptr, = pVariable
if lPos then
' lPos is the index of the matching item in the array of pointers.
' now place the virtual array upon the other string that points typenames
setat(vPtr, strPtr(me.pTypenames))
' and the vPtr(lPos) tells us where to read the type
return heap_get(vPtr(lPos))
else
' the matching pointer is not stored here. to prevent from an error we
Return "BYTE"
' if you test the result then you know it can not be an udt and will not
' use the variable. if you comment the above it could as well
msgBox("ERROR - the requested varptr is not stored here", %mb_iconError, function_name)
Stop
EndIf
End Function
end type
'#############################################################
' (just helper/function to make the printout structured and tbMain more readable)
function WaitNext( byval sOutput as string ) as String
printl
printl repeat$(30, "=-") in %ccolor_fyellow
if sOutput <> "" then
printl String$(5, $tab) & "press [esc] to abort" in %CCOLOR_FlightCYAN
printl String$(5, $tab) & "any other key to continue with " & sOutput in %ccolor_flightcyan
else
printl String$(5, $tab) & "press any key to end" in %ccolor_flightcyan
endif
select case Waitkey()
case "[ESC]"
Stop
case Else
if sOutput = "" then stop
function = selectexpression
end select
PrintL
end function
'=============================================================
'[] globals
' using to thinBasic built-in udts here for test
global test1 as filetime
global test2 as SYSTEMTIME
global test3 as dateInterval
' and the vartype-storage should be global
' else you had to make the udt-elements of it to be static
global VarTypeStore as tVarTypeStore
'=============================================================
function tbmain()
dword pReturned, theVarPtr
printl "there are 3 global udts dimensioned." in %ccolor_flightred
printl "it will introduce them to the vartypeStore first" in %ccolor_flightred
printl "and ask the types from the pointers later." in %ccolor_flightred
printl
printl string$(5, $tab) & "starting with test 1" in %ccolor_flightcyan
printl
printl "pReturned = varTypeStore.AddVar(test1)" in %ccolor_fintensewhite
pReturned = varTypeStore.AddVar(test1)
printl "result: 0x" & hex$(pReturned,8) & " points to : " & heap_get(pReturned)
printl
printl "pReturned = varTypeStore.AddVar(test2)" in %ccolor_fintensewhite
pReturned = varTypeStore.AddVar(test2)
printl "result: 0x" & hex$(pReturned,8) & " points to : " & heap_get(pReturned)
printl
printl "pReturned = varTypeStore.AddVar(test3)" in %ccolor_fintensewhite
pReturned = varTypeStore.AddVar(test3)
printl "result: 0x" & hex$(pReturned,8) & " points to : " & heap_get(pReturned)
printl
WaitNext( "test 2")
printl
printl "theVarptr = varptr(test2)" in %ccolor_fintensewhite
theVarptr = varptr(test2)
printl "Vartypestore.TypeByPtr$(theVarptr) = " & Vartypestore.TypeByPtr$(theVarptr)
printl
printl "theVarptr = varptr(test3)" in %ccolor_fintensewhite
theVarptr = varptr(test3)
printl "Vartypestore.TypeByPtr$(theVarptr) = " & Vartypestore.TypeByPtr$(theVarptr)
printl
printl "theVarptr = varptr(test1)" in %ccolor_fintensewhite
theVarptr = varptr(test1)
printl "Vartypestore.TypeByPtr$(theVarptr) = " & Vartypestore.TypeByPtr$(theVarptr)
printl
waitNext("")
End Function
Now i guess that will show you a way - not the way everyone would choose, but it leads to the goal.
when you receive a varptr of a variable that was stored, you request
String sType= Vartypestore.TypeByPtr$(theVarptr)
and
Dim x Like sType At theVarPtr
and x will be exactly the element that you need
Happy coding!
@ReneMiner,
Thanks for the example code. It's really helpful since the code is well commented. Let me study it. :)