** [[OOobbs3/31]] [#ke338b7d]
-''サマリ'': ConnectorShapeの矢印について
-''環境'': Draw
-''状態'': 解決
-''投稿者'': [[new_OOo3]]
-''投稿日'': 2010-10-10 (日) 15:20:25
*** 質問 [#q283af9b]
お世話になります。
連日の投稿で恐縮です。
現在、「com.sun.star.drawing.ConnectorShape」を用いてFlow Chart作成を行ないたいと考えています。
そこでConnectorShapeの端部を矢印に変更したいのですが、方法が分かりません。ただ1つ本Siteの「OOoBasic/Draw/Shapes」=>「コネクタ」( URL : http://hermione.s41.xrea.com/pukiwiki/index.php?OOoBasic/Draw/Shapes&word=ConnectorShape#b0e526f6 )に記されている「コネクタの両端の矢印は直線などの矢印の設定と同じです。」という情報を基に「 Arrow ConnectorShape 」や「 Arrow LineShape 」等様々なWordで検索した結果を閲覧していきましたが、上記以上の情報を得ることは出来ませんでした。
つきましては、丸投げ質問で申し訳ありませんが、下記Codeにて作成した最後のConnecter(３と０を結ぶ)のEnd端を矢印に変更する方法をご教示頂けます様お願いします。
また、単純な矢印の作成は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:factory/sdraw", "_default", 0, Dummy())
'
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.RectangleShape"), _
oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
oDoc.CreateInstance("com.sun.star.drawing.RectangleShape"), _
)
'
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.ConnectorShape")
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 & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
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
Dim oPage
Dim i%
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
'
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:factory/sdraw", "_default", 0, Dummy())
oPoints_1 = Array(_
CreatePoint( 2000, 2000 ),_
CreatePoint( 5000, 2000 )_
)
oPage = createDrawPage(oDoc, "Test Draw", True)
oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
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 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 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
'
oPage = oPages.getByIndex(oPages.getCount()-1)
oPage.setName(sName)
createDrawPage = oPage
End Function
********************************************
*** 回答 [#xa77e89a]
- 次のプロパティで線の端の形状を指定します。線のプロパティ一覧は [[OOoBasic/Draw/DrawingProperties#i29b4d3a]]。
oShape.LineStartName = "Arrow"
oShape.LineEndName = "Arrow"
MRI を利用しているのであれば、プロパティ名が分からない時には [[OOoBasic/Macros/MRI/Documentation/Tips]] にある方法を試してみてください。スタイルで線のフォーマットを設定するのであれば、個別に行うよりもいいと思います。利用できる末端の形状名の取得は・・・。
-- はにゃ? &new{2010-10-10 (日) 16:21:23};
#comment
*** 感想，コメント，メモ [#e9872158]
- ありがとうございます。 Lineの端末形状の設定がやっと分かりました。 -- new_OOo3 &new{2010-10-10 (日) 21:52:14};
昨日の苦労が嘘の様に端末形状設定が出来ました。蛇足とは思いますが知り得た端末形状名(Arrow～Arrow concave)を含むCodeを以下に記します。
本当にありがとうございました。
*********** 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:factory/sdraw", "_default", 0, Dummy())
oDwImpPage = oDoc.getDrawPages().getByIndex(0)
oStepsize = CDbl(oDwImpPage.height - 2000*2) / 10
for i = 0 to 6
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) + 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
