Macroの杜(LibreOffice Basic編)/ General No.4(1)

GSh-)[General]直線（Line)[ com.sun.star.drawing.LineShape / .LineColor / .LineWidth / .LineTransparence ]

Draw


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) / 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 = 250
			oPos.x = 0
			oPos.y = CLng(CDbl(i) * oStepsize)
			oLine.setPosition(oPos)
			oSize.width = oDwImpPage.width
			oSize.height = oDwImpPage.height -2 * oPos.y
			oLine.setSize(oSize)
			oDwImpPage.add(oLine)
		next i 
End Sub

Impress


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/simpress", "_default", 0, Dummy()) 
		oDwImpPage = oDoc.getDrawPages().getByIndex(0)
		oStepsize = CDbl(oDwImpPage.height) / 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 = 250
			oPos.x = 0
			oPos.y = CLng(CDbl(i) * oStepsize)
			oLine.setPosition(oPos)
			oSize.width = oDwImpPage.width
			oSize.height = oDwImpPage.height -2 * oPos.y
			oLine.setSize(oSize)
			oDwImpPage.add(oLine)
		next i 
End Sub

Calc




Sub oDrawLineInCalcDocument
  Dim oDoc as object
  Dim Dummy()
  	oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy()) 
  Dim oPage as object
  	oPage = oDoc.DrawPages(0)
  	'
	Dim oShape as object
  		oShape = oDoc.createInstance( "com.sun.star.drawing.LineShape" )
  			oShape.LineColor = RGB( 255, 0, 0 )
  			oShape.LineWidth = 100
	'
	Dim oPosition As New com.sun.star.awt.Point
		oPosition.X = 2500
  		oPosition.Y = 2500
  	oShape.setPosition(oPosition)
  	'
  	Dim oSize As New com.sun.star.awt.Size
  		oSize.width = 2500
  		oSize.height=5000
  	oShape.setSize(oSize)
  	'
  	oPage.add( oShape )
End Sub

Writer




Sub oAddLineShapeWriter
	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/swriter", "_default", 0, Dummy()) 
		oWriterPage = oDoc.getDrawPage()
		oStepsize = 800		'unit : mm
		for i = 0 to 10
			oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
			oLine.LineColor = RGB(0, 255-20*i,  20*i)
			oLine.LineWidth = 50
			
			oSize.width = oStepsize - CLng(CDbl(i) * oStepsize /10) /2
			oSize.height = oStepsize
			oLine.setSize(oSize)
			oWriterPage.add(oLine)
		next i 
End Sub

GSh-)[General]円(EllipseShape)[ com.sun.star.drawing.EllipseShape ]

Draw




Sub oShape
	Dim oDoc
	Dim oDrawP
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPages().getByIndex(0)
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			' Position
				oPoint = oShape.Position
					oPoint.X = oDrawP.Width / 4
					oPoint.Y = oDrawP.Height / 4 + oDrawP.BorderTop
				oShape.Position = oPoint
    		' Size
    			oSize = oShape.Size
    				oSize.Height = 6000		' unit : 1/100mm
    				oSize.Width =  6000		' unit : 1/100mm
    			oShape.Size = oSize
    		oDrawP.add(oShape) 
End Sub

Calc


	

Sub oShape
	Dim oDoc
	Dim oDrawP
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPages().getByIndex(0)
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			' Position
				oPoint = oShape.Position
					oPoint.X = 4000
					oPoint.Y = 4000
				oShape.Position = oPoint
    		' Size
    			oSize = oShape.Size
    				oSize.Height = 6000		' unit : 1/100mm
    				oSize.Width =  6000		' unit : 1/100mm
    			oShape.Size = oSize
    		oDrawP.add(oShape) 
End Sub

Writer


	

Sub oShapeWriter()
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPage()
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			'
			oDrawP.add(oShape)
			'
			oPositionShape( oShape, 1000, 1500,  3000, 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

GSh-)[General]EllipseShape2[ com.sun.star.drawing.EllipseShape ]



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/sdraw", "_default", 0, Dummy())
		'
		oLocs = Array( Array(CreatePoint(1000,1000), createSize(1000,1000)), _
						Array(CreatePoint(3000,1000), createSize(1000,1500)), _
						Array(CreatePoint(5000,1000), createSize(1500,1000)), _
						Array(CreatePoint(7000,1000), createSize(1500,1000)))
		'
		oPage = createDrawPage(oDOc, "Test Draw", True)
		' 
		for i = LBound(oLocs) to UBound(oLocs)
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			oPage.add(oShape)
			oCircle = oLocs(i)
			oShape.setPosition(oCircle(0))
			oShape.setSize(oCircle(1))
			oShape.setString(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

GSh-)[General]四角形(RectangleShape)[ com.sun.star.drawing.RectangleShape ]

Draw



Sub oDShape
	Dim oDoc
	Dim oDrawP
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPages().getByIndex(0)
			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			' Position
				oPoint = oShape.Position
					oPoint.X = oDrawP.Width / 4
					oPoint.Y = oDrawP.Height / 4 + oDrawP.BorderTop
				oShape.Position = oPoint
    		' Size
    			oSize = oShape.Size
    				oSize.Height = 5000		' unit : 1/100mm
    				oSize.Width =  10000		' unit : 1/100mm
    			oShape.Size = oSize
    		oDrawP.add(oShape) 
End Sub

Calc




Sub oDShape
	Dim oDoc
	Dim oDrawP
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPages().getByIndex(0)
			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			' Position
				oPoint = oShape.Position
					oPoint.X = 3000
					oPoint.Y = 3000
				oShape.Position = oPoint
    		' Size
    			oSize = oShape.Size
    				oSize.Height = 5000		' unit : 1/100mm
    				oSize.Width =  10000		' unit : 1/100mm
    			oShape.Size = oSize
    		oDrawP.add(oShape) 
End Sub

Writer




Sub oShape
	Dim oDoc
	Dim oDrawP
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPage()
			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			'
			oDrawP.add(oShape)
			'
			oPositionShape( oShape, 1000, 1500,  5000, 2000 ) 
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

GSh-)[General]ポリゴンベジェ形状(Poly Polygon Bezier Shape)[ com.sun.star.drawing.PolyPolygonBezierCoords / com.sun.star.drawing.ClosedBezierShape / com.sun.star.drawing.OpenBezierShape / com.sun.star.drawing.PolygonFlags.NORMAL / com.sun.star.drawing.PolygonFlags.CONTROL ]

閉じたベジェ形状 (Closed Bezier Shape)



	



Sub DrawShape
	Dim oDoc
	Dim oPage   'Page on which to draw
	Dim oShape  'Shape to insert
	Dim oCoords 'Coordinates of the polygon to insert
		oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
		'Fill in the actual coordinates. The first and last points are normal points and
		' the middle points are Bezier control points.
			oCoords.Coordinates = Array( Array( _
      								CreatePoint( 4000, 4000 ), _
      								CreatePoint( 12000, 16000 ), _
      								CreatePoint( 12000, 16000 ), _
      								CreatePoint( 20000, 4000 ) _
												) _
										 )
			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 _
    									)_
  								)
   
		oDoc = ThisComponent
		oPage = createDrawPage(ThisComponent, "Test Draw", True)
		oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
		oPage.add(oShape)
		oShape.FillStyle = com.sun.star.drawing.FillStyle.NONE
		oShape.PolyPolygonBezier = oCoords
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

	'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

開いたベジェ形状 (Opend Bezier Shape)





Sub DrawShape
	Dim oDoc
	Dim oPage   'Page on which to draw
	Dim oShape  'Shape to insert
	Dim oCoords 'Coordinates of the polygon to insert
		oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
		'Fill in the actual coordinates. The first and last points are normal points and
		' the middle points are Bezier control points.
			oCoords.Coordinates = Array( Array( _
      					CreatePoint( 4000, 4000 ), _
      					CreatePoint( 12000, 16000 ), _
      					CreatePoint( 12000, 16000 ), _
      					CreatePoint( 20000, 4000 ) _
								) _
							)
			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 _
								)_
					)
   
		oDoc = ThisComponent
		oPage = createDrawPage(ThisComponent, "Test Draw", True)
		oShape = oDoc.createInstance("com.sun.star.drawing.OpenBezierShape")
		oPage.add(oShape)
	'	oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
		oShape.PolyPolygonBezier = oCoords
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

	'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

GSh-)[General]寸法線(measurement shape)[ com.sun.star.drawing.MeasureShape / com.sun.star.drawing.TextAnimationKind.SCROLL / .setString() ]

寸法線



	



Sub DrawShape
	Dim oPage  'Page on which to draw
	Dim oShape 'Shape to insert
	Dim oStart As new com.sun.star.awt.Point
	Dim oEnd As new com.sun.star.awt.Point
		oPage = createDrawPage(ThisComponent, "Test Draw", True)
		'横寸法
			oShape = ThisComponent.createInstance("com.sun.star.drawing.MeasureShape")
			oPage.add(oShape) 
				oStart.X = oPage.Width / 4 : oEnd.X = oPage.Width / 2
				oStart.Y = oPage.Height/4  : oEnd.Y = oPage.Height/4
				oShape.StartPosition = oStart
				oShape.EndPosition = oEnd
		'縦寸法
			oShape = ThisComponent.createInstance("com.sun.star.drawing.MeasureShape")
			oPage.add(oShape)
				oStart.X = oPage.Width / 5 : oEnd.X = oPage.Width / 5
				oStart.Y = oPage.Height/4  : oEnd.Y = oPage.Height/2.5
				oShape.StartPosition = oStart
				oShape.EndPosition = oEnd
End Sub

'[ Function 1 ]
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

寸法値をText化



	



Sub DrawShape
	Dim oPage  'Page on which to draw
	Dim oShape 'Shape to insert
	Dim oStart As new com.sun.star.awt.Point
	Dim oEnd As new com.sun.star.awt.Point
		oPage = createDrawPage(ThisComponent, "Test Draw", True)
		'横寸法
			oShape = ThisComponent.createInstance("com.sun.star.drawing.MeasureShape")
			oPage.add(oShape) 
				oStart.X = oPage.Width / 4 : oEnd.X = oPage.Width / 2
				oStart.Y = oPage.Height/4  : oEnd.Y = oPage.Height/4
				oShape.StartPosition = oStart
				oShape.EndPosition = oEnd
			'寸法をTextにする
					oShape.setString("Width")
					oShape.TextAnimationKind = com.sun.star.drawing.TextAnimationKind.SCROLL
		'縦寸法
			oShape = ThisComponent.createInstance("com.sun.star.drawing.MeasureShape")
			oPage.add(oShape)
				oStart.X = oPage.Width / 5 : oEnd.X = oPage.Width / 5
				oStart.Y = oPage.Height/4  : oEnd.Y = oPage.Height/2.5
				oShape.StartPosition = oStart
				oShape.EndPosition = oEnd
			'寸法をTextにする
					oShape.setString("Height")
					oShape.TextAnimationKind = com.sun.star.drawing.TextAnimationKind.SCROLL
End Sub

'[ Function 1 ]
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

GSh-)[General]多角形(Polygon)[ com.sun.star.drawing.PolyLineShape / com.sun.star.drawing.PolyPolygonShape / .getByName("graphics") / .getByName("objectwitharrow") ]

ポリライン(Polyline)



	



Sub DrawShape
	Dim oPage     'Page on which to draw	
	Dim oShape    'Shape to insert
	Dim oPoints_1 'First set of points to plot
	Dim oPoints_2 'Second set of points to plot
  
		oPoints_1 = Array(_
			CreatePoint( 1000, 1000 ),_
			CreatePoint( 3000, 2000 ),_
			CreatePoint( 1000, 2000 ),_
			CreatePoint( 3000, 1000 )_
						)
		oPage = createDrawPage(ThisComponent, "Test Draw", True)
		oShape = ThisComponent.createInstance("com.sun.star.drawing.PolyLineShape")
			oPage.add(oShape)
			oShape.PolyPolygon = Array(oPoints_1)
			oShape.LineWidth = 50
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

	'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

ポリゴン(Poly Polygon)



	



Sub DrawShape
	Dim oPage     'Page on which to draw	
	Dim oShape    'Shape to insert
	Dim oPoints_1 'First set of points to plot
	Dim oPoints_2 'Second set of points to plot
  
		oPoints_1 = Array(_
			CreatePoint( 1000, 1000 ),_
			CreatePoint( 3000, 2000 ),_
			CreatePoint( 1000, 2000 ),_
			CreatePoint( 3000, 1000 )_
						)
		oPage = createDrawPage(ThisComponent, "Test Draw", True)
		oShape = ThisComponent.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
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

	'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 DrawShape
	Dim oPage     'Page on which to draw	
	Dim oShape    'Shape to insert
	Dim oPoints_1 'First set of points to plot
	Dim oPoints_2 'Second set of points to plot
  	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

	'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

GSh-)[General]テキストボックス(TextBox)[ com.sun.star.drawing.RectangleShape / com.sun.star.drawing.TextShape / .Shadow ]

Draw(Shadow付き)



	



Sub oDShape
	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(1000, 1000))
			oShape.setSize(createSize(6000, 1000))
			oShape.setString("OOoMacro")
			oShape.FillStyle = com.sun.star.drawing.FillStyle.NONE
		'　影付き
				oShape.Shadow = True
		
		'TEXTのみ
		oShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
			oPage.add(oShape)
			oShape.setPosition(createPoint(1000, 2500))
			oShape.setSize(createSize(10000, 1000))
			oShape.setString("TextShape")
		'　影付き		
				oShape.Shadow = True
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

Writer(Shadow無し)



	



Sub oDShape
	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.FillStyle = com.sun.star.drawing.FillStyle.NONE
		'　影付き
			oShape.Shadow = False
		
		'TEXTのみ
		oShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
			oPage.add(oShape)
			'
 			oPositionShape( oShape, 1000, 3500,  3000, 1000 )
			'
			oShape.setString("TextShape")
		'　影付き		
			oShape.Shadow = False
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

Calc(Shadow付き)



	



Sub oDShape
	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.DrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
 			oShape.setPosition(createPoint(1000, 1000))
			oShape.setSize(createSize(6000, 1000))
			oShape.setString("OOoMacro")
			oShape.FillStyle = com.sun.star.drawing.FillStyle.NONE
		'　影付き
				oShape.Shadow = True
		
		'TEXTのみ
		oShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
			oPage.add(oShape)
			oShape.setPosition(createPoint(1000, 2500))
			oShape.setSize(createSize(10000, 1000))
			oShape.setString("TextShape")
		'　影付き		
				oShape.Shadow = True
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

GSh-)[General]Shape数取得[ .Count ]

Draw



	



Sub oDShape
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPages().getByIndex(0)
		' First Shape
			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			' Position
				oPoint = oShape.Position
					oPoint.X = oDrawP.Width / 10
					oPoint.Y = oDrawP.Height / 20 + oDrawP.BorderTop
				oShape.Position = oPoint
    		' Size
    			oSize = oShape.Size
    				oSize.Height = 2500		' unit : 1/100mm
    				oSize.Width =  4000		' unit : 1/100mm
    			oShape.Size = oSize
    		oDrawP.add(oShape) 
    		'
    	' Second Shape
    		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
    		' Position
				oPoint = oShape.Position
					oPoint.X = oDrawP.Width / 8
					oPoint.Y = oDrawP.Height / 20 + oDrawP.BorderTop + 4000 / 2  + 1000/2 + 500
				oShape.Position = oPoint
			' Size
    			oSize = oShape.Size
    				oSize.Height = 1000		' unit : 1/100mm
    				oSize.Width =  2000		' unit : 1/100mm
    			oShape.Size = oSize
			oDrawP.add(oShape)
			'
	' Count Shape
	Dim oShapeCnt as Long
		oShapeCnt = oDrawP.Count
		'
	Dim oDisp as String
		oDisp = oShapeCnt
		msgbox oDisp,0,"Number of Shape in Draw" 
End Sub

Writer



	



Sub oDShape
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oPosX as Integer, oPosY as Integer, oWidth as Integer, oHieght as Integer
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPage()
		' First Shape
			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oDrawP.add(oShape)
			'
			oPosX = 2000
			oPosY = 1000
			oWidth = 4000		' unit : 1/100mm
			oHieght =  2500		' unit : 1/100mm
			oPositionShape( oShape, oPosX, oPosY,  oWidth, oHieght )
    		'
    	' Second Shape
    		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
    		oDrawP.add(oShape)
			'
			oPosX = 2000
			oPosY = 1000 + 2500 + 500
			oWidth = 2000		' unit : 1/100mm
			oHieght =  1000		' unit : 1/100mm
			oPositionShape( oShape, oPosX, oPosY,  oWidth, oHieght )
			'
	' Count Shape
	Dim oShapeCnt as Long
		oShapeCnt = oDrawP.Count
		'
	Dim oDisp as String
		oDisp = oShapeCnt
		msgbox oDisp,0,"Number of Shape in Writer" 
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

Calc



	



Sub oDShape
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
			oDrawP = oDoc.getDrawPages().getByIndex(0)
		' First Shape
			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			' Position
				oPoint = oShape.Position
					oPoint.X = 3000
					oPoint.Y = 3000
				oShape.Position = oPoint
    		' Size
    			oSize = oShape.Size
    				oSize.Height = 2500		' unit : 1/100mm
    				oSize.Width =  4000		' unit : 1/100mm
    			oShape.Size = oSize
    		oDrawP.add(oShape) 
    		'
    	' Second Shape
    		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
    		' Position
				oPoint = oShape.Position
					oPoint.X = 3000
					oPoint.Y = 6000
				oShape.Position = oPoint
			' Size
    			oSize = oShape.Size
    				oSize.Height = 1000		' unit : 1/100mm
    				oSize.Width =  2000		' unit : 1/100mm
    			oShape.Size = oSize
			oDrawP.add(oShape)
			'
	' Count Shape
	Dim oShapeCnt as Long
		oShapeCnt = oDrawP.Count
		'
	Dim oDisp as String
		oDisp = oShapeCnt
		msgbox oDisp,0,"Number of Shape in Calc Sheet"   	
End Sub

GSh-)[General]Shape選択[ .select() / com.sun.star.drawing.ShapeCollection / .add() ]

Shape選択



	



Sub oDShape()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape 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)
    	'
    msgbox "Success" 
End Sub

複数選択



	



Sub DShape()
	Dim oDoc as Object, oDrawP as Object, oShape as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		' Position
		oPoint = oShape.Position
			oPoint.X = 300
			oPoint.Y = 300
		oShape.Position = oPoint
    	' Size
    	oSize = oShape.Size
    		oSize.Height = 500		' unit : 1/100mm
    		oSize.Width =  2000		' unit : 1/100mm
    	oShape.Size = oSize
    	oDrawP.add(oShape)
    	'
    Dim oPosition As New com.sun.star.awt.Point
    	oLine = oDoc.createInstance( "com.sun.star.drawing.LineShape" )
  		oLine.LineColor = RGB( 255, 0, 0 )
  		oLine.LineWidth = 100
  		' Position
		oPosition.X = 200
  		oPosition.Y = 200
  		oLine.setPosition(oPosition)
  		' Size
  		oSize.width = 1000
  		oSize.height= 1000
  		oLine.setSize(oSize)
  		oDrawP.add( oLine )
  		'
  	' Selected Multi Object
  	Dim oMultiShale as Object
  	Dim oCtrl  as Object
  		oMultiShale = CreateUnoService("com.sun.star.drawing.ShapeCollection")
  		oMultiShale.add(oShape)
  		oMultiShale.add(oLine)
    	oCtrl = oDoc.getCurrentController()
    	oCtrl.select(oMultiShale)
    	'
    	msgbox "Success"
 End Sub

GSh-)[General]Shapeを最前面/最背面へ移動[ .uno:BringToFront / .uno:SendToBack ]



Sub DShape()
	Dim oDoc as Object, oDrawP as Object, oShape as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		' Position
		oPoint = oShape.Position
			oPoint.X = 300
			oPoint.Y = 300
		oShape.Position = oPoint
    	' Size
    	oSize = oShape.Size
    		oSize.Height = 500		' unit : 1/100mm
    		oSize.Width =  1000		' unit : 1/100mm
    	oShape.Size = oSize
    	oDrawP.add(oShape)
    	'
    Dim oPosition As New com.sun.star.awt.Point
    	oLine = oDoc.createInstance( "com.sun.star.drawing.LineShape" )
  		oLine.LineColor = RGB( 255, 0, 0 )
  		oLine.LineWidth = 100
  		' Position
		oPosition.X = 200
  		oPosition.Y = 200
  		oLine.setPosition(oPosition)
  		' Size
  		oSize.width = 1000
  		oSize.height= 1000
  		oLine.setSize(oSize)
  		oDrawP.add( oLine )
  		'
  		' Selected Object
  	Dim oCtrl  as Object
    	oCtrl = oDoc.getCurrentController()
    	oCtrl.select(oShape)
    	'
    Dim oFrame as Object
	Dim oDispatcher as Object
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame, ".uno:BringToFront", "", 0, Array())
		msgbox ".Rectangleを最前面へ移動しました。"
		oDispatcher.executeDispatch(oFrame, ".uno:SendToBack", "", 0, Array())
		msgbox ".Rectangleを最背面へ移動しました。"
End Sub

GSh-)[General]Group化/Ungroup化[ .group() / .ungroup() / .uno:FormatGroup / .uno:FormatUngroup ]

Group化/Ungroup化




Sub ShapeObj()
	Dim oDoc as Object, oDrawP as Object
	Dim oMultiShale  as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		'
		oMultiShale  = CreateUnoService("com.sun.star.drawing.ShapeCollection")
		for i = 0 to oDrawP.getCount()-1
			oMultiShale.add(oDrawP.getByIndex(i))
		next i
	' Selected Multi Object
  	Dim oCtrl  as Object
    	oCtrl = oDoc.getCurrentController()
    	oCtrl.select(oMultiShale)
		' Grouped
		oDrawP.group(oMultiShale)
		msgbox "Shape object Grouped !!",0,"Grouped"
	' Select grouped shape 
	Dim oGrShape as Object
		oGrShape = oDrawP.getByIndex(0)
		oCtrl.select(oGrShape)
		' Ungroup
		oDrawP.ungroup(oGrShape)
		msgbox "Shape object Ungrouped !!",0,"Ungrouped"
End Sub


【 解説 】
	Shapeを全て選択し、Group化した後にGroup解除するコードです

マクロの記録（DispatchHelper）




Sub ShapeObj()
	Dim oDoc as Object, oDrawP as Object
	Dim oMultiShale  as Object
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		'
		oMultiShale  = CreateUnoService("com.sun.star.drawing.ShapeCollection")
		for i = 0 to oDrawP.getCount()-1
			oMultiShale.add(oDrawP.getByIndex(i))
		next i
	' Selected Multi Object
  	Dim oCtrl  as Object
    	oCtrl = oDoc.getCurrentController()
    	oCtrl.select(oMultiShale)
	' Grouped
	Dim oFrame as Object
	Dim oDispatcher as Object
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:FormatGroup", "", 0, Array())
		msgbox "Shape object Grouped" & Chr$(10) & "(dispatcher) !!",0,"Grouped"
	' Select grouped shape 
	Dim oGrShape as Object
		oGrShape = oDrawP.getByIndex(0)
		oCtrl.select(oGrShape)
		' Ungroup
		oDispatcher.executeDispatch(oFrame, ".uno:FormatUngroup", "", 0, Array())
		msgbox "Shape object Ungrouped" & Chr$(10) & "(dispatcher) !!",0,"Ungrouped(Uno)"
End Sub

【 解説 】
	マクロの記録で使う
		createUnoService("com.sun.star.frame.DispatchHelper")
	を使うコードです。

GSh-)[General]TextShapeの文字取得[ .getString() ]

Calc / Draw / Impress




Sub oDShape
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPages().getByIndex(0)
		oDisp = "[ 取得文字 ]"
		for i = 0 to oDrawP.getCount()-1
			oDisp = oDisp & CHr$(13) & oDrawP.getByIndex(i).getString()
		next i
		msgbox oDisp,0,"LO7.0.4.2(x64)"
End Sub



【 解説 】
	Calcの実行結果




【 解説 】
	Drawの実行結果
	



【 解説 】
	Impressの実行結果

Writer




Sub oDShape
	Dim oDoc as Object
	Dim oDrawP as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oDrawP = oDoc.getDrawPage()
		oDisp = "[ 取得文字 ]"
		for i = 0 to oDrawP.getCount()-1
			oDisp = oDisp & Chr$(13) & Chr$(9) & oDrawP.getByIndex(i).getString()
		next i
		msgbox oDisp,0,"LO7.0.4.2(x64)"
End Sub


【 解説 】
	Writerの実行結果

Macroの杜(Basic編)

No.3 General No.4(1) No.4(2) No.4(3) No.5