Dansk LibreOffice Forum

Code: Select all

Sub acbwc
' v2.0.1 
' 5 sept 2003
' does footnotes and selections of all sizes
' still slow with large selections, but I blame Hamburg :-)
' v 2.0.1 slightly faster with improved cursorcount routine 
' not unendurably slow with lots of footnotes, using cursors.

' acb, June 2003
' rewritten version of the 
' dvwc macro by me and Daniel Vogelheim

' september 2003 changed the selection count to use a word cursor for large selections
' following hints from Andrew Pitonyak.
' this is not perfect, either, largely because move-by-word is erratic.
' it will slightly exaggerate the number of words in a selection, counting extra 
' for paragraph ends and some punctuation.
' but it is still much quicker than the old method.

Dim xDoc, xSel, nSelcount
Dim nAllChars
Dim nAllWords
Dim nAllPars 
Dim thisrange, sRes
Dim nSelChars, nSelwords, nSel 
Dim atext, bigtext
Dim fnotes, thisnote, nfnotes, fnotecount
Dim oddthing,startcursor,stopcursor
  xDoc = thiscomponent
  xSel = xDoc.getCurrentSelection()
  nSelCount = xSel.getCount()
  bigText=xDoc.getText()
  
  ' by popular demand ...
  fnotes=xdoc.getFootNotes()
  If fnotes.hasElements() Then
    fnotecount=0
    For nfnotes=0 To fnotes.getCount()-1
    thisnote=fnotes.getbyIndex(nfnotes)
    startcursor=thisnote.getStart()
    stopcursor=thisnote.getEnd()
    Do While thisnote.getText().compareRegionStarts(startcursor,stopcursor) AND startcursor.gotoNextWord(FALSE)
      fnotecount=fnotecount+1
    Loop
'         msgbox(startcursor.getString())
'         fnotecount=fnotecount+stringcount(thisnote.getstring())
'         fnotecount=fnotecount+CursorCount(thisnote,bigtext)
    Next nfnotes
  End If
  
  ' this next "If" works around the problem that If you have made a selection, then
  ' collapse it, and count again, the empty selection is still counted, 
  ' which was confusing and ugly
  If nSelCount=1 and xSel.getByIndex(0).getString()="" Then
    nSelCount=0
  End If

  ' access document statistics
  nAllChars = xDoc.CharacterCount
  nAllWords = xDoc.WordCount
  nAllPars = xDoc.ParagraphCount

  ' initialize counts
  nSelChars = 0
  nSelWords = 0
  ' the fancy bit starts here
  ' iterate over multiple selection
  For nSel = 0 To nSelCount - 1
    thisrange=xSel.GetByIndex(nSel)
    atext=thisrange.getString()
    If len(atext)< 220 Then
      nselwords=nSelWords+stringcount(atext)
    Else
      nselwords=nSelWords+Cursorcount(thisrange)
    End If
    nSelChars=nSelChars+len(atext)
  Next nSel
  
  ' dialog code rewritten for legibility
    If fnotes.hasElements() Then
      sRes="Document count (with footnotes): "  + nAllWords + _
           " words. "  + chr(13)
      sRes= sRes + "Word count without footnotes: " + _
                   str(nAllWords-fnotecount) + _
            " words. "  + chr(13)+"(Total: " +nAllChars +" Chars in "
    Else 
      sRes= "Document count: "  + nAllWords +"  words. "  + chr(13)+"(" + nAllChars +" Chars in "  
    End If
    sRes=sRes + nAllPars +" Paragraphs.)"+ chr(13)+ chr(13)
    If nselCount>0 Then 
      sRes=sRes  + "Selected text count: " + nSelWords  + "  words" + chr(13) + _
                   "(" + nSelChars  + " chars"
      If nSelcount=1 Then
        sRes=sRes  + " In " + str(nselCount) + " selection.)"
      Else
        REM I don't know why, but need this adjustment
        sRes=sRes +  " In " + str(nselCount-1) +" selections.)"
      End If
      sRes=sRes+chr(13)+chr(13)+"Document minus selected:" + chr(13)+ _
        str(nAllWords-nSelWords) + " words." +chr(13) +chr(13)
    End If
    If fnotes.hasElements() Then
      sRes=sRes+"There are "+ str(fnotecount) + " words in "+ fnotes.getCount() + " footnotes." +chr(13) +chr(13)
    End If
    msgbox(sRes,64,"acb Word Count")
End Sub

function Cursorcount(aRange)
' acb September 2003
' quick count for use with large selections
' based on Andrew Pitonyak's WordCountWordCursor() function
' but made cruder, in line with my general tendency.
Dim lnumwords as long
Dim atext
Dim startcursor, stopcursor as object
  atext=arange.getText()
  lnumwords=0
  If not atext.compareRegionStarts(aRange.getStart(),aRange.getEnd()) Then
    startcursor=atext.createTextCursorByRange(aRange.getStart())
    stopcursor=atext.createTextCursorByRange(aRange.getEnd())
  Else
    startcursor=atext.createTextCursorByRange(aRange.getEnd())
    stopcursor=atext.createTextCursorByRange(aRange.getStart())
  End If
  Do while aText.compareRegionEnds(startCursor, stopcursor) >= 0 and startCursor.gotoNextWord(False)
      lnumwords=lnumwords+1
  Loop
  CursorCount=lnumwords-1 
end function


Function stringcount(astring)
' acb June 2003
' slower, more accurate word count
' for use with smaller strings
' sharpened up by David Hammerton (http://crazney.net/) in September 2003
' to allow those who put two spaces after punctuation to escape their 
' just deserts
Dim nspaces,i,testchar,nextchar
  nspaces=0
  For i= 1 To len(astring)-1
    testchar=mid(astring,i,1)
    select Case testchar
    Case " ",chr(9),chr(13)
      nextchar = mid(astring,i+1,1)
      select Case nextchar
         Case " ",chr(9),chr(13),chr(10)
           nspaces=nspaces
         Case Else
           nspaces=nspaces+1
      end select
    end select
  Next i
  stringcount=nspaces+1
End Function