Here is a more complete version (I still have ideas on improving this).
================================================================================================
New Data Type
Variant
Usage: Use when declaring a variant variable.
Example: Dim VariantList(10) as Variant
Example: TempVariant as Variant
Note: The Variant data type is a DWord data type and the two data types are interchangeable. However, for good programming practices, using the Variant data type when declaring a variant will help in understanding the intention of the variant variable.
================================================================================================
New Command:
DV_Cast, DV_[DataType], To_[DataType]
Usage:
Return Value = DV_Cast DV_[DataType] <value> To_[DataType]
Transforms the <value> provided based on the input [DataType] and Output [DataType], and stores the result in the Return Value.
Command structure:
DV_Cast
Use the DV_Cast command to begin the command sentence.
DV_[DataType]
Use the DV_DataType to indicate the type of input value that follows. Valid DataType Commands are: DV_Variant, DV_DWord, DV_Integer, DV_Float, and DV_String.
<value>
This can be any value of any data type (excluding doubles). The data type of this value must match the preceding DV_[DataType] command. Using a data type other than that specified by the DV_DataType command may cause errors or a crash.
To_[DataType] This command indicates the data type for the return value. This ensures the output value matches the data type of the Return Value. Valid DataType Commands are: To_Variant, To_DWord, To_Integer, To_Float, and To_String.
Return Value:
This can be any data type variable, but it must match the To_[DataType] command. The value returned will be appropriate for the To_[DataType]. Using other data types will likely cause errors or a crash.
Example 1:
MyVariant as Variant
MyFloat as Float
MyString as String
MyInteger as Integer
MyFloat = 1.23
MyVariant = DV_Cast DV_Float MyFloat To_Variant
MyString = DV_Cast DV_Variant MyVariant To_String
MyInteger = DV_Cast DV_String MyString To_Integer
================================================================================================
New Function:
Return Integer = _DV_Get_Variant_Type(Value as Variant)
Return String = _DV_Get_Variant_Type$(Value as Variant)
The first form of this function returns a numeric value indicating the Variant data type; 1=DWord, 2=Integer, 3=Float, 4=String, 0=Unknown
The second form of this function returns a string indicating the Variant data type.
In both functions, the provided variant must be a valid variant or the results will be 0 or "Unknown"
================================================================================================
New Function:
_DV_Clean_Variant(Value as Variant)
This function frees the memory locations of the variant in memory. When a Variant is re-assigned a value, regardless of the data type, a new memory location is created. The only way to prevent this from becoming a memory leak is to clean up variants using this function prior to assigning a variant a new value. This function can be used safely with an unassigned variant (a null variant).
================================================================================================
Code snippet.
`========================================================================
`=DARK VARIANTS DEMO=====================================================
`========================================================================
`By Patrick Lewis
`Created 07/22/2009
`Remstart
Dim MyArray(4) as Variant
MyArray(0) = DV_Cast DV_Integer 15 To_Variant
MyArray(1) = DV_Cast DV_String "Hello" To_Variant
MyArray(2) = DV_Cast DV_String "World" To_Variant
MyArray(3) = DV_Cast DV_Float 173.5 To_Variant
MyArray(4) = DV_Cast DV_String "-535" To_Variant
For i = 0 to 4
Print "Variant #";i;" is a data type of ";_DV_Get_Variant_Type$(MyArray(i))
Next i
Print
v1 = DV_Cast DV_Variant MyArray(0) To_Integer
v2$ = DV_Cast DV_Variant MyArray(1) To_String
v3$ = DV_Cast DV_Variant MyArray(2) To_String
v4# = DV_Cast DV_Variant MyArray(3) To_Float
v5 = DV_Cast DV_Variant MyArray(4) To_Integer
v6$ = DV_Cast DV_Variant MyArray(4) To_String
v7$ = DV_Cast DV_Float v4# To_String
v8# = DV_Cast DV_String "96.8" To_Float
Print "Integer->Variant->Integer: ";v1
Print "String-->Variant->String: ";v2$
Print "String-->Variant->String: ";v3$
Print "Float--->Variant->Float: ";v4#
Print "String-->Variant->Integer: ";v5
Print "String-->Variant->String: ";v6$
Print "Float--->String: ";v7$
Print "String-->Float: ";v8#
Wait key
End
`Remend
`========================================================================
`=DARK VARIANTS==========================================================
`========================================================================
`By Patrick Lewis
`Created 07/21/2009
`Requires IanM's Matrix1Utils (Thanks IanM!)
`Returns a numeric value representing the variant's data type:
`1=DWord, 2=Integer, 3=Float, 4=String, 0=Unknown
Function _DV_Get_Variant_Type(VariantID as DWord)
If VariantID<1 Then ExitFunction 0
If Variant_Is_Valid(VariantID)=0 Then ExitFunction 0
vtype=Peek Byte(VariantID)
if vtype<1 or vtype>4 then vtype=0
EndFunction vtype
`Returns a string value indicating the variant's data type.
Function _DV_Get_Variant_Type$(VariantID as DWord)
If VariantID<1 Then ExitFunction "Unknown"
If Variant_Is_Valid(VariantID)=0 Then ExitFunction "Unknown"
vtype=Peek Byte(VariantID)
vtype$="Unknown"
Select vtype
Case 1:vtype$="DWord":EndCase
Case 2:vtype$="Integer":EndCase
Case 3:vtype$="Float":EndCase
Case 4:vtype$="String":EndCase
EndSelect
EndFunction vtype$
`Use to clean up a variant's memory. Recommended for use before assigning a new value to an exisitng variant.
Function _DV_Clean_Variant(VariantID as DWord)
MemLoc as DWord
If Variant_Is_Valid(VariantID)
MemLoc = Peek DWord(VariantID+1)
Free MemLoc
Free VariantID
Index=VariantDataLoc_Find_Entity(VariantID)
VariantDataLoc_Delete_Element(Index)
EndIf
EndFunction
Function _DVCastValue()
InType as Byte
OutType as Byte
Value as DWord
RetVal as DWord
MemLoc as DWord
Global DVtemp$ as String
arglist = Open Arglist()
InType = Arglist Byte(arglist)
Value = Arglist DWord(arglist)
OutType = Arglist Byte(arglist)
`Defensive Code
If InType = 0 And Variant_Is_Valid(Value)=0
Select OutType
Case 3:RetVal=Cast Float To DWord(0.0):EndCase
Case 4:DVtemp$="Error":RetVal=Get String Ptr(DVtemp$):EndCase
Case Default:RetVal=0:EndCase
EndSelect
ExitFunction RetVal
EndIf
`If the input data type is a variant, then convert the intype to the variant type and change the value to the stored value.
If InType = 0
`If the intype and outtype are both variants, then just pass the variant memory location to the Return Value and exit.
If OutType = 0
RetVal = Value
ExitFunction RetVal
EndIf
`Get the variant information.
VType=Peek Byte(Value)
MemLoc=Peek DWord(Value+1)
If VType=4
Value=MemLoc
Else
Value=Peek DWord(MemLoc)
EndIf
InType =VType
EndIf
Select InType
Case 3
Select OutType
Case 0
RetVal=Allocate_Variant()
Poke Byte RetVal,3
MemLoc=Alloc(4)
Poke DWord RetVal+1,MemLoc
Poke DWord MemLoc,Value
EndCase
Case 3
RetVal=Value
EndCase
Case 4
v#=Cast Dword to Float(Value)
DVTemp$=Str$(v#)
RetVal=Get String Ptr(DVTemp$)
EndCase
Case Default
v#=Cast Dword to Float(Value)
RetVal=v#
EndCase
EndSelect
EndCase
Case 4
s$=Peek String(Value)
Select OutType
Case 0
RetVal=Allocate_Variant()
Poke Byte RetVal,4
MemLoc=Alloc String(s$)
Poke DWord RetVal+1,MemLoc
EndCase
Case 3
v#=Val(s$)
RetVal=Cast Float To Dword(v#)
EndCase
Case 4
RetVal=Value
EndCase
Case Default
RetVal=Val(s$)
EndCase
EndSelect
EndCase
Case Default
Select OutType
Case 0
RetVal=Allocate_Variant()
Poke Byte RetVal,InType
MemLoc=Alloc(4)
Poke DWord RetVal+1,MemLoc
Poke DWord MemLoc,Value
EndCase
Case 4
v#=Cast Dword to Float(Value)
DVTemp$=Str$(v#)
RetVal=Get String Ptr(DVTemp$)
EndCase
Case Default
RetVal=Value
EndCase
EndSelect
EndCase
EndSelect
EndFunction RetVal
Function Allocate_Variant()
MemLoc as Dword
MemLoc= Alloc(5)
VariantDataLoc_Add_EntityID(MemLoc)
EndFunction MemLoc
Function Variant_Is_Valid(VariantID as DWord)
Index as Integer
Index=VariantDataLoc_Find_Entity(VariantID)
Flag=(Index>-1)
EndFunction Flag
#CONSTANT VARIANT DWORD
#CONSTANT DV_Cast Call Function Name("_DVCastValue",
#CONSTANT DV_Variant 0,
#CONSTANT DV_DWord 1,
#CONSTANT DV_Integer 2,
#CONSTANT DV_Float 3,
#CONSTANT DV_String 4,
#CONSTANT To_Variant ,0)
#CONSTANT To_DWord ,1)
#CONSTANT To_Integer ,2)
#CONSTANT To_Float ,3)
#CONSTANT To_String ,4)
`=================Entity Data Navigation Array (E.D.N.A.)================
`======================Sort-n-Search Functionality=======================
`
`Created 07/22/09 13:33:12
`
`========================================================================
`========================================================================
`Note: This library of functions is intended for use as sub modules.
Type VariantDataLoc_Type
EntityID as DWord
EndType
Function Initialize_Array_VariantDataLoc()
Dim InitArrayVariantDataLoc(0)
If InitArrayVariantDataLoc(0) Then ExitFunction
InitArrayVariantDataLoc(0)=1
Dim VariantDataLoc(999) as VariantDataLoc_Type
Dim VariantDataLocTop(0) as Integer
VariantDataLocTop(0)=-1
EndFunction
`VariantDataLoc_Find_Entity(EntityID as DWord):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.
Function VariantDataLoc_Find_Entity(EntityID as DWord)
Initialize_Array_VariantDataLoc()
Top=VariantDataLocTop(0)
Half=(Top+1)/2
If Top<0 Then ExitFunction -1
If EntityID<VariantDataLoc(0).EntityID Then ExitFunction -1
If EntityID=VariantDataLoc(0).EntityID Then ExitFunction 0
If EntityID=VariantDataLoc(Top).EntityID Then ExitFunction Top
If EntityID>VariantDataLoc(Top).EntityID Then ExitFunction -1
BSearch=Half
For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
If BSearch<1 then BSearch=1
If BSearch>Top then BSearch=Top
If EntityID=VariantDataLoc(BSearch).EntityID Then ExitFunction BSearch
Half=(Half+1)/2
If Half<1 then Half=1
BSearch=BSearch+Half*(((EntityID=>VariantDataLoc(BSearch).EntityID)-(EntityID<VariantDataLoc(BSearch).EntityID)))
Next i
EndFunction -1
`VariantDataLoc_Add_EntityID(EntityID as DWord):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.
Function VariantDataLoc_Add_EntityID(EntityID as DWord)
Index=VariantDataLoc_Find_EntityID_Place(EntityID)
VariantDataLoc_Insert_Element(Index)
VariantDataLoc(Index).EntityID=EntityID
EndFunction Index
`VariantDataLoc_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.
Function VariantDataLoc_Insert_Element(Index as Integer)
Initialize_Array_VariantDataLoc()
VariantDataLocTop(0)=VariantDataLocTop(0)+1
If VariantDataLocTop(0)=>Array Count(VariantDataLoc())
Array Insert At Bottom VariantDataLoc()
EndIf
If Index=>VariantDataLocTop(0) Then ExitFunction
For i =VariantDataLocTop(0)-1 To Index Step -1
VariantDataLoc(i+1)=VariantDataLoc(i)
Next i
EndFunction
`VariantDataLoc_Find_EntityID_Place(EntityID as DWord):Return Integer
`This function is similar to the VariantDataLoc_Find_EntityID() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`"fits" within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.
Function VariantDataLoc_Find_EntityID_Place(EntityID as DWord)
Initialize_Array_VariantDataLoc()
Top=VariantDataLocTop(0)
Half=(Top+1)/2
If Top<0 Then ExitFunction 0
If EntityID<=VariantDataLoc(0).EntityID Then ExitFunction 0
If EntityID=>VariantDataLoc(Top).EntityID Then ExitFunction Top+1
BSearch=Half
For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
If BSearch<1 then BSearch=1
If BSearch>Top then BSearch=Top
If EntityID=VariantDataLoc(BSearch).EntityID Then ExitFunction BSearch
If EntityID>VariantDataLoc(BSearch-1).EntityID And EntityID<=VariantDataLoc(BSearch).EntityID then ExitFunction BSearch
Half=(Half+1)/2
If Half<1 then Half=1
BSearch=BSearch+Half*(((EntityID=>VariantDataLoc(BSearch).EntityID)-(EntityID<VariantDataLoc(BSearch).EntityID)))
Next i
Top=Top+1
EndFunction Top
`VariantDataLoc_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.
Function VariantDataLoc_Delete_Element(Index as Integer)
Initialize_Array_VariantDataLoc()
If Index<0 or Index>VariantDataLocTop(0) Then ExitFunction
VariantDataLocTop(0)=VariantDataLocTop(0)-1
For i = Index to VariantDataLocTop(0)
VariantDataLoc(i)=VariantDataLoc(i+1)
Next i
EndFunction
Open MMORPG: It's your game!
