create a new page, using OOobbs3/31 as a template.
Front page
Search
掲示板
Reload
Help
Browse Log
掲示板の使い方
OOo 掲示板３
OOo 掲示板２
OOo 掲示板
掲示板
雑談掲示板
New
List of pages
Recent changes
Backup
簡単ヘルプ
整形ルール
Start:
** [[OOobbs3/31]] [#ke338b7d]
-''サマリ'': ConnectorShapeの矢印について
-''環境'': Draw
-''状態'': 解決
-''投稿者'': [[new_OOo3]]
-''投稿日'': 2010-10-10 (日) 15:20:25
*** 質問 [#q283af9b]
お世話になります。
連日の投稿で恐縮です。
現在、「com.sun.star.drawing.ConnectorShape」を用いてFlow...
そこでConnectorShapeの端部を矢印に変更したいのですが、方...
つきましては、丸投げ質問で申し訳ありませんが、下記Codeに...
また、単純な矢印の作成はCode2にて作成出来る事は確認してお...
宜しくお願いします。
******** Code1 ( 最後に作成したConnectorを選択する ) ***...
Sub oDShapeProp
Dim oPage
Dim oRectangleShape
Dim oShape
DIm oConnType
Dim oDoc
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factor...
'
oConnType = Array( _
com.sun.star.drawing.ConnectorType.STANDARD, _
com.sun.star.drawing.ConnectorType.CURVE, _
com.sun.star.drawing.ConnectorType.LINE, _
com.sun.star.drawing.ConnectorType.LINES, _
)
'
oRectangleShape = Array( _
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
)
'
oPage = createDrawPage(oDoc, "Test Draw", True)
' Create RectAngle
for i = 0 to 3
oPage.add(oRectangleShape(i))
oRectangleShape(i).setSize(CreateSize(1200, 1000))
next i
oRectangleShape(0).setPosition(CreatePoint(1500, 2500)
oRectangleShape(1).setPosition(CreatePoint(4000, 2000)
oRectangleShape(2).setPosition(CreatePoint(7000, 1500)
oRectangleShape(3).setPosition(CreatePoint(4000, 3500)
'
' Set String and GluePoint
for i = 0 to 3
oRectangleShape(i).setString(i)
' Connect Line( Curve )
oShape = oDoc.createInstance("com.sun.star.drawing.Con...
oPage.add(oShape)
oShape.StartShape = oRectangleShape(i)
Select Case i
case 0
oShape.StartGluePointIndex = 0
oShape.EndShape = oRectangleShape(i+1)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 0
case 1
oShapeStartGluePointIndex = 1
oShape.EndShape = oRectangleShape(i+1)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 4
case 2
oShape.StartGluePointIndex = 2
oShape.EndShape = oRectangleShape(i+1)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 1
case 3
oShape.StartGluePointIndex = 3
oShape.EndShape = oRectangleShape(0)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 1
End Select
next i
' oShape(0)を選択
oSelShape = oDoc.CurrentController().select(oShape)
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & ...
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ...
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Err...
End Sub
'
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As...
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 ...
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 boole...
Dim oPages
Dim oPage
Dim i%
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get ...
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page a...
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
********************************************
********** Code2(矢印作成) *****************
Sub DrawShape
Dim oPage
Dim oShape
Dim oPoints_1
Dim oPoints_2
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factor...
oPoints_1 = Array(_
CreatePoint( 2000, 2000 ),_
CreatePoint( 5000, 2000 )_
)
oPage = createDrawPage(oDoc, "Test Draw", True)
oShape = oDoc.createInstance("com.sun.star.drawing.Poly...
oPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
oShape.FillStyle = com.sun.star.drawing.FillStyle.NONE
oShape.LineWidth = 50
' Arrow
Dim oArrow
oArrow = oDoc.getStyleFamilies().getByName("graphics")
oShape.Style = oArrow.getByName("objectwitharrow")
End Sub
'
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As...
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'
'
'[ Function 2 ]
Function createDrawPage(oDoc, sName$, bForceNew As boole...
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 ...
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page a...
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
********************************************
*** 回答 [#xa77e89a]
- 次のプロパティで線の端の形状を指定します。線のプロパテ...
oShape.LineStartName = "Arrow"
oShape.LineEndName = "Arrow"
MRI を利用しているのであれば、プロパティ名が分からない時...
-- はにゃ? &new{2010-10-10 (日) 16:21:23};
#comment
*** 感想，コメント，メモ [#e9872158]
- ありがとうございます。 Lineの端末形状の設定がやっと分か...
昨日の苦労が嘘の様に端末形状設定が出来ました。蛇足とは思...
本当にありがとうございました。
*********** LineShape 端末形状 ************
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:factor...
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oStepsize = CDbl(oDwImpPage.height - 2000*2) / 10
for i = 0 to 6
oLine = oDoc.createInstance("com.sun.star.drawing.Line...
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
oPos.x = 2000
oPos.y = CLng(CDbl(i) * oStepsize) + 2000
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"
oLine.LineEndWidth = 1000
case 1
oLine.LineStartName = "Square"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Small Arrow"
oLine.LineEndWidth = 1000
case 2
oLine.LineStartName = "Dimension Lines"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Double Arrow"
oLine.LineEndWidth = 1000
case 3
oLine.LineStartName = "Rounded short Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Symmetric Arrow"
oLine.LineEndWidth = 1000
case 4
oLine.LineStartName = "Line Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Rounded large Arrow"
oLine.LineEndWidth = 1000
case 5
oLine.LineStartName = "Circle"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Square 45"
oLine.LineEndWidth = 1000
case 6
oLine.LineStartName = ""
oLine.LineEndName = "Arrow concave"
oLine.LineEndWidth = 1000
End Select
next i
End Sub
*******************************************
#comment
End:
** [[OOobbs3/31]] [#ke338b7d]
-''サマリ'': ConnectorShapeの矢印について
-''環境'': Draw
-''状態'': 解決
-''投稿者'': [[new_OOo3]]
-''投稿日'': 2010-10-10 (日) 15:20:25
*** 質問 [#q283af9b]
お世話になります。
連日の投稿で恐縮です。
現在、「com.sun.star.drawing.ConnectorShape」を用いてFlow...
そこでConnectorShapeの端部を矢印に変更したいのですが、方...
つきましては、丸投げ質問で申し訳ありませんが、下記Codeに...
また、単純な矢印の作成はCode2にて作成出来る事は確認してお...
宜しくお願いします。
******** Code1 ( 最後に作成したConnectorを選択する ) ***...
Sub oDShapeProp
Dim oPage
Dim oRectangleShape
Dim oShape
DIm oConnType
Dim oDoc
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factor...
'
oConnType = Array( _
com.sun.star.drawing.ConnectorType.STANDARD, _
com.sun.star.drawing.ConnectorType.CURVE, _
com.sun.star.drawing.ConnectorType.LINE, _
com.sun.star.drawing.ConnectorType.LINES, _
)
'
oRectangleShape = Array( _
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
oDoc.CreateInstance("com.sun.star.drawing.Rectangle...
)
'
oPage = createDrawPage(oDoc, "Test Draw", True)
' Create RectAngle
for i = 0 to 3
oPage.add(oRectangleShape(i))
oRectangleShape(i).setSize(CreateSize(1200, 1000))
next i
oRectangleShape(0).setPosition(CreatePoint(1500, 2500)
oRectangleShape(1).setPosition(CreatePoint(4000, 2000)
oRectangleShape(2).setPosition(CreatePoint(7000, 1500)
oRectangleShape(3).setPosition(CreatePoint(4000, 3500)
'
' Set String and GluePoint
for i = 0 to 3
oRectangleShape(i).setString(i)
' Connect Line( Curve )
oShape = oDoc.createInstance("com.sun.star.drawing.Con...
oPage.add(oShape)
oShape.StartShape = oRectangleShape(i)
Select Case i
case 0
oShape.StartGluePointIndex = 0
oShape.EndShape = oRectangleShape(i+1)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 0
case 1
oShapeStartGluePointIndex = 1
oShape.EndShape = oRectangleShape(i+1)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 4
case 2
oShape.StartGluePointIndex = 2
oShape.EndShape = oRectangleShape(i+1)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 1
case 3
oShape.StartGluePointIndex = 3
oShape.EndShape = oRectangleShape(0)
oShape.EdgeKind = oConnType(i)
oShape.EndGluePointIndex = 1
End Select
next i
' oShape(0)を選択
oSelShape = oDoc.CurrentController().select(oShape)
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & ...
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ...
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Err...
End Sub
'
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As...
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 ...
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 boole...
Dim oPages
Dim oPage
Dim i%
oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
'If we require a new page then delete the page and get ...
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page a...
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
********************************************
********** Code2(矢印作成) *****************
Sub DrawShape
Dim oPage
Dim oShape
Dim oPoints_1
Dim oPoints_2
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factor...
oPoints_1 = Array(_
CreatePoint( 2000, 2000 ),_
CreatePoint( 5000, 2000 )_
)
oPage = createDrawPage(oDoc, "Test Draw", True)
oShape = oDoc.createInstance("com.sun.star.drawing.Poly...
oPage.add(oShape)
oShape.PolyPolygon = Array(oPoints_1)
oShape.FillStyle = com.sun.star.drawing.FillStyle.NONE
oShape.LineWidth = 50
' Arrow
Dim oArrow
oArrow = oDoc.getStyleFamilies().getByName("graphics")
oShape.Style = oArrow.getByName("objectwitharrow")
End Sub
'
'[ Function 1 ]
Function CreatePoint(ByVal x As Long,ByVal y As Long) As...
Dim oPoint
oPoint = createUnoStruct( "com.sun.star.awt.Point" )
oPoint.X = x : oPoint.Y = y
CreatePoint = oPoint
End Function
'
'
'[ Function 2 ]
Function createDrawPage(oDoc, sName$, bForceNew As boole...
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 ...
If bForceNew Then
oPages.remove(oPages.getByName(sName))
Else
'Did not request a new page so return the found page a...
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
'
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
********************************************
*** 回答 [#xa77e89a]
- 次のプロパティで線の端の形状を指定します。線のプロパテ...
oShape.LineStartName = "Arrow"
oShape.LineEndName = "Arrow"
MRI を利用しているのであれば、プロパティ名が分からない時...
-- はにゃ? &new{2010-10-10 (日) 16:21:23};
#comment
*** 感想，コメント，メモ [#e9872158]
- ありがとうございます。 Lineの端末形状の設定がやっと分か...
昨日の苦労が嘘の様に端末形状設定が出来ました。蛇足とは思...
本当にありがとうございました。
*********** LineShape 端末形状 ************
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:factor...
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oStepsize = CDbl(oDwImpPage.height - 2000*2) / 10
for i = 0 to 6
oLine = oDoc.createInstance("com.sun.star.drawing.Line...
oLine.LineColor = RGB(0, 255-20*i, 20*i)
oLine.LineWidth = 75
oPos.x = 2000
oPos.y = CLng(CDbl(i) * oStepsize) + 2000
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"
oLine.LineEndWidth = 1000
case 1
oLine.LineStartName = "Square"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Small Arrow"
oLine.LineEndWidth = 1000
case 2
oLine.LineStartName = "Dimension Lines"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Double Arrow"
oLine.LineEndWidth = 1000
case 3
oLine.LineStartName = "Rounded short Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Symmetric Arrow"
oLine.LineEndWidth = 1000
case 4
oLine.LineStartName = "Line Arrow"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Rounded large Arrow"
oLine.LineEndWidth = 1000
case 5
oLine.LineStartName = "Circle"
oLine.LineStartWidth = 1000
oLine.LineEndName = "Square 45"
oLine.LineEndWidth = 1000
case 6
oLine.LineStartName = ""
oLine.LineEndName = "Arrow concave"
oLine.LineEndWidth = 1000
End Select
next i
End Sub
*******************************************
#comment
Page:
