/usr/lib/libreoffice/share/extensions/DmathsAddon/Dmaths2/GraphDrawing.xba is in libreoffice-dmaths 3.4+dfsg1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="GraphDrawing" script:language="StarBasic">'************************************************
'Copyright (C) Andy Lewis. (lewiss@ntlworld.com)
'téléchargé sur www.ooomacros.org
'
'This library is free software; you can redistribute it and/or
'modify it under the terms of the GNU Lesser General Public Licence (LGPL)
'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
'General Public License for more details.
'You should have received a copy of the GNU General Public Licence (GPL)
'along with this library; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
'************************************************
'Routines to draw graphs. Requires "AxesSetup"
option explicit
public goShadings as object
public oCollectionFigures as Object
'___________________________________________________________________________________________
sub DrawGraph (stFunction as String, xMin as single, xMax as single, inequality as String)
Dim discon as Boolean, erflag As Boolean
Dim x1 as Single, x2 as Single, oldx1 as Single, gap as single
Dim y1 as Single, y2 as Single, oldy1 as Single
Dim xStart as Single, yStart as Single, xEnd as Single, yEnd as single, yEdge as single
Dim oCurve as object, oSegment as object, oSegments as object, oRegionEdge as object, oShading as object
Dim oPoint(200) as object
Dim pointcount as integer
Dim MaxSectorLength as integer '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MaxSectorLength=200 '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
oSegments = createUnoService( "com.sun.star.drawing.ShapeCollection" )
parse (stFunction,erflag)
gap=(gsScaleRight-gsScaleLeft)/200
if xMin<gsScaleLeft then xMin=gsScaleLeft
if xMax>gsScaleRight then xMax=gsScaleRight
x1 = xMin : y1 = f(x1) : oldy1=notdef
xStart = x1 : yStart = y1
Do while x1 < xMax
Do While (y1 = notdef or y1>gsScaleTop or y1<gsScaleBottom) And x1 < xMax
oldx1=x1 : oldy1=y1 : x1 = x1 + gap : y1 = f(x1)
MaxSectorLength=MaxSectorLength-1 ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Loop
If x1>=xMax then Exit do
oRegionEdge = createUnoService( "com.sun.star.drawing.ShapeCollection" )
If oldy1 = notdef then
xStart=x1:yStart=y1
oPoint(0)=ScalePoint(xStart,yStart)
pointcount=0 ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ElseIf oldy1>gsScaleTop then
xStart=oldx1+(gsScaleTop-oldy1)/(y1-oldy1)*gap : yStart=gsScaleTop
oPoint(0)=ScalePoint(xStart,yStart)
pointcount=1 : oPoint(1)=ScalePoint(x1,y1)
ElseIf oldy1<gsScaleBottom then
xStart=oldx1+(gsScaleBottom-oldy1)/(y1-oldy1)*gap : yStart = gsScaleBottom
oPoint(0)=ScalePoint(xStart,yStart)
pointcount=1 : oPoint(1)=ScalePoint(x1,y1)
End If
Discon=False
do while x1<=xMax and Discon=False
x2 = x1 + gap:y2=f(x2)
If y2=notdef or x2>xMax then
xEnd=x1 : yEnd=y1 : Discon=True
ElseIf y2>gsScaleTop then
xEnd=x1+(gsScaleTop-y1)/(y2-y1)*gap : yEnd = gsScaleTop : Discon=True
pointcount=pointcount+1
oPoint(pointcount)=ScalePoint(xEnd,yEnd)
ElseIf y2<gsScaleBottom then
xEnd=x1+(gsScaleBottom-y1)/(y2-y1)*gap: yEnd = gsScaleBottom : Discon=True
pointcount=pointcount+1
oPoint(pointcount)=ScalePoint(xEnd,yEnd)
EndIf
If discon=True then
ReDim preserve oPoint(pointcount) as object
oSegment=DrawPolyLine(oPoint(),"Open",,,,oSegments)
if inequality<>"=" then
ReDim preserve oPoint(pointcount+3) as object
If inequality=">" then yEdge=gsScaleTop else yEdge=gsScaleBottom
pointcount=pointcount+1 : oPoint(pointcount)=ScalePoint(xEnd,yEdge)
pointcount=pointcount+1 : oPoint(pointcount)=ScalePoint(xStart,yEdge)
pointcount=pointcount+1 : oPoint(pointcount)=ScalePoint(xStart,yStart)
oShading=DrawPolyLine(oPoint(),"Closed",,,0,goShadings)
End If
x1=x2+gap:y1=f(x1)
MaxSectorLength=MaxSectorLength-pointcount '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF x1<=xmax then '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ReDim preserve oPoint(MaxSectorLength) as object '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End If '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Else
pointcount=pointcount+1
oPoint(pointcount)=ScalePoint(x2,y2)
x1=x2:y1=y2
End If
Loop
Loop
oCurve = goPage.Group( oSegments )
End Sub
'___________________________________________________________________________________________
Sub StraightLineGraph (m as single, c as single, inequality as String)
Dim StartFlag as Integer, EndFlag as Integer
Dim xStart as single, xEnd as single, yStart as Single, yEnd as Single
Dim oShading as object,oRegionEdge as object
On error resume next
yStart = m*gsScaleLeft+c
If yStart > gsScaleTop then
StartFlag=1 : xStart = (gsScaleTop - c)/m : yStart = gsScaleTop
ElseIf yStart < gsScaleBottom then
StartFlag=-1: xStart = (gsScaleBottom - c)/m : yStart = gsScaleBottom
Else
StartFlag=0: xStart = gsScaleLeft
End If
yEnd = m*gsScaleRight+c
If yEnd > gsScaleTop then
EndFlag=1 : xEnd = (gsScaleTop - c)/m : yEnd = gsScaleTop
ElseIf yEnd < gsScaleBottom then
EndFlag=-1: xEnd = (gsScaleBottom - c)/m : yEnd = gsScaleBottom
Else
EndFlag=0: xEnd = gsScaleRight
End If
DrawScaleLine(xStart,yStart, xEnd,yEnd,1,30,1)
If Inequality = "=" then Exit Sub
oRegionEdge = createUnoService( "com.sun.star.drawing.ShapeCollection" )
DrawScaleLine(xEnd,yEnd,xStart,yStart,1,0,1,oRegionEdge)
If Inequality = ">" then
if StartFlag =-1 then DrawScaleLineTo(gsScaleLeft,gsScaleBottom,1,0,1,oRegionEdge)
if StartFlag < 1 then DrawScaleLineTo(gsScaleLeft,gsScaleTop,1,0,1,oRegionEdge)
if EndFlag < 1 then DrawScaleLineTo(gsScaleRight,gsScaleTop,1,0,1,oRegionEdge)
if EndFlag =-1 then DrawScaleLineTo(gsScaleRight,gsScaleBottom,1,0,1,oRegionEdge)
EndIf
If Inequality = "<" then
if StartFlag = 1 then DrawScaleLineTo(gsScaleLeft,gsScaleTop,1,0,1,oRegionEdge)
if StartFlag > -1 then DrawScaleLineTo(gsScaleLeft,gsScaleBottom,1,0,1,oRegionEdge)
if EndFlag > -1 then DrawScaleLineTo(gsScaleRight,gsScaleBottom,1,0,1,oRegionEdge)
if EndFlag = 1 then DrawScaleLineTo(gsScaleRight,gsScaleTop,1,0,1,oRegionEdge)
EndIf
DrawScaleLineTo(xEnd,yEnd,1,0,1,oRegionEdge)
oShading = goPage.Bind(oRegionEdge)
oShading.LineStyle = com.sun.star.drawing.LineStyle.NONE
oShading.zOrder=0
goShadings.Add(oShading)
End Sub
'___________________________________________________________________________________________
Sub VerticalStraightLineGraph (x as single, inequality as String)
Dim oShading as Object,oRegionEdge as object
DrawScaleLine(x,gsScaleBottom,x,gsScaleTop,1,30,1)
If inequality = "=" then Exit Sub
oRegionEdge = createUnoService( "com.sun.star.drawing.ShapeCollection" )
DrawScaleLine(x,gsScaleBottom,x,gsScaleTop,1,0,0,oRegionEdge)
If inequality=">" then
DrawScaleLineTo(gsScaleRight,gsScaleTop,1,0,0,oRegionEdge)
DrawScaleLineTo(gsScaleRight,gsScaleBottom,1,0,0,oRegionEdge)
End If
If inequality="<" then
DrawScaleLineTo(gsScaleLeft,gsScaleTop,1,0,0,oRegionEdge)
DrawScaleLineTo(gsScaleLeft,gsScaleBottom,1,0,0,oRegionEdge)
End If
DrawScaleLineTo(x,gsScaleBottom,1,0,0,oRegionEdge)
oShading = goPage.Bind( oRegionEdge )
oShading.LineStyle = 0
oShading.zOrder=0
goShadings.Add(oShading)
End Sub
'**********************************************************************************************
'Macro ajoutée par Didier Dorange-Pattoret. Elle sert à grouper les objets de la page
Sub Grouper
Dim oDoc,oPage as Object
Dim oAjoute as Object
Dim I as Integer
oCollectionFigures = createUnoService("com.sun.star.drawing.ShapeCollection")
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDoc= oDocGraphPlotter
oPage = oDoc.drawpages(0)
For I=0 To oPage.GetCount()-1
oAJoute=oPage.GetByIndex(I)
If oAjoute.ShapeType <> "com.sun.star.drawing.ControlShape" Then oCollectionFigures.Add(oAjoute)
Next I
oPage.Group(oCollectionFigures)
' oDoc.CurrentController.Select(oCollectionFigures) 'selectionne la figure
End Sub
</script:module>
|