** [[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(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 ******************************************** *** 回答 [#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 |