Generic UNO Simple Struct and UNO Enum functions for Basic

Shared Libraries
Forum rules
For sharing working examples of macros / scripts. These can be in any script language supported by OpenOffice.org [Basic, Python, Netbean] or as source code files in Java or C# even - but requires the actual source code listing. This section is not for asking questions about writing your own macros.
Post Reply
JeJe
Volunteer
Posts: 2764
Joined: Wed Mar 09, 2016 2:40 pm

Generic UNO Simple Struct and UNO Enum functions for Basic

Post by JeJe »

All Basic natively allows us to do is define a variable as an Uno struct, provides us with the IsUnoStruct function (true or false only), and lets us copy a struct to another variable.

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)

Edit: TESTED ON OO ONLY

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.
Windows 10, Openoffice 4.1.11, LibreOffice 7.4.0.3 (x64)
Cazer
Posts: 53
Joined: Mon May 15, 2023 11:55 am

Re: Generic UNO Simple Struct and UNO Enum functions for Basic

Post by Cazer »

That's a late reply but thanks for sharing your code on UNO struct helper functions! I think your work with the CoreReflection service opens up new possibilities with UNO structs, especially in terms of testing struct fields and sorting an array of structs.
Keep up the good work!
OpenOffice 4.1.14
OS
Post Reply