helpful Fontmacro document.
Code: Select all
Option VBASupport 1
sub FontNames()
dim FontList as collection, i as long
FontList = new collection
oWindow = ThisComponent.getCurrentController().getFrame().getContainerWindow()
oFonts() = oWindow.getFontDescriptors()
on error resume next 'add to collection, the error will stop duplicates being added
For i = 0 to UBound(oFonts())
FontList.add oFonts(i).name,oFonts(i).name
Next
FontList=sortCollection (FontList) 'then use a generic collection sort routine (below)
end sub
'below 'generic collection sort routine not by me - from http://www.source-code.biz/snippets/vbasic/6.htm
' good example of how VB6 code can be used in OO - this ran fine without modification
' This routine uses the "heap sort" algorithm to sort a VB collection.
'Author: Christian d'Heureuse (www.source-code.biz, www.inventec.ch/chdh)
'License: Free / LGPL
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then Set SortCollection = New Collection: Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1: c2.Add c.Item(Index(i)): Next ' fill output collection
Set SortCollection = c2
End Function
Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As Long, ByVal n As Long)
' Heap order rule: a[i] >= a[2*i+1] and a[i] >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.Item(Index(k)) < c.Item(Index(k + 1)) Then k = k + 1
End If
If c.Item(Index(i)) >= c.Item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub
Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub