Convert text in Writer to text drawing object

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: 2784
Joined: Wed Mar 09, 2016 2:40 pm

Convert text in Writer to text drawing object

Post by JeJe »

TEXT TO DRAWING and back.
replaces a short piece of selected text in a single line in Writer with text drawing object

Example usage is a one-off made-up word like AAAAAAAAAAAh! that you don't want flagged up with every spell check nor want to add to a user dictionary.

Select a short piece of text on a single line and run test. Double click inside the resultant object to select and run test again to restore to text.

Code: Select all

	'TEXT TO DRAWING

	'replaces selected text in writer with drawn text
	'limited to short text within a single line

	'to convert back
	'select the shape by double clicking in the centre
	'(not on the borders when the sizing rectangles will show - which we don't want)

'select a short piece of text on a single line and run test
sub test 

	on error goto hr
	doc = thiscomponent
	vc= doc.currentcontroller.viewcursor
	tc = vc.text.createtextcursorbyrange(vc)

	IF LEN(VC.STRING )= 0 THEN 'assumes selected text drawing shape if there's no selected text 
		convertFromShapeToText tc 'convert back to text
	ELSE
		bdrcol =-1 '-1 for no border
		'bdrcol =  rgb(55,55,55) 'or choose color
		convertFromTextToShape doc, tc,bdrcol 'convert text to shape
	END IF
hr:
end sub

sub convertFromTextToShape (doc,tc,bdrcol)

	st = tc.string

	getCharAttributes(tc,Charfontname,Charheight,CharUnderline,charWeight,CharStrikeout,CharColor,CharPosture)

	tsh = Doc.createInstance("com.sun.star.drawing.TextShape")

	with tsh
		tc.string = ""
		Doc.Text.insertTextContent(tc.start, tsh, true)

		.setstring st

		setCharAttributes(tsh,Charfontname,Charheight,CharUnderline,charWeight,CharStrikeout,CharColor,CharPosture)

		.anchortype = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
		.TextHorizontalAdjust =com.sun.star.drawing.TextHorizontalAdjust.BLOCK
		.TextVerticalAdjust =com.sun.star.drawing.TextHorizontalAdjust.BLOCK


		if bdrcol = -1 then
			.linestyle =0
		else
			.linestyle =1
			.linewidth = 101
			.LineColor =bdrcol
			.linestartwidth =500
		end if

		.textleftdistance = 5
		.textlowerdistance =5
		.textRightdistance = 5
		.textUpperdistance =5
		.textAutoGrowHeight = true
		.textAutoGrowWidth = true
		.textwrap = com.sun.star.text.WrapTextMode.THROUGHT
		.textverticaladjust = com.sun.star.drawing.TextVerticalAdjust.TOP
		.vertorient = 6


	end with
End Sub


Sub convertFromShapeToText(tc)
	en =tc.createcontentenumeration("com.sun.star.text.TextContent")
	if en.hasmoreelements=false then exit sub
	n= en.nextelement
	if isnull(n)=false then

		getCharAttributes(n,Charfontname,Charheight,CharUnderline,charWeight,CharStrikeout,CharColor,CharPosture)
		st= n.string
		tc.gotorange(n.getanchor.getstart,false)
		tc.text.removetextcontent(n)
		tc.collapsetostart
		tc.string = st


		setCharAttributes(tc,Charfontname,Charheight,CharUnderline,charWeight,CharStrikeout,CharColor,CharPosture)

	end if
end sub

sub getCharAttributes(obj,Charfontname,Charheight,CharUnderline,charWeight,CharStrikeout,CharColor,CharPosture)
	with obj
		Charfontname = .Charfontname
		Charheight=.Charheight
		CharUnderline= .CharUnderline
		charWeight= .charWeight
		CharStrikeout=.CharStrikeout
		CharColor=.CharColor
		CharPosture=.CharPosture
	end with

end sub

sub setCharAttributes(obj,Charfontname,Charheight,CharUnderline,charWeight,CharStrikeout,CharColor,CharPosture)
	with obj
		.Charfontname=Charfontname
		.Charheight=Charheight
		.CharUnderline= CharUnderline
		.charWeight = charWeight
		.CharStrikeout=CharStrikeout
		.CharColor=CharColor
		.CharPosture=CharPosture
	end with
end sub



Windows 10, Openoffice 4.1.11, LibreOffice 7.4.0.3 (x64)
Post Reply