Re: [users] Font demo in Writer

Andrew Douglas Pitonyak Tue, 08 Mar 2005 21:27:01 -0800


Robert Moore wrote:

I believe I solved my own problem.  I modified a bunch of code supplied by
the wonderful Andrew Pitonyak in his macro demo as well as some of his forum
postings and came up with the following.  Probably really inefficient, but
it suits my purposes.  I'm going to export the resultant Writer file as a
PDF and then use that for my purposes.

Thanks Pitonyak!

Dim s$
Dim tempString$
Dim mySelection As Object

Sub ListFonts
Dim oWindow 'The container window supports the awt XDevice interface.
Dim oDescript 'Array of awt FontDescriptor structures
Dim i% 'General index variable
oWindow =
ThisComponent.getCurrentController().getFrame().getContainerWindow()
oDescript = oWindow.getFontDescriptors()

For i = LBound(oDescript) to UBound(oDescript)
tempString = oDescript(i).Name
s = "My Demo Text - "
s = s & tempString
InsertSimpleText
Next
End Sub

Sub InsertSimpleText
Dim oDocument As Object
Dim oText As Object
Dim oViewCursor As Object
Dim oTextCursor As Object
oDocument = ThisComponent
oText = oDocument.Text
oViewCursor = oDocument.CurrentController.getViewCursor()
oTextCursor = oText.createTextCursorByRange(oViewCursor.getStart())
' Place the text to insert here
oTextCursor.charFontName=tempString
oTextCursor.CharHeight="14"
oText.insertString(oTextCursor, s, FALSE)
oText.insertControlCharacter(oTextCursor,
com.sun.star.text.ControlCharacter.LINE_BREAK, False)
End Sub

Rob Moore
------------------------------------------------
"The legitimate powers of government extend only to such acts as are
injurious to others. But it does me no injury for my neighbor to say there
are 20 gods, or no God. It neither picks my pocket nor breaks my leg."
    -Thomas Jefferson

----- Original Message ----- From: "Robert Moore" <[EMAIL PROTECTED]> To: <[email protected]> Sent: Tuesday, March 08, 2005 10:32 PM Subject: [users] Font demo in Writer


Hello all,

I would like to first introduce myself as this is my first question to the
community.  My name is Rob Moore, I'm a 4th year undergraduate student in CS
at Seton Hall University in New Jersey.  I've been using OOo for about 2
years now in lieu of M$ Office.

My question concerns using fonts and demoing them similar to what is done in
the Font drop-down box.  I would like to create a Macro that displays some
constant text in every font available on a machine.  I need the Macro to
work in either Writer or Calc as these are the most familiar for me.

In case it matters, I am running Windows XP SP1, using OOo version 1.1.4 or
1.9.x (beta).  Either version would be acceptable, and I appreciate any help
in response to this request.

Gratefully,

Rob Moore ------------------------------------------------ "The legitimate powers of government extend only to such acts as are injurious to others. But it does me no injury for my neighbor to say there are 20 gods, or no God. It neither picks my pocket nor breaks my leg." -Thomas Jefferson

Thank you for your kind words.... I made a few changes to your macro.

1) Always use "Option Explicit".
2) Try to NOT use global variables.
3) I did not insert the text if the font was just used.

Perhaps (3) makes no difference on your system, but it is HUGE difference on my Linux computer. Neat macro! I will probably add it to my macro document.....


Option Explicit


Sub ListFonts
 Dim oWindow      'The container window supports the awt XDevice interface.
 Dim oDescript    'Array of awt FontDescriptor structures.
 Dim i%           'General index variable.
 Dim s$           'General string variable.
 Dim sFontName$   'Name of one font.
 Dim sLastFont$

oWindow = ThisComponent.getCurrentController().getFrame().getContainerWindow() oDescript = oWindow.getFontDescriptors()

 For i = LBound(oDescript) to UBound(oDescript)
   sFontName = oDescript(i).Name
   If sFontName <> sLastFont Then
     sLastFont = sFontName
     s = "My Demo Text - " & sFontName
     InsertSimpleText(s, sFontName)
   End If
 Next
End Sub

Sub InsertSimpleText(s$, sFontName$)
 Dim oText As Object
 Dim oViewCursor As Object
 Dim oTextCursor As Object

 oText = ThisComponent.getText()
 oViewCursor = ThisComponent.CurrentController.getViewCursor()
 oTextCursor = oText.createTextCursorByRange(oViewCursor.getStart())
 ' Place the text to insert here
 oTextCursor.charFontName=sFontName
 oTextCursor.CharHeight="14"
 oText.insertString(oTextCursor, s, FALSE)
 oText.insertControlCharacter(oTextCursor, _
       com.sun.star.text.ControlCharacter.LINE_BREAK, False)
End Sub

--
Andrew Pitonyak
My Macro Document: http://www.pitonyak.org/AndrewMacro.sxw
My Macro Book: http://www.hentzenwerke.com/catalog/oome.htm
Free Info:  http://www.pitonyak.org/oo.php


---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Re: [users] Font demo in Writer

Reply via email to