Sub oAddLineShape
Dim Dummy()
Dim oDoc
Dim oLine
Dim i as Long
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStepsize as Double
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oNum = 13
oStepsize = CDbl(oDwImpPage.height - 2000*2) / oNum
for i = 0 to oNum
oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
oPos.x = 2000
oPos.y = CLng(CDbl(i) * oStepsize) + 1500
oLine.setPosition(oPos)
oSize.width = oDwImpPage.width/4
oSize.height = 0
oLine.setSize(oSize)
oDwImpPage.add(oLine)
Select case i
case 0
oLine.LineStartName = ""
oLine.LineEndName = "Arrow short"
oLine.LineEndWidth = 1000
case 1
oLine.LineStartName = "Concave short"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Arrow"
oLine.LineEndWidth = 1000
case 2
oLine.LineStartName = "Triangle"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Concave"
oLine.LineEndWidth = 1000
case 3
oLine.LineStartName = "Arrow large"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Circle"
oLine.LineEndWidth = 1000
case 4
oLine.LineStartName = "Square"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Square 45"
oLine.LineEndWidth = 1000
case 5
oLine.LineStartName = "Diamond"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Circle"
oLine.LineEndWidth = 1000
case 6
oLine.LineStartName = "Dimension Lines"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Dimension Line Arrow"
oLine.LineEndWidth = 1000
case 7
oLine.LineStartName = "Dimension Line"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Line short"
oLine.LineEndWidth = 1000
case 8
oLine.LineStartName = "Line"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Circle unfilled"
oLine.LineEndWidth = 1000
case 9
oLine.LineStartName = "Half Arrow left"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Arrow right"
oLine.LineEndWidth = 1000
case 10
oLine.LineStartName = "Reversed Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Double Arrow"
oLine.LineEndWidth = 1000
case 11
oLine.LineStartName = "CF One"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Only One"
oLine.LineEndWidth = 1000
case 12
oLine.LineStartName = "CF Many"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Many One"
oLine.LineEndWidth = 1000
case 13
oLine.LineStartName = "CF Zero One"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Zero Many"
oLine.LineEndWidth = 1000
End Select
next i
msgbox "Success" & Chr$(13),0,"LO7.0.4.2(x64)"
End Sub
【 解説 】
LineEndName や LineEndNameで、
Small Arrow
Rounded short Arrow
Symmetric Arrow
はなくなりました。
Sub oAddLineShape
Dim Dummy()
Dim oDoc
Dim oLine
Dim i as Long
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStepsize as Double
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oNum = 13
oStepsize = (29400-2000*2) / oNum
for i = 0 to oNum
oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
oPos.x = 2000
oPos.y = CLng(CDbl(i) * oStepsize) + 1500
oLine.setPosition(oPos)
oSize.width = 5000
oSize.height = 0
oLine.setSize(oSize)
oDwImpPage.add(oLine)
Select case i
case 0
oLine.LineStartName = ""
oLine.LineEndName = "Arrow short"
oLine.LineEndWidth = 1000
case 1
oLine.LineStartName = "Concave short"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Arrow"
oLine.LineEndWidth = 1000
case 2
oLine.LineStartName = "Triangle"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Concave"
oLine.LineEndWidth = 1000
case 3
oLine.LineStartName = "Arrow large"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Circle"
oLine.LineEndWidth = 1000
case 4
oLine.LineStartName = "Square"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Square 45"
oLine.LineEndWidth = 1000
case 5
oLine.LineStartName = "Diamond"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Circle"
oLine.LineEndWidth = 1000
case 6
oLine.LineStartName = "Dimension Lines"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Dimension Line Arrow"
oLine.LineEndWidth = 1000
case 7
oLine.LineStartName = "Dimension Line"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Line short"
oLine.LineEndWidth = 1000
case 8
oLine.LineStartName = "Line"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Circle unfilled"
oLine.LineEndWidth = 1000
case 9
oLine.LineStartName = "Half Arrow left"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Arrow right"
oLine.LineEndWidth = 1000
case 10
oLine.LineStartName = "Reversed Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Double Arrow"
oLine.LineEndWidth = 1000
case 11
oLine.LineStartName = "CF One"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Only One"
oLine.LineEndWidth = 1000
case 12
oLine.LineStartName = "CF Many"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Many One"
oLine.LineEndWidth = 1000
case 13
oLine.LineStartName = "CF Zero One"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Zero Many"
oLine.LineEndWidth = 1000
End Select
next i
msgbox "Success" & Chr$(13),0,"LO7.0.4.2(x64)"
End Sub
Sub oAddLineShape
Dim Dummy()
Dim oDoc as Object
Dim oLine as Object
Dim i as Long
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStepsize as Double
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPage()
oNum = 13
for i = 0 to oNum
oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
'
positionShape( oLine, 1000, 1000 + i * 2000, 5000, 0 )
'
oDwImpPage.add(oLine)
Select case i
case 0
oLine.LineStartName = ""
oLine.LineEndName = "Arrow short"
oLine.LineEndWidth = 1000
case 1
oLine.LineStartName = "Concave short"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Arrow"
oLine.LineEndWidth = 1000
case 2
oLine.LineStartName = "Triangle"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Concave"
oLine.LineEndWidth = 1000
case 3
oLine.LineStartName = "Arrow large"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Circle"
oLine.LineEndWidth = 1000
case 4
oLine.LineStartName = "Square"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Square 45"
oLine.LineEndWidth = 1000
case 5
oLine.LineStartName = "Diamond"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Circle"
oLine.LineEndWidth = 1000
case 6
oLine.LineStartName = "Dimension Lines"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Dimension Line Arrow"
oLine.LineEndWidth = 1000
case 7
oLine.LineStartName = "Dimension Line"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Line short"
oLine.LineEndWidth = 1000
case 8
oLine.LineStartName = "Line"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Circle unfilled"
oLine.LineEndWidth = 1000
case 9
oLine.LineStartName = "Half Arrow left"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Half Arrow right"
oLine.LineEndWidth = 1000
case 10
oLine.LineStartName = "Reversed Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Double Arrow"
oLine.LineEndWidth = 1000
case 11
oLine.LineStartName = "CF One"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Only One"
oLine.LineEndWidth = 1000
case 12
oLine.LineStartName = "CF Many"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Many One"
oLine.LineEndWidth = 1000
case 13
oLine.LineStartName = "CF Zero One"
oLine.LineStartWidth = 1000
oLine.LineEndName = "CF Zero Many"
oLine.LineEndWidth = 1000
End Select
next i
msgbox "Success" & Chr$(13),0,"LO7.0.4.2(x64)"
End Sub
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oAddLineShape
Dim Dummy()
Dim oDoc
Dim oLine
Dim i as Long
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStepsize as Double
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oStepsize = CDbl(oDwImpPage.height - 10000*2) / 10
for i = 0 to 10
oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
oPos.x = 2000
oPos.y = CLng(CDbl(i) * oStepsize) + 1500
oLine.setPosition(oPos)
oSize.width = oDwImpPage.width/4
oSize.height = 0
oLine.setSize(oSize)
oDwImpPage.add(oLine)
Select case i
case 0
' 実線
oLine.LineStartName = ""
oLine.LineEndName = ""
case 1
' 極細の細線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Ultrafine Dashed"
case 2
' 細かい破線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dashed"
case 3
' 細かい点線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dotted"
case 4
' 細かい点の集まった線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Line with Fine Dots"
case 5
' 細かい破線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dashed (var)"
case 6
' 三破線三点鎖線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "3 Dashes 3 Dots (var)"
case 7
' 極細の点線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Ultrafine Dotted (var)"
case 8
' 線スタイル9
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Line Style 9"
case 9
' 二点鎖線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "2 Dots 1 Dash"
case 10
' 破線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Dashed (var)"
End Select
next i
End Sub
Sub oAddLineShape
Dim Dummy()
Dim oDoc
Dim oLine
Dim i as Long
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStepsize as Double
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oStepsize = (29400-10000*2) / 10
for i = 0 to 10
oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
oPos.x = 2000
oPos.y = CLng(CDbl(i) * oStepsize) + 1500
oLine.setPosition(oPos)
oSize.width = 5000
oSize.height = 0
oLine.setSize(oSize)
oDwImpPage.add(oLine)
Select case i
case 0
' 実線
oLine.LineStartName = ""
oLine.LineEndName = ""
case 1
' 極細の細線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Ultrafine Dashed"
case 2
' 細かい破線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dashed"
case 3
' 細かい点線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dotted"
case 4
' 細かい点の集まった線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Line with Fine Dots"
case 5
' 細かい破線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dashed (var)"
case 6
' 三破線三点鎖線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "3 Dashes 3 Dots (var)"
case 7
' 極細の点線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Ultrafine Dotted (var)"
case 8
' 線スタイル9
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Line Style 9"
case 9
' 二点鎖線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "2 Dots 1 Dash"
case 10
' 破線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Dashed (var)"
End Select
next i
End Sub
Sub oAddLineShape
Dim Dummy()
Dim oDoc as Object
Dim oLine as Object
Dim i as Long
Dim oPos as new com.sun.star.awt.Point
Dim oSize as new com.sun.star.awt.Size
Dim oStepsize as Double
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPage()
for i = 0 to 10
oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
'
positionShape( oLine, 1000, 1000 + i * 1000, 5000, 0 )
'
oDwImpPage.add(oLine)
Select case i
case 0
' 実線
oLine.LineStartName = ""
oLine.LineEndName = ""
case 1
' 極細の細線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Ultrafine Dashed"
case 2
' 細かい破線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dashed"
case 3
' 細かい点線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dotted"
case 4
' 細かい点の集まった線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Line with Fine Dots"
case 5
' 細かい破線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Fine Dashed (var)"
case 6
' 三破線三点鎖線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "3 Dashes 3 Dots (var)"
case 7
' 極細の点線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Ultrafine Dotted (var)"
case 8
' 線スタイル9
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Line Style 9"
case 9
' 二点鎖線
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "2 Dots 1 Dash"
case 10
' 破線(可変)
oLine.LineStartName = ""
oLine.LineEndName = ""
oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
oLine.LineDashName = "Dashed (var)"
End Select
next i
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oDShape
Dim oDoc
Dim oPage
Dim oShape
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' Ellipse
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
' Position
oPoint = oShape.Position
oPoint.X = oPage.Width / 4
oPoint.Y = oPage.Height / 10 + oPage.BorderTop +1000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
oPage.add(oShape)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oShape.FillColor = RGB(255,255,100)
oShape.FillTransparence = "50%" 'Transparency Percentage (透過度)
' Rectangle
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = oPage.Width / 4
oPoint.Y = oPage.Height / 10 + oPage.BorderTop + 4000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
'Draw
oPage.add(oShape)
'Bitmap
oShape.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
oShape.FillBitmapName = "Sky"
oShape.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
'ClosedBezier
Dim oCoords 'Coordinates of the polygon to insert
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
xP = oPage.Width / 4 + 3000
yP = oPage.Height / 10 + oPage.BorderTop
oCoords.Coordinates = Array( Array( _
CreatePoint( xP+1000, yP+1000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+5000, yP+1000 ) _
) _
)
oCoords.Flags = Array(Array( _
com.sun.star.drawing.PolygonFlags.NORMAL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.NORMAL _
)_
)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
oPage.add(oShape)
oShape.PolyPolygonBezier = oCoords
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' GradientStyle
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.LINEAR
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'PolyPolygonShape
Dim oPoints_1
xP1 = oPage.Width / 4 + 3000
yP1 = oPage.Height / 10 + oPage.BorderTop + 3000
oPoints_1 = Array(_
CreatePoint( xP1+1000, yP1+1000 ),_
CreatePoint( xP1+3500, yP1+3500 ),_
CreatePoint( xP1+1000, yP1+3500 ),_
CreatePoint( xP1+3500, yP1+1000 )_
)
oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
oPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
'
Dim oHatch As New com.sun.star.drawing.Hatch
oHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE 'DOUBLE
oHatch.Color = RGB(64,64,64)
oHatch.Distance = 100
oHatch.Angle = 450
oShape.FillHatch = oHatch
oShape.FillBackground = RGB(255,255,255)
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
Sub oDShape
Dim oDoc
Dim oPage
Dim oShape
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' Ellipse
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
' Position
oPoint = oShape.Position
oPoint.X = 2000
oPoint.Y = 2000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
oPage.add(oShape)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oShape.FillColor = RGB(255,255,100)
oShape.FillTransparence = "50%" 'Transparency Percentage (透過度)
' Rectangle
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = 2000
oPoint.Y = 5000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
'Draw
oPage.add(oShape)
'Bitmap
oShape.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
oShape.FillBitmapName = "Sky"
oShape.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
'ClosedBezier
Dim oCoords 'Coordinates of the polygon to insert
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
xP = 5000
yP = 2000
oCoords.Coordinates = Array( Array( _
CreatePoint( xP+1000, yP+1000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+5000, yP+1000 ) _
) _
)
oCoords.Flags = Array(Array( _
com.sun.star.drawing.PolygonFlags.NORMAL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.NORMAL _
)_
)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
oPage.add(oShape)
oShape.PolyPolygonBezier = oCoords
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' GradientStyle
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.LINEAR
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'PolyPolygonShape
Dim oPoints_1
xP1 = 5000
yP1 = 5000
oPoints_1 = Array(_
CreatePoint( xP1+1000, yP1+1000 ),_
CreatePoint( xP1+3500, yP1+3500 ),_
CreatePoint( xP1+1000, yP1+3500 ),_
CreatePoint( xP1+3500, yP1+1000 )_
)
oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
oPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
'
Dim oHatch As New com.sun.star.drawing.Hatch
oHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE 'DOUBLE
oHatch.Color = RGB(64,64,64)
oHatch.Distance = 100
oHatch.Angle = 450
oShape.FillHatch = oHatch
oShape.FillBackground = RGB(255,255,255)
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
Sub oDShape
Dim oDoc
Dim oPage
Dim oShape
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
'
oWriterPage = oDoc.getDrawPage()
'
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oPage = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
' Ellipse
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
'
oWriterPage.add(oShape)
'
Dim oX
Dim oY
oX = 1000
oY = 1000
oPositionShape( oShape, oX, oY, 2500, 2500 )
'
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oShape.FillColor = RGB(255,255,100)
oShape.FillTransparence = "50%" 'Transparency Percentage (透過度)
' Rectangle
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oWriterPage.add(oShape)
'
oX = 1000
oY = 4000
oPositionShape( oShape, oX, oY, 2500, 2500 )
'
'Bitmap
oShape.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
oShape.FillBitmapName = "Sky"
oShape.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
'ClosedBezier
Dim oCoords 'Coordinates of the polygon to insert
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
'
xP = 2500
yP = 6000
oCoords.Coordinates = Array( Array( _
CreatePoint( xP+1000, yP+1000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+5000, yP+1000 ) _
) _
)
oCoords.Flags = Array(Array( _
com.sun.star.drawing.PolygonFlags.NORMAL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.NORMAL _
)_
)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
'
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
oWriterPage.add(oShape)
oShape.PolyPolygonBezier = oCoords
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' GradientStyle
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.LINEAR
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'
'PolyPolygonShape
Dim oPoints_1
xP1 = 2500
yP1 = 8500
oPoints_1 = Array(_
CreatePoint( xP1+1000, yP1+1000 ),_
CreatePoint( xP1+3500, yP1+3500 ),_
CreatePoint( xP1+1000, yP1+3500 ),_
CreatePoint( xP1+3500, yP1+1000 )_
)
oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
'
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
oWriterPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
'
Dim oHatch As New com.sun.star.drawing.Hatch
oHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE 'DOUBLE
oHatch.Color = RGB(64,64,64)
oHatch.Distance = 100
oHatch.Angle = 450
oShape.FillHatch = oHatch
oShape.FillBackground = RGB(255,255,255)
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
Sub oDShape
Dim oDoc
Dim oPage
Dim oShape
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' Ellipse
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
' Position
oPoint = oShape.Position
oPoint.X = oPage.Width / 4
oPoint.Y = oPage.Height / 10 + oPage.BorderTop +1000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
oPage.add(oShape)
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.AXIAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash1 as New com.sun.star.drawing.LineDash
With oDash1
.Style = com.sun.star.drawing.DashStyle.ROUND
.Dashes = 1
.DashLen = 100
.Distance = 100
End With
oShape.LineDash = oDash1
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
' Rectangle
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = oPage.Width / 4
oPoint.Y = oPage.Height / 10 + oPage.BorderTop + 4000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
'Draw
oPage.add(oShape)
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.RADIAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash2 as New com.sun.star.drawing.LineDash
With oDash2
.Style = com.sun.star.drawing.DashStyle.RECT
.Dots = 2
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 50
End With
oShape.LineDash = oDash2
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
'ClosedBezier
Dim oCoords 'Coordinates of the polygon to insert
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
xP = oPage.Width / 4 + 3000
yP = oPage.Height / 10 + oPage.BorderTop
oCoords.Coordinates = Array( Array( _
CreatePoint( xP+1000, yP+1000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+5000, yP+1000 ) _
) _
)
oCoords.Flags = Array(Array( _
com.sun.star.drawing.PolygonFlags.NORMAL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.NORMAL _
)_
)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
oPage.add(oShape)
oShape.PolyPolygonBezier = oCoords
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.ELLIPTICAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash3 as New com.sun.star.drawing.LineDash
With oDash3
.Style = com.sun.star.drawing.DashStyle.ROUND
.Dots = 1
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 100
End With
oShape.LineDash = oDash3
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
'
'PolyPolygonShape
Dim oPoints_1
xP1 = oPage.Width / 4 + 3000
yP1 = oPage.Height / 10 + oPage.BorderTop + 3000
oPoints_1 = Array(_
CreatePoint( xP1+1000, yP1+1000 ),_
CreatePoint( xP1+3500, yP1+3500 ),_
CreatePoint( xP1+1000, yP1+3500 ),_
CreatePoint( xP1+3500, yP1+1000 )_
)
oShape = ThisComponent.createInstance("com.sun.star.drawing.PolyPolygonShape")
oPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
'
Dim oHatch As New com.sun.star.drawing.Hatch
oHatch.Style = com.sun.star.drawing.HatchStyle.DOUBLE
oHatch.Color = RGB(64,64,64)
oHatch.Distance = 100 ' unit = 1/100 mm
oHatch.Angle = 450 ' unit = 1/10 degree
oShape.FillHatch = oHatch
oShape.FillBackground = RGB(255,255,255)
'
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash4 as New com.sun.star.drawing.LineDash
With oDash4
.Style = com.sun.star.drawing.DashStyle.RECT
.Dots = 3
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 50
End With
oShape.LineDash = oDash4
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
Sub oDShape
Dim oDoc
Dim oPage
Dim oShape
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' Ellipse
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
' Position
oPoint = oShape.Position
oPoint.X = 2000
oPoint.Y = 2000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
oPage.add(oShape)
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.AXIAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash1 as New com.sun.star.drawing.LineDash
With oDash1
.Style = com.sun.star.drawing.DashStyle.ROUND
.Dashes = 1
.DashLen = 100
.Distance = 100
End With
oShape.LineDash = oDash1
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
' Rectangle
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = 2000
oPoint.Y = 5000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 2500 ' unit : 1/100mm
oSize.Width = 2500 ' unit : 1/100mm
oShape.Size = oSize
'Draw
oPage.add(oShape)
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.RADIAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash2 as New com.sun.star.drawing.LineDash
With oDash2
.Style = com.sun.star.drawing.DashStyle.RECT
.Dots = 2
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 50
End With
oShape.LineDash = oDash2
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
'ClosedBezier
Dim oCoords 'Coordinates of the polygon to insert
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
xP = 5000
yP = 2000
oCoords.Coordinates = Array( Array( _
CreatePoint( xP+1000, yP+1000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+5000, yP+1000 ) _
) _
)
oCoords.Flags = Array(Array( _
com.sun.star.drawing.PolygonFlags.NORMAL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.NORMAL _
)_
)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
oPage.add(oShape)
oShape.PolyPolygonBezier = oCoords
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.ELLIPTICAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash3 as New com.sun.star.drawing.LineDash
With oDash3
.Style = com.sun.star.drawing.DashStyle.ROUND
.Dots = 1
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 100
End With
oShape.LineDash = oDash3
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
'
'PolyPolygonShape
Dim oPoints_1
xP1 = 5000
yP1 = 5000
oPoints_1 = Array(_
CreatePoint( xP1+1000, yP1+1000 ),_
CreatePoint( xP1+3500, yP1+3500 ),_
CreatePoint( xP1+1000, yP1+3500 ),_
CreatePoint( xP1+3500, yP1+1000 )_
)
oShape = ThisComponent.createInstance("com.sun.star.drawing.PolyPolygonShape")
oPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
'
Dim oHatch As New com.sun.star.drawing.Hatch
oHatch.Style = com.sun.star.drawing.HatchStyle.DOUBLE
oHatch.Color = RGB(64,64,64)
oHatch.Distance = 100 ' unit = 1/100 mm
oHatch.Angle = 450 ' unit = 1/10 degree
oShape.FillHatch = oHatch
oShape.FillBackground = RGB(255,255,255)
'
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash4 as New com.sun.star.drawing.LineDash
With oDash4
.Style = com.sun.star.drawing.DashStyle.RECT
.Dots = 3
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 50
End With
oShape.LineDash = oDash4
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
Sub oDShape
Dim oDoc
Dim oPage
Dim oShape
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
'
oWriterPage = oDoc.getDrawPage()
'
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oPage = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
'oPage = oDoc.getDrawPages().getByIndex(0)
' Ellipse
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
oWriterPage.add(oShape)
'
Dim oX
Dim oY
oX = 1000
oY = 1000
oPositionShape( oShape, oX, oY, 2500, 2500 )
'
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.AXIAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash1 as New com.sun.star.drawing.LineDash
With oDash1
.Style = com.sun.star.drawing.DashStyle.ROUND
.Dashes = 1
.DashLen = 100
.Distance = 100
End With
oShape.LineDash = oDash1
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
' Rectangle
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oWriterPage.add(oShape)
'
oX = 1000
oY = 4000
oPositionShape( oShape, oX, oY, 2500, 2500 )
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.RADIAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash2 as New com.sun.star.drawing.LineDash
With oDash2
.Style = com.sun.star.drawing.DashStyle.RECT
.Dots = 2
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 50
End With
oShape.LineDash = oDash2
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
'ClosedBezier
Dim oCoords 'Coordinates of the polygon to insert
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
xP = 2500
yP = 6000
oCoords.Coordinates = Array( Array( _
CreatePoint( xP+1000, yP+1000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+3000, yP+4000 ), _
CreatePoint( xP+5000, yP+1000 ) _
) _
)
oCoords.Flags = Array(Array( _
com.sun.star.drawing.PolygonFlags.NORMAL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.CONTROL,_
com.sun.star.drawing.PolygonFlags.NORMAL _
)_
)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
oWriterPage.add(oShape)
'
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
oShape.PolyPolygonBezier = oCoords
'Gradient
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
' Gradietion Style
oGradient = createUnoStruct("com.sun.star.awt.Gradient")
With oGradient
.Style = com.sun.star.awt.GradientStyle.ELLIPTICAL
.StartColor = RGB( 255, 255, 0 )
.EndColor = RGB( 255, 0, 0 )
.Angle = 300 ' unit : 1/10 degree
.Border = 10
.XOffset = 0
.YOffset = 0
.StartIntensity = 100
.EndIntensity = 100
.StepCount = 128
End With
oShape.FillGradient = oGradient
'
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash3 as New com.sun.star.drawing.LineDash
With oDash3
.Style = com.sun.star.drawing.DashStyle.ROUND
.Dots = 1
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 100
End With
oShape.LineDash = oDash3
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
'
'PolyPolygonShape
Dim oPoints_1
xP1 = 2500
yP1 = 8500
oPoints_1 = Array(_
CreatePoint( xP1+1000, yP1+1000 ),_
CreatePoint( xP1+3500, yP1+3500 ),_
CreatePoint( xP1+1000, yP1+3500 ),_
CreatePoint( xP1+3500, yP1+1000 )_
)
oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
oWriterPage.add(oShape)
'
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
oShape.PolyPolygon = Array(oPoints_1)
'Fill
oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
'
Dim oHatch As New com.sun.star.drawing.Hatch
oHatch.Style = com.sun.star.drawing.HatchStyle.DOUBLE
oHatch.Color = RGB(64,64,64)
oHatch.Distance = 100 ' unit = 1/100 mm
oHatch.Angle = 450 ' unit = 1/10 degree
oShape.FillHatch = oHatch
oShape.FillBackground = RGB(255,255,255)
'
'Line Propertis
oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
'Dash
Dim oDash4 as New com.sun.star.drawing.LineDash
With oDash4
.Style = com.sun.star.drawing.DashStyle.RECT
.Dots = 3
.DotLen = 50
.Dashes = 1
.DashLen = 500
.Distance = 50
End With
oShape.LineDash = oDash4
'
oShape.LineColor = RGB(0,0,255)
oShape.LineWidth = 50 ' Unit : 1/100 mm
oShape.LineTransparence = "0%"
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
'
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = createDrawPage(oDOc, "Test Draw", True)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oShape.setPosition(createPoint(3000, 1000))
oShape.setSize(createSize(6000, 1000))
oShape.setString("OOoMacro")
' 影付き
oShape.Shadow = True
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oShape.setPosition(createPoint(3000, 5000))
oShape.setSize(createSize(6000, 1000))
oShape.setString("OOoMacro")
' 影付き
oShape.Shadow = True
' Shadow Prop
oShape.ShadowXDistance = -1000
oShape.ShadowYDistance = -1000
oShape.ShadowColor = 255000000
oShape.ShadowTransparence = 50% ' 透明度
oShape.CornerRadius = 100
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oShape.setPosition(createPoint(3000, 1000))
oShape.setSize(createSize(6000, 1000))
oShape.setString("OOoMacro")
' 影付き
oShape.Shadow = True
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oShape.setPosition(createPoint(3000, 5000))
oShape.setSize(createSize(6000, 1000))
oShape.setString("OOoMacro")
' 影付き
oShape.Shadow = True
' Shadow Prop
oShape.ShadowXDistance = -1000
oShape.ShadowYDistance = -1000
oShape.ShadowColor = 255000000
oShape.ShadowTransparence = 50% ' 透明度
oShape.CornerRadius = 100
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oPage = oDoc.getDrawPage()
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
'
oPositionShape( oShape, 1000, 1500, 3000, 1000 )
'
oShape.setString("OOoMacro")
' 影付き
oShape.Shadow = True
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
'
oPositionShape( oShape, 2000, 4500, 3000, 1000 )
'
oShape.setString("OOoMacro")
' 影付き
oShape.Shadow = True
' Shadow Prop
oShape.ShadowXDistance = -1000
oShape.ShadowYDistance = -1000
oShape.ShadowColor = 255000000
oShape.ShadowTransparence = 50% ' 透明度
oShape.CornerRadius = 100
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = createDrawPage(oDOc, "Test Draw", True)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(4000,1500))
oShape.setString("OOoMacro1")
' 20degree RotateAngle
oShape.RotateAngle = 2000 ' unit : 1/100 degree
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(4000,1500))
oShape.setString("OOoMacro1")
' 20degree RotateAngle
oShape.RotateAngle = 2000 ' unit : 1/100 degree
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oPage = oDoc.getDrawPage()
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
'
oPositionShape( oShape, 1000, 1500, 3000, 1000 )
'
oShape.setString("OOoMacro1")
' 20degree RotateAngle
oShape.RotateAngle = 2000 ' unit : 1/100 degree
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub ToggleOfRotateMode()
Dim oDoc as Object, oCtrl as Object, oFrame
Dim oDrawP as Object
Dim oShape as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oDrawP = oDoc.getDrawPages().getByIndex(0)
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
' Position
oPoint = oShape.Position
oPoint.X = 1000
oPoint.Y = 1000
oShape.Position = oPoint
' Size
oSize = oShape.Size
oSize.Height = 1200 ' unit : 1/100mm
oSize.Width = 1500 ' unit : 1/100mm
oShape.Size = oSize
oDrawP.add(oShape)
'
' 作成したShapeを選択状態にする
oCtrl = oDoc.CurrentController()
oCtrl.select(oShape)
'
' ObjectのRotaion Mode ON / OFF
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch( oFrame, ".uno:ToggleObjectRotateMode", "", 0, Array())
msgbox "Roataion Mode = ON",0,"Toggle of Rotaion"
'
oDispatcher.executeDispatch( oFrame, ".uno:ToggleObjectRotateMode", "", 0, Array())
msgbox "Roataion Mode = OFF",0,"Toggle of Rotaion"
End Sub
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = createDrawPage(oDOc, "Test Draw", True)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(4000,1500))
oShape.setString("OOoMacro1")
' 30degree ShearAngle
oShape.ShearAngle = 3000 ' unit : 1/100 degree
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(4000,1500))
oShape.setString("OOoMacro1")
' 30degree ShearAngle
oShape.ShearAngle = 3000 ' unit : 1/100 degree
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oPage = oDoc.getDrawPage()
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
'
oPositionShape( oShape, 1000, 1500, 3000, 1000 )
'
oShape.setString("OOoMacro1")
' 30degree ShearAngle
oShape.ShearAngle = 3000 ' unit : 1/100 degree
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = createDrawPage(oDOc, "Test Draw", True)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro1")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.NONE
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,6000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro2")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,9000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro3")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.ALLLINES
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,12000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro4")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.RESIZEATTR
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro1")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.NONE
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,6000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro2")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,9000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro3")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.ALLLINES
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,12000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro4")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.RESIZEATTR
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oPage = oDoc.getDrawPage()
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 1500, 3000, 1000 )
oShape.setString("OOoMacro1")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.NONE
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 3000, 3000, 1000 )
oShape.setString("OOoMacro2")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 4500, 3000, 1000 )
oShape.setString("OOoMacro3")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.ALLLINES
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 6000, 3000, 1000 )
oShape.setString("OOoMacro4")
'
oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.RESIZEATTR
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = createDrawPage(oDOc, "Test Draw", True)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro1")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,6000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro2")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,9000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro3")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.RIGHT
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,12000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro4")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.BLOCK
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro1")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,6000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro2")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,9000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro3")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.RIGHT
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,12000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro4")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.BLOCK
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oPage = oDoc.getDrawPage()
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 1500, 3000, 1000 )
oShape.setString("OOoMacro1")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 3000, 3000, 1000 )
oShape.setString("OOoMacro2")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 4500, 3000, 1000 )
oShape.setString("OOoMacro3")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.RIGHT
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 6000, 3000, 1000 )
oShape.setString("OOoMacro4")
'
oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.BLOCK
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
oPage = createDrawPage(oDOc, "Test Draw", True)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro1")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,6000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro2")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,9000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro3")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BOTTOM
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,12000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro4")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BLOCK
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
oPage = oDoc.getDrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,3000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro1")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,6000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro2")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,9000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro3")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BOTTOM
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
'
oPage.add(oShape)
oShape.setPosition(createPoint(3000,12000))
oShape.setSize(createSize(6000,2000))
oShape.setString("OOoMacro4")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BLOCK
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oPage = oDoc.getDrawPage()
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 1500, 3000, 1500 )
oShape.setString("OOoMacro1")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 3500, 3000, 1500 )
oShape.setString("OOoMacro2")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 5500, 3000, 1500 )
oShape.setString("OOoMacro3")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BOTTOM
'
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 7500, 3000, 1500 )
oShape.setString("OOoMacro4")
'
oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BLOCK
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
DIm oLocs
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
'
oLocs = Array( _
com.sun.star.drawing.CircleKind.FULL, _
com.sun.star.drawing.CircleKind.SECTION, _
com.sun.star.drawing.CircleKind.CUT, _
com.sun.star.drawing.CircleKind.ARC, _
)
'
oPage = createDrawPage(oDOc, "Test Draw", True)
'
for i = LBound(oLocs) to UBound(oLocs)
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
oPage.add(oShape)
oShape.setPosition(CreatePoint((i+1)*2000, 1000))
oShape.setSize(CreateSize(1000, 700))
oShape.setString(i)
oShape.CircleStartAngle = 9000
oShape.CircleEndAngle = 36000
oShape.CircleKind = oLocs(i)
next i
oShape.RotateAngle = 3000
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'[ Function 3 ]
Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
Dim oPages 'All of the draw pages
Dim oPage 'A single draw page
Dim i% 'General index variable
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get out of the for loop.
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page and then get out of the function.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'Did not find the page, or found the page and removed it. Create a new page, set the name, and return the page.
' oPages.insertNewByIndex(oPages.getCount())
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
DIm oLocs
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
'
oLocs = Array( _
com.sun.star.drawing.CircleKind.FULL, _
com.sun.star.drawing.CircleKind.SECTION, _
com.sun.star.drawing.CircleKind.CUT, _
com.sun.star.drawing.CircleKind.ARC, _
)
'
oPage = oDoc.getDrawPages().getByIndex(0)
'
for i = LBound(oLocs) to UBound(oLocs)
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
oPage.add(oShape)
oShape.setPosition(CreatePoint((i+1)*2000, 1000))
oShape.setSize(CreateSize(1000, 700))
oShape.setString(i)
oShape.CircleStartAngle = 9000
oShape.CircleEndAngle = 36000
oShape.CircleKind = oLocs(i)
next i
oShape.RotateAngle = 3000
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oDShapeProp
Dim oPage 'Page on which to draw
Dim oShape 'Shape to insert
Dim oCircle
DIm oLocs
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
'
oLocs = Array( _
com.sun.star.drawing.CircleKind.FULL, _
com.sun.star.drawing.CircleKind.SECTION, _
com.sun.star.drawing.CircleKind.CUT, _
com.sun.star.drawing.CircleKind.ARC, _
)
'
oPage = oDoc.getDrawPage()
'
for i = LBound(oLocs) to UBound(oLocs)
oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
oPage.add(oShape)
oPositionShape( oShape, 1000, 1500 + i*2000 , 3000, 1500 )
oShape.setString(i)
oShape.CircleStartAngle = 9000
oShape.CircleEndAngle = 36000
oShape.CircleKind = oLocs(i)
next i
oShape.RotateAngle = 3000
End Sub
'
'
Sub oPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
Sub MirrorObject()
Dim oDoc as Object, oCtrl as Object, oFrame
Dim oPage as object
Dim oLine as Object, oShape as Object
Dim oPosition As New com.sun.star.awt.Point
Dim oSize As New com.sun.star.awt.Size
Dim oDispatcher as Object
oDoc = ThisComponent
oPage = oDoc.DrawPages().getByIndex(0)
' Line Object
oLine = oDoc.createInstance( "com.sun.star.drawing.LineShape" )
oLine.LineColor = RGB( 255, 0, 0 )
oLine.LineWidth = 100
' Position
oPosition.X = 500
oPosition.Y = 500
oLine.setPosition(oPosition)
' Size
oSize.width = 2500
oSize.height= 2500
oLine.setSize(oSize)
oPage.add( oLine )
' 両端形状
oLine.LineStartName = "Square"
oLine.LineStartWidth = 500
oLine.LineEndName = "Small Arrow"
oLine.LineEndWidth = 500
msgbox "Draw Line !!",0,"Initial"
'
' Selected Object
oCtrl = oDoc.CurrentController()
oCtrl.select(oLine)
'
' The Mirroring in the horizontal direction
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorHorizontal", "", 0, Array())
msgbox "Horizontal",0,"Mirroring"
'
oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorVertical", "", 0, Array())
msgbox "Vertical",0,"Mirroring"
End Sub
Sub MirrorObject()
Dim oDoc as Object, oCtrl as Object, oFrame
Dim oPage as Object
Dim oShape as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oPage = oDoc.DrawPages().getByIndex(0)
' 四角形の中にTEXT
oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
oPage.add(oShape)
oShape.setPosition(createPoint(1000, 1000))
oShape.setSize(createSize(3000, 1000))
oShape.setString("LibreOffice")
'
' Selected Object
oCtrl = oDoc.CurrentController()
oCtrl.select(oShape)
'
' The Mirroring in the horizontal direction
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
wait 10
oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorHorizontal", "", 0, Array())
msgbox "文字を記入している為" & Chr$(10) & "Horizontalの反転は不可",0,"Mirroring"
'
oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorVertical", "", 0, Array())
msgbox "Verticalは文字も反転する" & Chr$(10) & "180°回転した結果と同じ",0,"Mirroring"
End Sub
'
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
Sub oShapeText()
Dim oPage as Object, oShape as Object
Dim oDoc as Object
oDoc = ThisComponent
oPage = oDoc.DrawPages().getByIndex(0)
' Only Text
oShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
oPage.add(oShape)
oShape.setPosition(createPoint(100, 400))
oShape.setSize(createSize(5000, 1000))
oShape.setString("TextShape")
' Text Animation
oShape.TextAnimationKind = com.sun.star.drawing.TextAnimationKind.SCROLL
'
msgbox "Success",0,"LO4.3.1"
End Sub
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'[ Function 2 ]
Function CreateSize(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Size
Dim oSize
oSize = createUnoStruct( "com.sun.star.awt.Size" )
oSize.Width = x : oSize.Height = y
CreateSize = oSize
End Function
'
' [ Note ]
' com.sun.star.drawing.TextAnimationKind
'
' NONE : なし
' BLINK : 点滅
' SCROLL : 通過
' ALTERNATE : 前方に進行
' SLIDE : 流し込み
