Apache OpenOffice Community Forum

Code: Select all

Dim oDoc As Object
Dim Proceed As Boolean
Dim Cursor As Object

oDoc = ThisComponent
Cursor = oDoc.Text.createTextCursor()
Cursor.gotoStart (false)'start of doc
Cursor.gotoEndOfWord(True)

do

MsgBox Cursor.String
Cursor.gotoNextWord (false)
Proceed = Cursor.gotoEndOfWord(True)

Loop While Proceed

Code: Select all

oDoc = ThisComponent
'oText = oDoc.getText()
Cursor = oDoc.Text.createTextCursor()
Cursor.gotoStart (false)'start of doc
Cursor.gotoEndOfWord(True)
Proceed = true
do


if Cursor.String = "." then
 'do nothing, skip
else
MsgBox Cursor.String
end if
'if Cursor.isEndOfParagraph () then
'Proceed = Cursor.gotoNextParagraph (false)
'Proceed = Cursor.gotoEndOfWord(True)
'else
Cursor.gotoNextWord (false)
if not Cursor.gotoEndOfWord(True) then
Proceed = gotoNextParagraph(false)
end if

'end if




Loop While Proceed

Code: Select all

Cursor.gotoNextWord (false)
if not Cursor.gotoEndOfWord(True) then
  Proceed = Cursor.gotoNextParagraph(true)
  Cursor.gotoEndOfWord(True)
end if

Code: Select all

Cursor.gotoStart (false)'start of doc
Cursor.gotoEndOfWord(True)
MsgBox Cursor.String'--> empty string

Code: Select all

do
MsgBox Cursor.String
proceed = Cursor.gotoNextWord (false)
Cursor.gotoEndOfWord(True)
Loop While Proceed
End Sub

Code: Select all

REM  *****  BASIC  *****

Sub Main
Dim oDoc As Object
Dim Proceed As Boolean
Dim Cursor As Object
Dim words as string

	oDoc = ThisComponent
	Cursor = oDoc.Text.createTextCursor()
	Cursor.gotoStart (false)'start of doc
	Cursor.gotoEndOfWord(True)
	words = ""
do
	str1 = Cursor.String
REM goToNextWord() mis-handles words beginning with "." 
REM  this bit corrects that behavior 
	if str1 = "." then   
	  Cursor.gotoPreviousWord(False)
	  Cursor.goRight(2, False)
	  Cursor.gotoEndOfWord(False)
	  Cursor.gotoStartOfWord(True)
	  str1 = "." & Cursor.String
	endif
REM now continue on building list
	words = words & CHR$(10) & str1
	Proceed =  Cursor.gotoNextWord (False)
REM put a marker in the list when starting a new paragraph 
  	If Cursor.IsStartOfParagraph Then   'isStartOfParagraph
	  	words = words & CHR$(10) & "**** New Paragraph ****"
	End If 
REM check if all the words are on the list	
	If Cursor.gotoEndOfWord(True) = False then
	  Proceed = False
	end if
Loop While Proceed
  MsgBox words, 0,  "Word List"
End Sub

Code: Select all

do
MsgBox Cursor.String
cursor.collapsetoend
proceed=Cursor.gotoNextWord (true)
Loop While Proceed

Code: Select all

Sub EnumerateParagraphs
	REM Author: Andrew Pitonyak
	Dim oParEnum 'Enumerator used to enumerate the paragraphs
	Dim oPar 'The enumerated paragraph
	REM Enumerate the paragraphs.
	REM Tables are enumerated along with paragraphs
	oParEnum = ThisComponent.getText().createEnumeration()
	Do While oParEnum.hasMoreElements()
		oPar = oParEnum.nextElement()
		REM This avoids the tables. Add an else statement if you want to
		REM process the tables.
		If oPar.supportsService("com.sun.star.text.Paragraph") Then
			'MsgBox oPar.getString(), 0, "I found a paragraph"
			getwordsinpara(oPar.getstring)

		ElseIf oPar.supportsService("com.sun.star.text.TextTable") Then
			'Print "I found a TextTable"
		Else
			'Print "What did I find?"
		End If
	Loop
End Sub


sub getwordsinPara(txt as string) as long 'author - me
	dim punct as string,i as long,c as string,wd as string,lenwd as long


	punct = " .;:!?(){}[]\/<>,*@" & Chr(34) & Chr(10)

	for i = 1 to len(txt)
		c = Mid(txt, i, 1)
		If InStr(1, punct, c) <> 0 Then
			if wd <>"" then

'				if isnumeric(wd) =false then

					msgbox wd
					'
'				end if
			end if
		
			wd = ""
			lenwd=0
		Else
			lenwd = lenwd+1
			wd =  wd & c
		End If
	next


			if wd <>"" then

'				if isnumeric(wd) =false then

					msgbox wd
					'
'				end if
			end if


end sub

Code: Select all

Sub test()
Print wordCount()
End Sub

Function wordCount(Optional pSearchable)
If IsMissing(pSearchable) Then pSearchable = ThisComponent
doc0 = pSearchable
tRD = doc0.CreateReplaceDescriptor
tRD.SearchRegularExpression = True
tRD.SearchString = "\b\w+\b"
found = doc0.FindAll(tRD)
wordCount = found.Count
For j = 0 To found.Count - 1
  oneWord = found(j).String
  Print oneWord ' Now every found word is displayed one by one
Next j
End Function

Code: Select all

Sub EnumerateParagraphs
	REM Author: Andrew Pitonyak
	Dim oParEnum 'Enumerator used to enumerate the paragraphs
	Dim oPar 'The enumerated paragraph
	REM Enumerate the paragraphs.
	REM Tables are enumerated along with paragraphs
	oParEnum = ThisComponent.getText().createEnumeration()
	Do While oParEnum.hasMoreElements()
		oPar = oParEnum.nextElement()
		REM This avoids the tables. Add an else statement if you want to
		REM process the tables.
		If oPar.supportsService("com.sun.star.text.Paragraph") Then
			'MsgBox oPar.getString(), 0, "I found a paragraph"
			getwordsinpara(oPar.getstring)

		ElseIf oPar.supportsService("com.sun.star.text.TextTable") Then
			'Print "I found a TextTable"
		Else
			'Print "What did I find?"
		End If
	Loop
End Sub


sub getwordsinPara(txt as string) as long
	dim punct as string,i as long,c as string,wd as string,lenwd as long
	dim lentxt as long,webaddress as boolean, breakpos as long,hyphencount as long

	lentxt = len(txt)
	punct = " ;:!?(){}[]<>,*‘’“”—–…‹›«»•†‡§||#_" & Chr(34) & Chr(10) & chr(9)
	'".'-_@\/" handle separately ?

	for i = 1 to lentxt 'go though each letter
		c = Mid(txt, i, 1)

		select case c
		case "."
			IF WD = "" THEN
				breakpos = i
			ELSE
				if i < lentxt then
					IF InStr(1, punct, Mid(txt, i+1, 1)) <> 0 Then breakpos =i
				else
					breakpos =i
				end if
			END IF
			'apostrophe and single curly quote confusion - NOT handled yet
			'		case "'" 'not in punctuation list so always treating as part of word
			'		case "‘" in punctuation list so always treated as breakchar
			'		case "’" in punctuation list so always treated as breakchar
			'		case "_" 'underline in punctuation list so always treated as breakchar

		case "-" 'hyphen options when to treat as break char
			hyphencount = hyphencount +1

		CASE ":"
			IF wd <> "http" then breakpos = i

		case "/"
			if instr(1,wd,"http:") <>1 and instr(1,wd,"www.")<>1 then
				breakpos = i
			else
				webaddress = true
			end if
		case else
			If InStr(1, punct, c) <> 0 Then breakpos =i
		end select

		if breakpos<>0 then
			gosub handleword
			breakpos =0
			wd = ""
			lenwd=0
			webaddress = false
			hyphencount = 0
		Else
			lenwd = lenwd+1
			wd =  wd & c
		End If
	next

	gosub handleword
	exit sub


handleword:

	if wd<>"" then
		'handle hyphenated words if 1 hyphen treat as one world else spit if not date
		if webaddress = false then
			if hyphencount >1 and isdate(wd) =false then
				wds = split(wd,"-")
				for j=  0 to ubound(wds)
					'option to exclude numbers
					'					if isnumeric(wd) =false then
					msgbox wd
					'					end if
				next
			end if
		end if

			if wd<> "" then
				'option to exclude numbers
				'				if isnumeric(wd) =false then
				msgbox wd
				'				end if
			end if
		end if

		return

end sub