But using the CoreReflection service much more is available. Things like testing if struct fields match or sorting an array of structs (eg fontdescriptors) by a chosen field (such as name or size) is easy to implement generically.
Code: Select all
'UNO STRUCT HELPER FUNCTIONS for SIMPLE UNO STRUCTS ONLY - COMPOSED OF FIELDS OF SIMPLE DATA TYPE
'NOTE NO TO LIMITED ERROR CHECKING FOR BAD CALLS ETC.
'useful structs for function return or sorting (sorting function by struct key included below)
'com.sun.star.beans.StringPair
'com.sun.star.beans.NamedValue
'com.sun.star.beans.Optional
'com.sun.star.beans.PropertyValue
'model example for returning optional struct in a function:
'Function ModelOptionalReturnFunction()
'Dim Opt As New "com.sun.star.beans.Optional<string>" 'string or other variable type
'opt.value = 50
'opt.ispresent = true
'ModelOptionalReturnFunction=Opt
'end function
Option Explicit
Option VBASupport 1
'''''''''''''''TEST STRUCT FUNCTIONS'''''''''''''''''''''''''''''''''''''''
'uncomment lines below item to test
Sub TestStructFunctions
dim FD,RR1,RR2,RR3,Rectarray, i, st as string,arr,retarray()
FD =createunostruct("com.sun.star.awt.FontDescriptor")
RR1 =createunostruct("com.sun.star.awt.Rectangle")
RR2 =createunostruct("com.sun.star.awt.Rectangle")
RR2.width = 500
RR3 =createunostruct("com.sun.star.awt.Rectangle")
'''''''''''''''STRUCT INFORMATION FUNCTIONS'''''''''''''''''''''''''''''''''''''''
'function GetTypeOfStruct(v) as string
msgbox GetTypeOfStruct(RR1)
'Function isStringEnumName(st)
'msgbox isStringEnumName("com.sun.star.awt.Rectangle")
'msgbox isStringEnumName("com.sun.star.awt.FontSlant")
'Function EnumStringToValue(st)
'msgbox EnumStringToValue("com.sun.star.awt.FontSlant.OBLIQUE")
'Function isStringStructName(st)
'msgbox isStringStructName("com.sun.star.awt.Rectangle")
'msgbox isStringStructName("com.sun.star.awt.FontSlant")
'Function getFieldnames(structst,sepst,inctypename as boolean)
'mri getFieldnames("com.sun.star.awt.FontDescriptor"," as ",true)
'mri getFieldnames("com.sun.star.awt.FontSlant","",false)
'Function GetEqualFields(a,b)
'mri GetEqualFields(RR1,RR2)
'Function GetNonEqualFields(a,b)
'mri GetNonEqualFields(RR1,RR2)
''''''''''''''''STRUCT COMPARISONS'''''''''''''''''''''''''''''''''''''''''
'function areEqualStructs(a,b) as boolean
'msgbox areEqualStructs(RR1,RR2)
'msgbox areEqualStructs(RR1,RR3)
''''''''''''''''''''set by name'''''''''''''''''''''''''''''''''''''''''''''''
'sub SetStructFieldByName(s,fieldname,fieldvalue)
'msgbox RR1.width
'SetStructFieldByName RR1,"Width",1000
'msgbox RR1.width
''''''''''''''''''''''''ARRAY Generic functions for array of structs'''''''''''''''''''''''
'sub createArrayOfStructs(arr,examplestruct,ub) 'create struct array of n items
'createArrayOfStructs Rectarray,RR1,10
'mri Rectarray
'function CreateStructArrayWithValues(sname,byval numberoffieldnames,ParamArray args()) function GetLargestFieldValue(marray,fieldname)
'Rectarray=CreateStructArrayWithValues( "com.sun.star.awt.Rectangle",2,"Width","Height",0,0,50,60,200,1000,50,200)
'mri Rectarray
'function GetSmallestFieldValue(arr,fieldname)
'Rectarray=CreateStructArrayWithValues( "com.sun.star.awt.Rectangle",2,"Width","Height",0,0,50,60,200,1000,50,200)
'for i = 0 to ubound(rectarray)
'st = st & chr(10) & Rectarray(i).width
'next
'st = st & chr(10) & "Biggest " & GetLargestFieldValue(Rectarray,"Width")
'st = st & chr(10) & "Smallest " & GetSmallestFieldValue(Rectarray,"Width")
'msgbox st
'sub ShellSortStructArrayByFieldname(mArray,Fieldname)
'function BinarySearchStructArray(marray,v,fieldname) 'based on function sub ArrayToStructArrayFields(mArray(),structArray,FieldName) 'apply array to sub StructArrayFieldsToArray(mArray(),structArray,FieldName) 'copy from struct
'Rectarray=CreateStructArrayWithValues( "com.sun.star.awt.Rectangle",2,"Width","Height",0,0,53,60,200,1000,50,200,-10,80,2,1000)
'for i = 0 to ubound(rectarray)
'st = st & chr(10) & Rectarray(i).width
'next
'ShellSortStructArrayByFieldname RectArray,"Width"
'st = st & "_______________"
'for i = 0 to ubound(rectarray)
'st = st & chr(10) & Rectarray(i).width
'next
'msgbox st
'RR1.width = 53
'mri RectArray(BinarySearchStructArray(RectArray,RR1,"Width"))
'
'sub ArrayToStructArrayFields(mArray(),structArray,FieldName) 'apply array to struct array field
'sub StructArrayFieldsToArray(mArray(),structArray,FieldName) 'copy from struct field to array
'createArrayOfStructs Rectarray,RR1,3
'redim arr(3)
'arr(0)= 5
'arr(1)= 50
'arr(2)= 678
'arr(3)= 90
'ArrayToStructArrayFields arr,Rectarray,"Width" 'apply array to struct array field
'mri RectArray
'redim retarray(ubound(RectArray))
'StructArrayFieldsToArray retarray,RectArray,"Width" 'copy from struct field to array
'mri retarray
'
'*************************************ENUM
'Function GetEnumFieldFromString(byval EnumString)
'MRI GetEnumFieldFromString("com.sun.star.awt.FontSlant.OBLIQUE")
end sub
'''''''''''''''STRUCT AND Enum INFORMATION FUNCTIONS'''''''''''''''''''''''''''''''''''''''
function GetTypeOfStruct(v) as string
dim CR
if isunostruct(v) then
CR =createunoservice("com.sun.star.reflection.CoreReflection")
GetTypeOfStruct=cr.gettype(v).name
end if
end function
Function isStringEnumName(st) as boolean
dim CR,fs
on error goto hr
CR= createUnoService("com.sun.star.reflection.CoreReflection")
fs = CR.getByHierarchicalName(st)
if isnull(fs) = false then
isStringEnumName = ( fs.typeclass = com.sun.star.uno.TypeClass.ENUM )
end if
hr:
end function
'msgbox EnumStringToValue ("com.sun.star.awt.FontSlant.OBLIQUE")
Function EnumStringToValue(st)
dim CR,fs
CR= createUnoService("com.sun.star.reflection.CoreReflection")
EnumStringToValue = CR.getByHierarchicalName(st)
end function
Function isStringStructName(st) as boolean
dim CR,fs
CR= createUnoService("com.sun.star.reflection.CoreReflection")
fs = CR.getByHierarchicalName(st)
if isnull(fs) = false then
isStringStructName = ( fs.typeclass = com.sun.star.uno.TypeClass.STRUCT )
end if
end function
'mri getFieldnames("com.sun.star.awt.Rectangle", " as ",true) 'strut
'mri getFieldnames("com.sun.star.awt.FontSlant","",false) 'enum
Function getFieldnames(structst,sepst,inctypename as boolean)
dim CR,fs,ub,i,arr() as string
CR= createUnoService("com.sun.star.reflection.CoreReflection")
fs = CR.getByHierarchicalName(structst)
if isnull(fs) = false then
if fs.typeclass = com.sun.star.uno.TypeClass.ENUM or fs.typeclass = com.sun.star.uno.TypeClass.STRUCT THEN
ub = ubound(fs.fields)
redim arr(ub)
for i = 0 to ub
arr(i) = fs.fields(i).name
if inctypename then arr(i) = arr(i) & sepst & fs.fields(i).type.name
next
getFieldnames = arr
END IF
end if
End function
Function GetEqualFields(a,b)
dim CR,aCR,BCR,i,ST AS string
if isunostruct(a) and isunostruct(b) then
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(a): bCR= CR.getType(b)
if aCR.name = bCR.name then
for i = 0 to ubound( aCR.fields)
with aCR.fields(i)
if .get(a) = .get(b) then
if st<>"" then st = st & chr(10)
st = st & .name
end if
end with
next
GetEqualFields= st
end if
end if
end function
Function GetNonEqualFields(a,b)
dim CR,aCR,BCR,i,st as string
if isunostruct(a) and isunostruct(b) then
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(a): bCR= CR.getType(b)
if aCR.name = bCR.name then
for i = 0 to ubound( aCR.fields)
with aCR.fields(i)
if .get(a) <> .get(b) then
if st<>"" then st = st & chr(10)
st = st & .name
end if
end with
next
GetNonEqualFields= st
end if
end if
end function
'''''''''''''''STRUCT COMPARISONS'''''''''''''''''''''''''''''''''''''''''
function areEqualStructs(a,b) as boolean
dim CR,aCR,BCR,i
if isunostruct(a) and isunostruct(b) then
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(a): bCR= CR.getType(b)
if aCR.name = bCR.name then
for i = 0 to ubound( aCR.fields)
with aCR.fields(i)
if .get(a) <> .get(b) then exit function
end with
next
areEqualStructs=true
end if
end if
end function
'''''''''''''''''''set by name'''''''''''''''''''''''''''''''''''''''''''''''
sub SetStructFieldByName(s,fieldname,fieldvalue)
dim CR,acr
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(s)
acr.getfield(Fieldname).set s,fieldvalue
end sub
'''''''''''''''''''''''ARRAY Generic functions for array of structs'''''''''''''''''''''''
sub createArrayOfStructs(arr,examplestruct,ub) 'create struct array of n items
dim CR,acr,i
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(examplestruct)
redim arr(ub)
for i = 0 to ub
acr.createobject(arr(i))
next
end sub
function CreateStructArrayWithValues(sname,byval numberoffieldnames,ParamArray args()) 'struct name, no field names,
'paramarray with fieldnames followed by matching field values for each item in sequence
dim a,CR,aCR,i,noitems,ubitems,j,arr,c
a =createunostruct(sname)
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(a)
dim fnames(numberoffieldnames -1)
for i = 0 to numberoffieldnames -1
fnames(i)= acr.getfield(args(i))
next
noitems = (ubound(args) - numberoffieldnames +1) \ numberoffieldnames
ubitems =noitems -1
redim arr(ubitems)
c=numberoffieldnames
for j = 0 to ubitems
acr.createobject(arr(j))
for i = 0 to numberoffieldnames -1
fnames(i).set arr(j),args(c)
c=c+1
next
next
CreateStructArrayWithValues =arr
end function
function GetLargestFieldValue(Marray,fieldname)
dim biggest,CR,aCR,ub,isstring as boolean,i
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(mArray(0))
with acr.getfield(Fieldname)
isstring = .gettype.getname = "string"
Ub = uBound(mArray)
biggest = .get(mArray(0)
if ub >0 then
for i = 1 to ub
if isstring then
if strComp(.get(mArray(i)), biggest, 0) = 1 then biggest = .get(mArray(i))
else
if .get(mArray(i)) > biggest then biggest = .get(mArray(i)
end if
next
end if
end with
GetLargestFieldValue =biggest
end function
function GetSmallestFieldValue(marray,fieldname)
dim smallest,CR,aCR,ub,isstring as boolean,i
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(mArray(0))
with acr.getfield(Fieldname)
isstring = .gettype.getname = "string"
Ub = uBound(mArray)
smallest = .get(mArray(0)
if ub >0 then
for i = 1 to ub
if isstring then
if strComp(.get(mArray(i)), biggest, 0) = -1 then smallest = .get(mArray(i))
else
if .get(mArray(i)) < smallest then smallest = .get(mArray(i)
end if
next
end if
end with
GetSmallestFieldValue =smallest
end function
'shell sort and binary sesarch struct arrays based on
'based on https://wiki.openoffice.org/wiki/Sorting_and_searching
sub ShellSortStructArrayByFieldname(byref mArray,Fieldname)
dim CR,acr,isstring as boolean
dim n as integer, h as integer, i as integer, j as integer, t, Ub as integer, LB as integer
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(mArray(0))
with acr.getfield(Fieldname)
isstring = (.gettype.getname = "string")
Lb = lBound(mArray)
Ub = uBound(mArray)
' compute largest increment
n = Ub - Lb + 1
h = 1
if n > 14 then
do while h < n
h = 3 * h + 1
loop
h = h \ 3
h = h \ 3
end if
do while h > 0
' sort by insertion in increments of h
for i = Lb + h to Ub
t = mArray(i)
for j = i - h to Lb step -h
if isstring then
' if strComp(mArray(j), t, 0) < 1 then exit for
if strComp(.get(mArray(j)), .get(t), 0) < 1 then exit for
else
if .get( mArray(j)) <= .get(t) then exit for
end if
mArray(j + h) = mArray(j)
next j
mArray(j + h) = t
next i
h = h \ 3
loop
end with
end sub
function BinarySearchStructArray(marray,v,Fieldname) 'based on function fnBinarySearch(a, v)
dim CR,aCR,nleft,nright,tofind,nMid,isstring as boolean
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(mArray(0))
with acr.getfield(Fieldname)
isstring = (.gettype.getname = "string")
nLeft = 0
nRight = uBound(marray)
tofind = .get(v)
while nLeft <= nRight
nMid = int((nLeft + nRight)/2)
if .get(marray(nMid))= tofind then
BinarySearchStructArray =nmid
exit function
else
if isstring then
if strComp(tofind, .get(marray(nMid)), 0) =- 1 then
nRight = nMid - 1
else
nLeft = nMid + 1
end if
else
if tofind < .get(marray(nMid)) then
nRight = nMid - 1
else
nLeft = nMid + 1
end if
end if
end if
wend
BinarySearchStructArray =-1
end with
end function
sub ArrayToStructArrayFields(mArray(),structArray,FieldName) 'apply array to struct array field
dim CR,aCR,ub,ub2,i
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(structArray(0))
with acr.getfield(Fieldname)
ub = ubound(mArray()
ub2 = ubound(structArray()
if ub<>ub2 then exit sub
for i =0 to ub
.set(structArray(i), marray(I))
next
end with
end sub
sub StructArrayFieldsToArray(mArray(),structArray,FieldName) 'copy from struct field to array
dim CR,aCR,ub,ub2,i
CR =createunoservice("com.sun.star.reflection.CoreReflection")
aCR= CR.getType(structArray(0))
with acr.getfield(Fieldname)
ub = ubound(mArray()
ub2 = ubound(structArray()
if ub<>ub2 then exit sub
for i =0 to ub
marray(I) = .get(structArray(i))
next
end with
end sub
'*************************************ENUM
Function GetEnumFieldFromString(byval EnumString)
dim CR,aCR,ub,sts,lenstub
CR =createunoservice("com.sun.star.reflection.CoreReflection")
sts = split(EnumString,".")
ub = ubound(sts)
lenstub = len(sts(ubound(sts)))
enumstring = left(enumstring,len(enumstring) - lenstub-1)
GetEnumFieldFromString = CR.getByHierarchicalName(enumstring).getfield(sts(ub))
end function
'not implemented ''''''''''''''''''''''''''Function CompareStructField(a,b,fieldname)
Edit2: added msgbox st to the sort test
Edit3: Added the word "simple" to the thread title for the structs. Structs contraining other structs aren't handled.