/usr/lib/libreoffice/share/extensions/DmathsAddon/Dmaths2/DrawModule.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 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | <?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="DrawModule" 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
'************************************************
'A collection routines for drawing objects on a Drawing page
'A custom coordinate system is set up in a defined area of the page using the 4 Public
'variables below. This coord system has (0,0) at bottom left hand corner (ie is standard
'as opposed to OOo's built in coord system which has (0,0) at top left)
public glDiagramHeight as Long
public glDiagramWidth as Long
public glDiagramLeft as long
public glDiagramBottom as long
'Default style values for lines, fill areas and fonts
private glLineWidth as long, glLineStyle as long, glLineColor as long, glFillColor as long
private gsFontName as string, gsFontSize as string
'These are the document and page on which everything will be drawn
public goDoc as object
public goPage as object
public oDesktop as Object
'___________________________________________________________________________________________
'Sets up the Diagram area on the page. If Newdoc is true, a new draw document is greated;
'If it is false, the current document is used (which will have to be a Draw document
sub InitialiseDiagramArea(Newdoc as Boolean,DiagramHeight as long,DiagramWidth as long, DiagramLeft as long, DiagramBottom as long)
glDiagramHeight=DiagramHeight
glDiagramWidth=DiagramWidth
glDiagramLeft=DiagramLeft
glDiagramBottom=DiagramBottom
'Default Style Parameters
glLineWidth = 30
glLineStyle = 1
glLineColor = 255
glFillColor = 125000
gsFontName="Arial"
gsFontSize=10
If NewDoc=TRUE then
goDoc = NewDrawDoc()
else
rem goDoc= ThisComponent
oDesktop = createUnoService("com.sun.star.frame.Desktop")
goDoc = oDocGraphPlotter
' goDoc= oDesktop.getCurrentComponent()
end if
goPage= goDoc.drawpages(0)
end sub
'___________________________________________________________________________________________
'Does what it says!
sub ClearDrawPage()
Do While goPage.Count > 0
goPage.remove( goPage.getByIndex( 0 ) )
Loop
End Sub
'___________________________________________________________________________________________
'Create a new Draw document
Function NewDrawDoc() As Object
Dim oDocument As Object
oDocument = StarDesktop.LoadComponentFromURL( "private:factory/sdraw", "_blank", 0, Array() )
NewDrawDoc() = oDocument
End Function
'___________________________________________________________________________________________
'Create and return a new Point object.
'The coordinates are converted from standard ie (0,0) at bottom left
'to what OOo expects ie (0,0) at top left
Function AbsPoint( x As Long, y As Long ) As com.sun.star.awt.Point
Dim aPoint As New com.sun.star.awt.Point
aPoint.x = glDiagramLeft+x
aPoint.y = glDiagramBottom-y
AbsPoint() = aPoint
End Function
'___________________________________________________________________________________________
'Create and return a new Size object.
'The coordinates are converted from standard ie (0,0) at bottom left
'to what OOo expects ie (0,0) at top left
Function AbsSize( width As Long, height As Long ) As com.sun.star.awt.Size
Dim aSize As New com.sun.star.awt.Size
aSize.width = width
aSize.height = -height
AbsSize() = aSize
End Function
'___________________________________________________________________________________________
'Draw a line of given position and size (these can be defined using the AbsPoint and AbsSize
' functions in this module, or the ScalePoint and ScaleSize functions in the AxesSetup module
' or a combination of the two.
'Optional style parameters can be supplied;if omitted, defaults defined above are used
'Optionally, a ShapeCollection object can be supplied, in which case the line drawn will be
' added to this collection.
Function DrawLineShape(position As Object, size As Object,optional LineColor,_
optional LineWidth, optional LineStyle, optional Collection) As Object
If IsMissing(Collection) then
DrawLineShape = DrawShape("LineShape", position, size,LineColor,LineWidth, LineStyle)
else
DrawLineShape = DrawShape("LineShape", position, size,LineColor,LineWidth, LineStyle, Collection)
end if
End Function
'___________________________________________________________________________________________
'Draw a rectangle; corner1 and corner2 should be diagonally opposite corners.
'See comments on DrawLineShape above for further details
Function DrawRectangleShape(corner1 As Object, corner2 As Object,optional LineColor,_
optional LineWidth, optional LineStyle, optional FillColor, optional Collection) As Object
Dim size as new com.sun.star.awt.Size
position=corner1
size.width=corner2.x-corner1.x
size.height=corner2.y-corner1.y
If IsMissing(Collection) then
DrawRectangleShape = DrawShape("RectangleShape", position, size,LineColor,LineWidth, LineStyle)
else
DrawRectangleShape = DrawShape("RectangleShape", position, size,LineColor,LineWidth, LineStyle, Collection)
end if
If IsMissing(FillColor) then
DrawRectangleShape.FillColor=glFillColor
else
DrawRectangleShape.FillColor=FillColor
end if
End Function
'___________________________________________________________________________________________
'Draw a circle with given centre and radius.
'See comments on DrawLineShape above for further details
Function DrawCircleShape(centre As Object, radius as long,optional LineColor,_
optional LineWidth, optional LineStyle, optional FillColor, optional Collection) As Object
Dim size as new com.sun.star.awt.Size
Dim position as new com.sun.star.awt.Point
position.x=centre.x-radius
position.y=centre.y-radius
size.width=2*radius : size.height=2*radius
If IsMissing(Collection) then
DrawCircleShape = DrawShape("EllipseShape", position, size,LineColor,LineWidth, LineStyle)
else
DrawCircleShape = DrawShape("EllipseShape", position, size,LineColor,LineWidth, LineStyle, Collection)
end if
If IsMissing(FillColor) then
DrawCircleShape.FillColor=glFillColor
else
DrawCircleShape.FillColor=FillColor
end if
End Function
'___________________________________________________________________________________________
'Position text on the screen. Poscode defines where "Position" is relative to the text:
'1 is top left, 2 top middle, 3 top right, 4 middle right
'5 bottom right, 6 bottom middle, 7 bottom left, 8 middle left (ie 1-8 clockwise round the text)
'See comments on DrawLineShape above for further details
Function PlaceText(TextString as String, Position as object, PosCode as integer,_
optional FontName, optional FontSize, optional Collection) As object
Dim oText as object
oText = goDoc.createInstance("com.sun.star.drawing.TextShape")
goPage.add(oText)
oText.TextAutoGrowWidth = TRUE : oText.TextAutoGrowHeight = TRUE
oText.setString(textstring)
if IsMissing(FontName) then
oText.CharFontName=gsFontName
else
oText.CharFontName=FontName
end if
if IsMissing(FontSize) then
oText.CharHeight=gsFontSize
else
oText.CharHeight=FontSize
end if
if PosCode=2 or PosCode=6 then
Position.x=Position.x-(oText.getsize().width/2)
elseif PosCode=3 or PosCode=4 or PosCode=5 then
Position.x=Position.x-oText.getsize().width
endif
if PosCode=4 or PosCode=8 then
Position.y=Position.y-(oText.getsize().height/2)
elseif PosCode=5 or PosCode=6 or PosCode=7 then
Position.y=Position.y-oText.getsize().height
endif
oText.position=Position
PlaceText = oText
' If requested, add this to a ShapeCollection
If not IsMissing(Collection) Then
Collection.Add(PlaceText)
EndIf
End Function
'___________________________________________________________________________________________
'Draw any shape; you need to supply the API shapename though.
'See comments on DrawLineShape above for further details
Function DrawShape(ShapeName As String, Position as object, Size as object, optional LineColor,_
optional LineWidth, optional LineStyle, optional Collection) As object
Dim oShape As Object
oShape = goDoc.createInstance("com.sun.star.drawing." & ShapeName)
oShape.Position=Position
oShape.Size=Size
If IsMissing(LineColor) then
oShape.LineColor = glLineColor
else
oShape.LineColor = LineColor
End If
If IsMissing(LineWidth) then
oShape.LineWidth = glLineWidth
else
oShape.LineWidth = LineWidth
End If
If IsMissing(LineStyle) then
oShape.LineStyle = glLineStyle
else
oShape.LineStyle = LineStyle
End If
goPage.add(oShape)
' If requested, add this to a ShapeCollection
If not IsMissing(Collection) Then
Collection.Add(oShape)
EndIf
DrawShape() = oShape
End Function
'___________________________________________________________________________________________
' Draw a line from (x1,y1) to (x2,y2) in the coordinate system defined above.
'See comments on DrawLineShape above for further details
Sub DrawLine( x1 As Long, y1 As Long, x2 As Long, y2 As Long,_
optional LineColor as Long, optional LineWidth as Long, optional LineStyle as Long)
' Create a line shape
Dim oPosition As Object
Dim oSize As Object
Dim oLineShape As Object
oPosition = AbsPoint( x1, y1 )
oSize = AbsSize( x2-x1, y2-y1 )
oLineShape = DrawLineShape(oPosition, oSize,LineColor,LineWidth,LineStyle)
End Sub
'___________________________________________________________________________________________
'Dras a PolyLine defined by the array of Points supplied in Point().
'Stype is either "Open" or "Closed" in which case the last point is joined to the first.
'See comments on DrawLineShape above for further details
Function DrawPolyLine(Point() as object, sType as String, optional LineColor,_
optional LineWidth, optional LineStyle, optional Collection) As Object
dim position as new com.sun.star.awt.Point
dim size as new com.sun.star.awt.Size
pointcount=ubound(Point())
dim Flag(pointcount) as Integer
dim Coords as new com.sun.star.drawing.PolyPolygonBezierCoords
dim Points(0) as object, Flags(0) as object
If IsMissing(Collection) then
DrawPolyLine = DrawShape(sType & "BezierShape", position, size,LineColor,LineWidth, LineStyle)
else
DrawPolyLine = DrawShape(sType & "BezierShape", position, size,LineColor,LineWidth, LineStyle, Collection)
end if
for i=0 to pointcount
Flag(i)=com.sun.star.drawing.PolygonFlags.NORMAL
next i
Points(0)=Point() : Flags(0)=Flag()
Coords.Coordinates=Points() : Coords.Flags=Flags()
DrawPolyLine.PolyPolygonBezier=Coords
End Function
'___________________________________________________________________________________________
'Find the intersection of the shapes supplied in oCollection
'Note that this is the true intersection - not the "Intersection" in the "Modify - Shape"
'menu which is actually the intersection of the bottommost shape and the union of those above it.
'There is no error checking - this assumes oDrawDocument is a valid Drawing
' and oCollection is a Collection of Shapes in the current view of this Drawing
'The function returns a ShapeCollection
Function Intersection(oDrawDocument as Object,oCollection as Object) as Object
Dim viewer as object, docframe as object, dispatcher as object
Dim oBaseShape as object, oPair as object
viewer = oDrawDocument.CurrentController
docframe = viewer.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim Array(0) as new com.sun.star.beans.PropertyValue
oBaseShape=oCollection.getbyindex(0)
for index=1 to oCollection.Count - 1
oPair=NewShapeCollection
oPair.add(oCollection.getbyindex(index))
oPair.add(oBaseShape)
'Select the shapes to be intersected
viewer.Select(oPair)
'Carry out the intersection process
dispatcher.executeDispatch(docframe, ".uno:Intersect", "", 0, Array())
'The resulting intersection is selected so make it the new base shape
oBaseShape = viewer.GetSelection().getbyindex(0)
next index
Intersection=oBaseShape
'Then deselect the intersection
viewer.Select(oDrawDocument)
End Function
'___________________________________________________________________________________________
'Returns a new ShapeCollection object
Function NewShapeCollection() as object
NewShapeCollection() = createUnoService( "com.sun.star.drawing.ShapeCollection" )
End Function
</script:module>
|