This is just here for reference. It enumerates the formula objects and extracts the text, converts it to expressions and so on. But, it doesn't execute them because there is no convenient way of doing it. A JavaScript version will be created.
'********************************************************************************
' Copyright (C) 2007 Kevin Whitefoot
' Losely based on code Copyright (C) 2003 Laurent Godard
'dev.godard@wanadoo.fr
'This library is free software; you can redistribute it and/or
'modify it under the terms of the GNU Lesser General Public
'License as published by the Free Software Foundation; either
'version 2.1 of the License, or (at your option) any later version.
'This library is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
'Lesser General Public License for more details.
'http://www.opensource.org/licenses/lgpl-license.php
'You should have received a copy of the GNU Lesser General Public
'License along with this library; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
'******************************************************************************
'
OPTION EXPLICIT
private Sub EvaluateFormula(roFormule as object, roValues as string) as double
Dim sFormula as String
sFormula = FormulaToString(roFormule.Formula)
dim nValue as double
dim bIsDefinition as boolean
dim i as integer
dim n as double
i=instr(rsFormula,"=")
bIsDefinition = mid$(rsFormula,i-1,1)=":"
sRHS = trim(mid$(rsFormula,i+1))
if bISDefinition then
sLHS= trim(left$(rsFormula,i-2))
n = EvaluateString(sRHS, roValues, rlValuesInUse)
SetValue rsValues, sLHS, n
else
sLHS= trim(left$(rsFormula,i-1))
if GetValue(rsValues, sLHS, n) then
roFormule = sLHS & " = " & n
endif
endif
EvaluateFormula = n
End Sub
private function GetValue(rsValues as string, rsKey as string, byref rnValue as double) as boolean
dim iStartKey as integer
dim iStartValue as integer
dim iEnd as integer
GetValue = FindValue(rsValues, rsKey, rlStartKey, rlStartValue, rlEnd)
if GetValue then
rnValue = mid(rsValues, iStartKey, iEnd-iStartKey)
endif
end function
private sub SetValue(byref rsValues as string, rsKey as string, byref rnValue as double)
dim iStartKey as integer
dim iStartValue as integer
dim iEnd as integer
dim sEntry as string
sEntry = "|" & rsKey & "=" & rnValue & "|"
if FindValue(rsValues, rsKey, rlStartKey, rlStartValue, rlEnd) then
rsvalues=left(rsvalues, iStartKey-1) & sEntry & mid(rsvalues,iEnd+1)
else
rsValues = rsValues & sEntry
endif
end sub
private function FindValue(rsValues as string, rsKey as string, _
byref rlStartKey as integer, _
byref rlStartValue as integer, _
byref rlEnd as integer) as boolean
iStartKey = instr(rsvalues, "|" & rsKey & "=")
if iStartKey<>0 then
FindValue = true
iStartValue = iStartKey+3+len(rsKey)
rlEnd = instr(istart, "|")
else
FindValue= false
endif
end function
private Sub EvaluateString(rsFormula as string, _
roValues() as object, _
rlValuesInUse as integer) as double
End Sub
public Sub ExtractFormulas
dim oDesktop as object
dim oDocument as object
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument = oDesktop.getCurrentComponent
Call EvaluateFormulas(oDocument)
End Sub
'***********************************************************************
private Sub EvaluateFormulas(roDocument as object)
dim aValues(1 to 50,1 to 2) as object ' Dammit! No hashtables, have to go to JavaScript or Java after all.
dim lValuesInUse as integer
dim oObjects as object
oObjects=roDocument.getEmbeddedObjects
dim i as integer
for i=0 to oObjects.count-1
dim oObject as object
oObject =oObjects(i)
if oObject.getImplementationName="SwXTextEmbeddedObject" then
on error resume next
if oObject.embeddedObject.getImplementationName="com.sun.star.comp.math.FormulaDocument" then
EvaluateFormula(oObject.embeddedObject, aValues, lValuesInUse)
on error goto 0
endif
endif
next i
end sub
' Remove size declarations, replace curly brackets, replace times and over.
' Remove initial and final brackets if any.
private function RemoveSize(rsFormula as string) as string
dim sFormula as string
sFormula = rsFormula
do
dim iStart as integer
iStart=instr(1, sFormula, "size", 1)
if iStart=0 then
exit do
endif
iEnd = iStart+5
do while mid$(sFormula, iEnd, 1)<>"{"
iEnd = iEnd + 1
loop
sFormula = left$(sFormula, iStart-1) & mid$(sformula, iEnd)
loop
RemoveSize = sFormula
end function
' Remove size declarations, replace curly brackets, replace times and over.
' Remove initial and final brackets if any.
private function Replace(rs as string, rsWhat as string, rsWith as string) as string
dim s as string
s = rs
do
dim iStart as integer
iStart=instr(1, s, rsWhat, 1)
if iStart=0 then
exit do
endif
s = left$(s, iStart-1) & rsWith & mid$(s, iStart + len(rsWhat))
loop
Replace = s
end function
' Remove size declarations, replace curly brackets, replace times and over.
' Remove initial and final brackets if any.
private function FormulaToString(rsFormula as string) as string
dim s as string
s = trim(Replace(Replace(Replace(Replace(removeSize(rsFormula), "{","("),"}",")"),"times","*"),"over","/"))
if left$(s,1) = "(" then
s= mid$(s,2,len(s)-2)
endif
FormulaToString = s
end function
</pre>
No comments:
Post a Comment