Top > OOobbs3 > 31

OOobbs3/31 Edit

  • サマリ: ConnectorShapeの矢印について
  • 環境: Draw
  • 状態: 解決
  • 投稿者: new_OOo3?
  • 投稿日: 2010-10-10 (日) 15:20:25

質問 Edit

お世話になります。

連日の投稿で恐縮です。

現在、「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(3と0を結ぶ)の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
********************************************

回答 Edit

oShape.LineStartName = "Arrow"
oShape.LineEndName = "Arrow"

MRI を利用しているのであれば、プロパティ名が分からない時には OOoBasic/Macros/MRI/Documentation/Tips にある方法を試してみてください。スタイルで線のフォーマットを設定するのであれば、個別に行うよりもいいと思います。利用できる末端の形状名の取得は・・・。

  • はにゃ? 2010-10-10 (日) 16:21:23

感想,コメント,メモ Edit

  • ありがとうございます。 Lineの端末形状の設定がやっと分かりました。 -- new_OOo3 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
*******************************************


Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup   Help   RSS of recent changes