Home of site


Macroの杜
(OpenOffice.org/LibreOffice Basic編)

General No.4

###【 Continued from General No.3 】###


**********************【 Index 】**********************

Shape

[ Shape ]


[ ShapeProperty ]


[ ConnectorShape ]


[ GraphicObjectShape ]


[ OLE Shape ]


[ Anchor ]

{{ Writer }}


{{ Calc }}





###【 Following General No.5 】###











**********************【 Macro Code 】**********************

Shape

[ Shape ]

GSh-1)[General / Draw]Line


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

GSh-1)[General]Line(Draw, 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

GSh-2)[General]Line(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]Line(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

GSh-)[General]EllipseShape


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

GSh-)[General]EllipseShape2


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]EllipseShape


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

GSh-)[General]EllipseShape


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( Page Anchor )


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_PAGE
	'
	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]RectangleShape


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

GSh-)[General]RectangleShape


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

GSh-)[General]RectangleShape


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]ClosedBezierShape / PolyPolygonBezierrShape


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

GSh-)[General]OpenBezierShape / PolyPolygonBezierrShape


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]MeasureShape1


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.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
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]MeasureShape2


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]PolyLineShape


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

GSh-)[General]PolyPolygonShape


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

GSh-)[General]矢印


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]TextShape[ Draw, Impress ]


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

GSh-)[General]TextShape[ Writer ]


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

GSh-)[General]TextShape[ Calc ]


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数取得( 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

GSh-)[General]Shape数取得( 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

GSh-)[General]Shape数取得( 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選択


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

GSh-)[General]複数のShape選択


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を最前面/最背面へ移動


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]複数のShapeのGroup化/Ungroup化(1)


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

GSh-)[General]複数のShapeのGroup化/Ungroup化(2)


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








[ ShapeProperty ]

GSSP-)[General / Draw]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

GSSP-)[General / Calc]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/scalc", "_default", 0, Dummy()) 
		oDwImpPage = oDoc.getDrawPages().getByIndex(0)
		oStepsize = (29400-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 = 5000
			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

GSSP-)[General / Writer]LineShape


Sub oAddLineShape
	Dim Dummy()
	Dim oDoc as Object
	Dim oLine as Object
	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()) 
		oDwImpPage = oDoc.getDrawPage()
		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
			'
			positionShape( oLine, 1000, 1000 + i * 2000, 5000, 0 )
			'
			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

Sub positionShape( 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

GSSP-)[General / Draw]LineShape2


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 - 10000*2) / 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 = 75
			oPos.x = 2000
			oPos.y = CLng(CDbl(i) * oStepsize) + 1500
			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 = ""
				case 1
					' 極細の細線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Ultrafine Dashed"
				case 2
					' 細かい破線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dashed"
				case 3
					' 細かい点線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dotted"
				case 4
					' 細かい点の集まった線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Line with Fine Dots"
				case 5
					' 細かい破線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dashed (var)"
				case 6
					' 三破線三点鎖線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "3 Dashes 3 Dots (var)"
				case 7
					' 極細の点線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Ultrafine Dotted (var)"
				case 8
					' 線スタイル9
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Line Style 9"
				case 9
					' 二点鎖線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "2 Dots 1 Dash"
				case 10
					' 破線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Dashed (var)"
			End Select
		next i 
End Sub

GSSP-)[General / Calc]LineShape2


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/scalc", "_default", 0, Dummy()) 
		oDwImpPage = oDoc.getDrawPages().getByIndex(0)
		oStepsize = (29400-10000*2) / 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 = 75
			oPos.x = 2000
			oPos.y = CLng(CDbl(i) * oStepsize) + 1500
			oLine.setPosition(oPos)
			oSize.width = 5000
			oSize.height = 0
			oLine.setSize(oSize)
			oDwImpPage.add(oLine)
			Select case i
				case 0
					' 実線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
				case 1
					' 極細の細線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Ultrafine Dashed"
				case 2
					' 細かい破線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dashed"
				case 3
					' 細かい点線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dotted"
				case 4
					' 細かい点の集まった線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Line with Fine Dots"
				case 5
					' 細かい破線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dashed (var)"
				case 6
					' 三破線三点鎖線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "3 Dashes 3 Dots (var)"
				case 7
					' 極細の点線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Ultrafine Dotted (var)"
				case 8
					' 線スタイル9
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Line Style 9"
				case 9
					' 二点鎖線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "2 Dots 1 Dash"
				case 10
					' 破線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Dashed (var)"
			End Select
		next i 
End Sub

GSSP-)[General / Writer]LineShape2


Sub oAddLineShape
	Dim Dummy()
	Dim oDoc as Object
	Dim oLine as Object
	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()) 
		oDwImpPage = oDoc.getDrawPage()
		for i = 0 to 10
			oLine = oDoc.createInstance("com.sun.star.drawing.LineShape")
			oLine.LineColor = RGB(0, 255-20*i,  20*i)
			oLine.LineWidth = 75
			'
			positionShape( oLine, 1000, 1000 + i * 1000, 5000, 0 )
			'
			oDwImpPage.add(oLine)
			Select case i
				case 0
					' 実線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
				case 1
					' 極細の細線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Ultrafine Dashed"
				case 2
					' 細かい破線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dashed"
				case 3
					' 細かい点線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dotted"
				case 4
					' 細かい点の集まった線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Line with Fine Dots"
				case 5
					' 細かい破線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Fine Dashed (var)"
				case 6
					' 三破線三点鎖線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "3 Dashes 3 Dots (var)"
				case 7
					' 極細の点線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Ultrafine Dotted (var)"
				case 8
					' 線スタイル9
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Line Style 9"
				case 9
					' 二点鎖線
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "2 Dots 1 Dash"
				case 10
					' 破線(可変)
					oLine.LineStartName = ""
					oLine.LineEndName = ""
					oLine.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oLine.LineDashName = "Dashed (var)"
			End Select
		next i 
End Sub
'
Sub positionShape( 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

GSSP-1)[General / Draw]EllipseShape / Fill


Sub oDShape
	Dim oDoc
	Dim oPage
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy()) 
			oPage = oDoc.getDrawPages().getByIndex(0)
			' Ellipse
				oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = oPage.Width / 4
						oPoint.Y = oPage.Height / 10 + oPage.BorderTop +1000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			oPage.add(oShape)
    			'Fill
    				oShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
    				oShape.FillColor = RGB(255,255,100)
    				oShape.FillTransparence = "50%"		'Transparency Percentage (透過度)
    			
    		' Rectangle
    			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = oPage.Width / 4
						oPoint.Y = oPage.Height / 10 + oPage.BorderTop + 4000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			'Draw
					oPage.add(oShape)
    			'Bitmap
    				oShape.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
					oShape.FillBitmapName = "Sky"
					oShape.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
			
			'ClosedBezier
				Dim oCoords 'Coordinates of the polygon to insert
					oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
						xP = oPage.Width / 4 + 3000
						yP = oPage.Height / 10 + oPage.BorderTop
							oCoords.Coordinates = Array( Array( _
      								CreatePoint( xP+1000, yP+1000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+5000, yP+1000 ) _
												) _
										 )
							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 _
    									)_
  								)
						
						oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
						
						oPage.add(oShape)
						oShape.PolyPolygonBezier = oCoords
						
					'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
    					' GradientStyle	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.LINEAR
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
			'PolyPolygonShape
				Dim oPoints_1
					xP1 = oPage.Width / 4 + 3000
					yP1 = oPage.Height / 10 + oPage.BorderTop + 3000
						oPoints_1 = Array(_
							CreatePoint( xP1+1000, yP1+1000 ),_
							CreatePoint( xP1+3500, yP1+3500 ),_
							CreatePoint( xP1+1000, yP1+3500 ),_
							CreatePoint( xP1+3500, yP1+1000 )_
							)
					
					oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
						oPage.add(oShape)
						oShape.PolyPolygon = Array(oPoints_1)
					'Fill
						oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
					'
						Dim oHatch As New com.sun.star.drawing.Hatch
							oHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE		'DOUBLE
							oHatch.Color = RGB(64,64,64)
							oHatch.Distance = 100
							oHatch.Angle = 450
							oShape.FillHatch = oHatch
						oShape.FillBackground = RGB(255,255,255)
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

GSSP-1)[General / Calc]EllipseShape / Fill


Sub oDShape
	Dim oDoc
	Dim oPage
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy()) 
			oPage = oDoc.getDrawPages().getByIndex(0)
			' Ellipse
				oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = 2000
						oPoint.Y = 2000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			oPage.add(oShape)
    			'Fill
    				oShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
    				oShape.FillColor = RGB(255,255,100)
    				oShape.FillTransparence = "50%"		'Transparency Percentage (透過度)
    			
    		' Rectangle
    			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = 2000
						oPoint.Y = 5000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			'Draw
					oPage.add(oShape)
    			'Bitmap
    				oShape.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
					oShape.FillBitmapName = "Sky"
					oShape.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
			
			'ClosedBezier
				Dim oCoords 'Coordinates of the polygon to insert
					oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
						xP = 5000
						yP = 2000
							oCoords.Coordinates = Array( Array( _
      								CreatePoint( xP+1000, yP+1000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+5000, yP+1000 ) _
												) _
										 )
							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 _
    									)_
  								)
						
						oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
						
						oPage.add(oShape)
						oShape.PolyPolygonBezier = oCoords
						
					'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
    					' GradientStyle	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.LINEAR
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
			'PolyPolygonShape
				Dim oPoints_1
					xP1 = 5000
					yP1 = 5000
						oPoints_1 = Array(_
							CreatePoint( xP1+1000, yP1+1000 ),_
							CreatePoint( xP1+3500, yP1+3500 ),_
							CreatePoint( xP1+1000, yP1+3500 ),_
							CreatePoint( xP1+3500, yP1+1000 )_
							)
					
					oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
						oPage.add(oShape)
						oShape.PolyPolygon = Array(oPoints_1)
					'Fill
						oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
					'
						Dim oHatch As New com.sun.star.drawing.Hatch
							oHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE		'DOUBLE
							oHatch.Color = RGB(64,64,64)
							oHatch.Distance = 100
							oHatch.Angle = 450
							oShape.FillHatch = oHatch
						oShape.FillBackground = RGB(255,255,255)
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

GSSP-)[General / Writer]EllipseShape / Fill


Sub oDShape
	Dim oDoc
	Dim oPage
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
		'
			oWriterPage = oDoc.getDrawPage()
		'
			oViewCursor = oDoc.CurrentController.getViewCursor()
			oPageStyle	= oViewCursor.PageStyleName
			oPage = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
			' Ellipse
				oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
				'
				oWriterPage.add(oShape)
				'
				Dim oX
				Dim oY
					oX = 1000
					oY = 1000
				oPositionShape( oShape, oX, oY,  2500, 2500 ) 
    			'
    			'Fill
    				oShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
    				oShape.FillColor = RGB(255,255,100)
    				oShape.FillTransparence = "50%"		'Transparency Percentage (透過度)
    			
    		' Rectangle
    			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
    			'
				oWriterPage.add(oShape)
				'
				oX = 1000
				oY = 4000
				oPositionShape( oShape, oX, oY,  2500, 2500 ) 
				'
    			'Bitmap
    				oShape.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
					oShape.FillBitmapName = "Sky"
					oShape.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
			
			'ClosedBezier
				Dim oCoords 'Coordinates of the polygon to insert
					oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
					'
						xP = 2500
						yP = 6000
							oCoords.Coordinates = Array( Array( _
      								CreatePoint( xP+1000, yP+1000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+5000, yP+1000 ) _
												) _
										 )
							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 _
    									)_
  								)
						
						oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
						'
						oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
						'
						oWriterPage.add(oShape)
						oShape.PolyPolygonBezier = oCoords
						
					'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
    					' GradientStyle	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.LINEAR
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						'
			'PolyPolygonShape
				Dim oPoints_1
					xP1 = 2500
					yP1 = 8500
						oPoints_1 = Array(_
							CreatePoint( xP1+1000, yP1+1000 ),_
							CreatePoint( xP1+3500, yP1+3500 ),_
							CreatePoint( xP1+1000, yP1+3500 ),_
							CreatePoint( xP1+3500, yP1+1000 )_
							)
					
					oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
					'
					oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
					'
						oWriterPage.add(oShape)
						oShape.PolyPolygon = Array(oPoints_1)
					'Fill
						oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
					'
						Dim oHatch As New com.sun.star.drawing.Hatch
							oHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE		'DOUBLE
							oHatch.Color = RGB(64,64,64)
							oHatch.Distance = 100
							oHatch.Angle = 450
							oShape.FillHatch = oHatch
						oShape.FillBackground = RGB(255,255,255)
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

'[ 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

GSSP-2)[General / Draw]EllipseShape / Outline


Sub oDShape
	Dim oDoc
	Dim oPage
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
			oPage = oDoc.getDrawPages().getByIndex(0)
			' Ellipse
				oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = oPage.Width / 4
						oPoint.Y = oPage.Height / 10 + oPage.BorderTop +1000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			oPage.add(oShape)
    			'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.AXIAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						
    			'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash1 as New com.sun.star.drawing.LineDash
		   					With oDash1
    							.Style = com.sun.star.drawing.DashStyle.ROUND
    							.Dashes = 1
    							.DashLen = 100
    							.Distance = 100
    						End With
    					oShape.LineDash = oDash1
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    			
    		' Rectangle
    			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = oPage.Width / 4
						oPoint.Y = oPage.Height / 10 + oPage.BorderTop + 4000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			'Draw
					oPage.add(oShape)
    			'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.RADIAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash2 as New com.sun.star.drawing.LineDash
    						With oDash2
    							.Style = com.sun.star.drawing.DashStyle.RECT
    							.Dots = 2
    							.DotLen = 50
    							.Dashes = 1    							
    							.DashLen = 500
    							.Distance = 50
    						End With
    					oShape.LineDash = oDash2
    			'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    					
			
			'ClosedBezier
				Dim oCoords 'Coordinates of the polygon to insert
					oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
						xP = oPage.Width / 4 + 3000
						yP = oPage.Height / 10 + oPage.BorderTop
							oCoords.Coordinates = Array( Array( _
      								CreatePoint( xP+1000, yP+1000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+5000, yP+1000 ) _
												) _
										 )
							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 _
    									)_
  								)
						
						oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
						
						oPage.add(oShape)
						oShape.PolyPolygonBezier = oCoords
						
					'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.ELLIPTICAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						'
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash3 as New com.sun.star.drawing.LineDash
		   					With oDash3
    							.Style = com.sun.star.drawing.DashStyle.ROUND
    							.Dots = 1
    							.DotLen = 50
    							.Dashes = 1
    							.DashLen = 500
    							.Distance = 100
    						End With
    					oShape.LineDash = oDash3	
				'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    			
	'
			'PolyPolygonShape
				Dim oPoints_1
					xP1 = oPage.Width / 4 + 3000
					yP1 = oPage.Height / 10 + oPage.BorderTop + 3000
						oPoints_1 = Array(_
							CreatePoint( xP1+1000, yP1+1000 ),_
							CreatePoint( xP1+3500, yP1+3500 ),_
							CreatePoint( xP1+1000, yP1+3500 ),_
							CreatePoint( xP1+3500, yP1+1000 )_
							)
					
					oShape = ThisComponent.createInstance("com.sun.star.drawing.PolyPolygonShape")
						oPage.add(oShape)
						oShape.PolyPolygon = Array(oPoints_1)
					'Fill
						oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
					'
						Dim oHatch As New com.sun.star.drawing.Hatch
							oHatch.Style = com.sun.star.drawing.HatchStyle.DOUBLE
							oHatch.Color = RGB(64,64,64)
							oHatch.Distance = 100			' unit = 1/100 mm
							oHatch.Angle = 450					' unit = 1/10 degree
							oShape.FillHatch = oHatch
						oShape.FillBackground = RGB(255,255,255)
			'
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash4 as New com.sun.star.drawing.LineDash
		   					With oDash4
    							.Style = com.sun.star.drawing.DashStyle.RECT
    							.Dots = 3
    							.DotLen = 50
    							.Dashes = 1
    							.DashLen = 500
    							.Distance = 50
    						End With
    					oShape.LineDash = oDash4
			'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"

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

GSSP-)[General / Calc]EllipseShape / Outline


Sub oDShape
	Dim oDoc
	Dim oPage
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
			oPage = oDoc.getDrawPages().getByIndex(0)
			' Ellipse
				oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = 2000
						oPoint.Y = 2000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			oPage.add(oShape)
    			'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.AXIAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						
    			'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash1 as New com.sun.star.drawing.LineDash
		   					With oDash1
    							.Style = com.sun.star.drawing.DashStyle.ROUND
    							.Dashes = 1
    							.DashLen = 100
    							.Distance = 100
    						End With
    					oShape.LineDash = oDash1
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    			
    		' Rectangle
    			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
				' Position
					oPoint = oShape.Position
						oPoint.X = 2000
						oPoint.Y = 5000
					oShape.Position = oPoint
    			' Size
    				oSize = oShape.Size
    					oSize.Height = 2500		' unit : 1/100mm
    					oSize.Width =  2500		' unit : 1/100mm
    				oShape.Size = oSize
    			'Draw
					oPage.add(oShape)
    			'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.RADIAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash2 as New com.sun.star.drawing.LineDash
    						With oDash2
    							.Style = com.sun.star.drawing.DashStyle.RECT
    							.Dots = 2
    							.DotLen = 50
    							.Dashes = 1    							
    							.DashLen = 500
    							.Distance = 50
    						End With
    					oShape.LineDash = oDash2
    			'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    					
			
			'ClosedBezier
				Dim oCoords 'Coordinates of the polygon to insert
					oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
						xP = 5000
						yP = 2000
							oCoords.Coordinates = Array( Array( _
      								CreatePoint( xP+1000, yP+1000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+5000, yP+1000 ) _
												) _
										 )
							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 _
    									)_
  								)
						
						oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
						
						oPage.add(oShape)
						oShape.PolyPolygonBezier = oCoords
						
					'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.ELLIPTICAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						'
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash3 as New com.sun.star.drawing.LineDash
		   					With oDash3
    							.Style = com.sun.star.drawing.DashStyle.ROUND
    							.Dots = 1
    							.DotLen = 50
    							.Dashes = 1
    							.DashLen = 500
    							.Distance = 100
    						End With
    					oShape.LineDash = oDash3	
				'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    			
	'
			'PolyPolygonShape
				Dim oPoints_1
					xP1 = 5000
					yP1 = 5000
						oPoints_1 = Array(_
							CreatePoint( xP1+1000, yP1+1000 ),_
							CreatePoint( xP1+3500, yP1+3500 ),_
							CreatePoint( xP1+1000, yP1+3500 ),_
							CreatePoint( xP1+3500, yP1+1000 )_
							)
					
					oShape = ThisComponent.createInstance("com.sun.star.drawing.PolyPolygonShape")
						oPage.add(oShape)
						oShape.PolyPolygon = Array(oPoints_1)
					'Fill
						oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
					'
						Dim oHatch As New com.sun.star.drawing.Hatch
							oHatch.Style = com.sun.star.drawing.HatchStyle.DOUBLE
							oHatch.Color = RGB(64,64,64)
							oHatch.Distance = 100			' unit = 1/100 mm
							oHatch.Angle = 450					' unit = 1/10 degree
							oShape.FillHatch = oHatch
						oShape.FillBackground = RGB(255,255,255)
			'
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash4 as New com.sun.star.drawing.LineDash
		   					With oDash4
    							.Style = com.sun.star.drawing.DashStyle.RECT
    							.Dots = 3
    							.DotLen = 50
    							.Dashes = 1
    							.DashLen = 500
    							.Distance = 50
    						End With
    					oShape.LineDash = oDash4
			'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"

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

GSSP-)[General / Writer]EllipseShape / Outline


Sub oDShape
	Dim oDoc
	Dim oPage
	Dim oShape
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
		'
		oWriterPage = oDoc.getDrawPage()
		'
			oViewCursor = oDoc.CurrentController.getViewCursor()
			oPageStyle	= oViewCursor.PageStyleName
			oPage = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
			'oPage = oDoc.getDrawPages().getByIndex(0)
			' Ellipse
				oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
				oWriterPage.add(oShape)
				'
				Dim oX
				Dim oY
					oX = 1000
					oY = 1000
				oPositionShape( oShape, oX, oY,  2500, 2500 ) 
				'
    			'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.AXIAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						
    			'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash1 as New com.sun.star.drawing.LineDash
		   					With oDash1
    							.Style = com.sun.star.drawing.DashStyle.ROUND
    							.Dashes = 1
    							.DashLen = 100
    							.Distance = 100
    						End With
    					oShape.LineDash = oDash1
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    			
    		' Rectangle
    			oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
				oWriterPage.add(oShape)
				'
					oX = 1000
					oY = 4000
				oPositionShape( oShape, oX, oY,  2500, 2500 ) 
    			'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.RADIAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash2 as New com.sun.star.drawing.LineDash
    						With oDash2
    							.Style = com.sun.star.drawing.DashStyle.RECT
    							.Dots = 2
    							.DotLen = 50
    							.Dashes = 1    							
    							.DashLen = 500
    							.Distance = 50
    						End With
    					oShape.LineDash = oDash2
    			'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    					
			
			'ClosedBezier
				Dim oCoords 'Coordinates of the polygon to insert
					oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
						xP = 2500
						yP = 6000
							oCoords.Coordinates = Array( Array( _
      								CreatePoint( xP+1000, yP+1000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+3000, yP+4000 ), _
      								CreatePoint( xP+5000, yP+1000 ) _
												) _
										 )
							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 _
    									)_
  								)
						
						oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
						
						oWriterPage.add(oShape)
						'
						oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
						'
						oShape.PolyPolygonBezier = oCoords
						
					'Gradient
    					oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT	
					' Gradietion Style
						oGradient = createUnoStruct("com.sun.star.awt.Gradient") 
							With oGradient 
      							.Style = com.sun.star.awt.GradientStyle.ELLIPTICAL
      							.StartColor = RGB( 255, 255, 0 ) 
      							.EndColor = RGB( 255, 0, 0 ) 
      							.Angle = 300			' unit : 1/10 degree 
      							.Border = 10 
      							.XOffset = 0 
      							.YOffset = 0 
 						     	.StartIntensity = 100 
 						     	.EndIntensity = 100 
 						     	.StepCount = 128 
   							End With 
						oShape.FillGradient = oGradient
						'
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash3 as New com.sun.star.drawing.LineDash
		   					With oDash3
    							.Style = com.sun.star.drawing.DashStyle.ROUND
    							.Dots = 1
    							.DotLen = 50
    							.Dashes = 1
    							.DashLen = 500
    							.Distance = 100
    						End With
    					oShape.LineDash = oDash3	
				'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"
    			
	'
			'PolyPolygonShape
				Dim oPoints_1
					xP1 = 2500
					yP1 = 8500
						oPoints_1 = Array(_
							CreatePoint( xP1+1000, yP1+1000 ),_
							CreatePoint( xP1+3500, yP1+3500 ),_
							CreatePoint( xP1+1000, yP1+3500 ),_
							CreatePoint( xP1+3500, yP1+1000 )_
							)
					
					oShape = oDoc.createInstance("com.sun.star.drawing.PolyPolygonShape")
						oWriterPage.add(oShape)
						'
						oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
						'
						oShape.PolyPolygon = Array(oPoints_1)
					'Fill
						oShape.FillStyle = com.sun.star.drawing.FillStyle.HATCH
					'
						Dim oHatch As New com.sun.star.drawing.Hatch
							oHatch.Style = com.sun.star.drawing.HatchStyle.DOUBLE
							oHatch.Color = RGB(64,64,64)
							oHatch.Distance = 100			' unit = 1/100 mm
							oHatch.Angle = 450					' unit = 1/10 degree
							oShape.FillHatch = oHatch
						oShape.FillBackground = RGB(255,255,255)
			'
				'Line Propertis
    				oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    				'Dash
    					Dim oDash4 as New com.sun.star.drawing.LineDash
		   					With oDash4
    							.Style = com.sun.star.drawing.DashStyle.RECT
    							.Dots = 3
    							.DotLen = 50
    							.Dashes = 1
    							.DashLen = 500
    							.Distance = 50
    						End With
    					oShape.LineDash = oDash4
			'	
    				oShape.LineColor = RGB(0,0,255)
    				oShape.LineWidth = 50		' Unit : 1/100 mm
    				oShape.LineTransparence = "0%"

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
'
'[ 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

GSSP-)[General / Draw]Shadow


Sub oDShapeProp
	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(3000, 1000))
			oShape.setSize(createSize(6000, 1000))
			oShape.setString("OOoMacro")
		' 影付き
				oShape.Shadow = True
		
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
 			oShape.setPosition(createPoint(3000, 5000))
			oShape.setSize(createSize(6000, 1000))
			oShape.setString("OOoMacro")
		' 影付き
				oShape.Shadow = True
		' Shadow Prop
			oShape.ShadowXDistance = -1000
			oShape.ShadowYDistance = -1000
			oShape.ShadowColor = 255000000
			oShape.ShadowTransparence = 50%		' 透明度
			oShape.CornerRadius = 100
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

GSSP-)[General / Calc]Shadow


Sub oDShapeProp
	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.getDrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
 			oShape.setPosition(createPoint(3000, 1000))
			oShape.setSize(createSize(6000, 1000))
			oShape.setString("OOoMacro")
		' 影付き
				oShape.Shadow = True
		
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
 			oShape.setPosition(createPoint(3000, 5000))
			oShape.setSize(createSize(6000, 1000))
			oShape.setString("OOoMacro")
		' 影付き
				oShape.Shadow = True
		' Shadow Prop
			oShape.ShadowXDistance = -1000
			oShape.ShadowYDistance = -1000
			oShape.ShadowColor = 255000000
			oShape.ShadowTransparence = 50%		' 透明度
			oShape.CornerRadius = 100
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

GSSP-)[General / Writer]Shadow


Sub oDShapeProp
	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.Shadow = True
		
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			'
 			oPositionShape( oShape, 2000, 4500,  3000, 1000 )
			'
			oShape.setString("OOoMacro")
		' 影付き
				oShape.Shadow = True
		' Shadow Prop
			oShape.ShadowXDistance = -1000
			oShape.ShadowYDistance = -1000
			oShape.ShadowColor = 255000000
			oShape.ShadowTransparence = 50%		' 透明度
			oShape.CornerRadius = 100
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

GSSP-)[General / Draw]>RotationAngle


Sub oDShapeProp
	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(3000,3000))
		oShape.setSize(createSize(4000,1500))
		oShape.setString("OOoMacro1")
		' 20degree RotateAngle
		oShape.RotateAngle = 2000		' unit : 1/100 degree
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

GSSP-)[General / Calc]>RotationAngle


Sub oDShapeProp
	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.getDrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,3000))
		oShape.setSize(createSize(4000,1500))
		oShape.setString("OOoMacro1")
		' 20degree RotateAngle
		oShape.RotateAngle = 2000		' unit : 1/100 degree
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

GSSP-)[General / Writer]>RotationAngle


Sub oDShapeProp
	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("OOoMacro1")
		' 20degree RotateAngle
		oShape.RotateAngle = 2000		' unit : 1/100 degree
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

GSSP-)[General / Calc]Rotate Mode ON / OFF


Sub ToggleOfRotateMode()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oDispatcher 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)
    	'
    ' ObjectのRotaion Mode ON / OFF
    	oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch( oFrame, ".uno:ToggleObjectRotateMode", "", 0, Array())
		msgbox "Roataion Mode = ON",0,"Toggle of Rotaion"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ToggleObjectRotateMode", "", 0, Array())
		msgbox "Roataion Mode = OFF",0,"Toggle of Rotaion" 
End Sub

GSSP-)[General / Draw]ShearAngle


Sub oDShapeProp
	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(3000,3000))
		oShape.setSize(createSize(4000,1500))
		oShape.setString("OOoMacro1")
		' 30degree ShearAngle 
		oShape.ShearAngle = 3000		' unit : 1/100 degree
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

GSSP-)[General / Calc ]ShearAngle


Sub oDShapeProp
	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.getDrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,3000))
		oShape.setSize(createSize(4000,1500))
		oShape.setString("OOoMacro1")
		' 30degree ShearAngle 
		oShape.ShearAngle = 3000		' unit : 1/100 degree
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

GSSP-)[General / Writer]ShearAngle


Sub oDShapeProp
	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("OOoMacro1")
		' 30degree ShearAngle 
		oShape.ShearAngle = 3000		' unit : 1/100 degree
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

GSSP-)[General / Draw]Text Sizeを外形Sizeと一致させる


Sub oDShapeProp
	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(3000,3000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro1")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.NONE
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,6000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro2")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,9000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro3")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.ALLLINES
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,12000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro4")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.RESIZEATTR
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

GSSP-)[General / Calc]Text Sizeを外形Sizeと一致させる


Sub oDShapeProp
	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.getDrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,3000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro1")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.NONE
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,6000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro2")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,9000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro3")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.ALLLINES
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,12000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro4")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.RESIZEATTR
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

GSSP-)[General / Writer]Text Sizeを外形Sizeと一致させる


Sub oDShapeProp
	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("OOoMacro1")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.NONE
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 3000,  3000, 1000 )
			oShape.setString("OOoMacro2")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.PROPORTIONAL
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 4500,  3000, 1000 )
			oShape.setString("OOoMacro3")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.ALLLINES
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		oPage.add(oShape)
		oPositionShape( oShape, 1000, 6000,  3000, 1000 )
		oShape.setString("OOoMacro4")
		'  
		oShape.TextFitToSize = com.sun.star.drawing.TextFitToSizeType.RESIZEATTR
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

GSSP-)[General / Draw]Text Box内の水平位置


Sub oDShapeProp
	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(3000,3000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro1")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,6000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro2")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,9000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro3")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.RIGHT
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,12000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro4")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.BLOCK
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

GSSP-)[General / Calc]Text Box内の水平位置


Sub oDShapeProp
	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.getDrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,3000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro1")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,6000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro2")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,9000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro3")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.RIGHT
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,12000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro4")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.BLOCK
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

GSSP-)[General / Writer]Text Box内の水平位置


Sub oDShapeProp
	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("OOoMacro1")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.LEFT
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 3000,  3000, 1000 )
			oShape.setString("OOoMacro2")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.CENTER
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 4500,  3000, 1000 )
			oShape.setString("OOoMacro3")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.RIGHT
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 6000,  3000, 1000 )
			oShape.setString("OOoMacro4")
		'  
		oShape.TextHorizontalAdjust = com.sun.star.drawing.TextHorizontalAdjust.BLOCK
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

GSSP-)[General / Draw]Text Box内の垂直位置


Sub oDShapeProp
	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(3000,3000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro1")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,6000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro2")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,9000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro3")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BOTTOM
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,12000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro4")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BLOCK
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

GSSP-)[General / Calc]Text Box内の垂直位置


Sub oDShapeProp
	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.getDrawPages().getByIndex(0)
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,3000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro1")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,6000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro2")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,9000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro3")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BOTTOM
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		'
		oPage.add(oShape)
		oShape.setPosition(createPoint(3000,12000))
		oShape.setSize(createSize(6000,2000))
		oShape.setString("OOoMacro4")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BLOCK
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

GSSP-)[General / Writer]Text Box内の垂直位置


Sub oDShapeProp
	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, 1500 )
			oShape.setString("OOoMacro1")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.TOP
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 3500,  3000, 1500 )
			oShape.setString("OOoMacro2")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.CENTER
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 5500,  3000, 1500 )
			oShape.setString("OOoMacro3")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BOTTOM
		'
		' 四角形の中にTEXT
		oShape = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 7500,  3000, 1500 )
			oShape.setString("OOoMacro4")
		'  
		oShape.TextVerticalAdjust = com.sun.star.drawing.TextVerticalAdjust.BLOCK
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

GSSP-)[General / Draw]CircleKind


Sub oDShapeProp
	Dim oPage     'Page on which to draw
	Dim oShape    'Shape to insert
	DIm oLocs
	Dim oDoc
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_default", 0, Dummy())
		'
		oLocs = Array( _
						com.sun.star.drawing.CircleKind.FULL, _
						com.sun.star.drawing.CircleKind.SECTION, _
						com.sun.star.drawing.CircleKind.CUT, _
						com.sun.star.drawing.CircleKind.ARC, _
						)
		'
		oPage = createDrawPage(oDOc, "Test Draw", True)
		' 
		for i = LBound(oLocs) to UBound(oLocs)
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			oPage.add(oShape)
			oShape.setPosition(CreatePoint((i+1)*2000, 1000))
			oShape.setSize(CreateSize(1000, 700))
			oShape.setString(i)
			oShape.CircleStartAngle = 9000
			oShape.CircleEndAngle = 36000
			oShape.CircleKind = oLocs(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

GSSP-)[General / Calc]CircleKind


Sub oDShapeProp
	Dim oPage     'Page on which to draw
	Dim oShape    'Shape to insert
	DIm oLocs
	Dim oDoc
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default", 0, Dummy())
		'
		oLocs = Array( _
						com.sun.star.drawing.CircleKind.FULL, _
						com.sun.star.drawing.CircleKind.SECTION, _
						com.sun.star.drawing.CircleKind.CUT, _
						com.sun.star.drawing.CircleKind.ARC, _
						)
		'
		oPage = oDoc.getDrawPages().getByIndex(0)
		' 
		for i = LBound(oLocs) to UBound(oLocs)
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			oPage.add(oShape)
			oShape.setPosition(CreatePoint((i+1)*2000, 1000))
			oShape.setSize(CreateSize(1000, 700))
			oShape.setString(i)
			oShape.CircleStartAngle = 9000
			oShape.CircleEndAngle = 36000
			oShape.CircleKind = oLocs(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

GSSP-)[General / Writer]CircleKind


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/swriter", "_default", 0, Dummy())
		'
		oLocs = Array( _
						com.sun.star.drawing.CircleKind.FULL, _
						com.sun.star.drawing.CircleKind.SECTION, _
						com.sun.star.drawing.CircleKind.CUT, _
						com.sun.star.drawing.CircleKind.ARC, _
						)
		'
		oPage = oDoc.getDrawPage()
		' 
		for i = LBound(oLocs) to UBound(oLocs)
			oShape = oDoc.createInstance("com.sun.star.drawing.EllipseShape")
			oPage.add(oShape)
			oPositionShape( oShape, 1000, 1500 + i*2000 ,  3000, 1500 )
			oShape.setString(i)
			oShape.CircleStartAngle = 9000
			oShape.CircleEndAngle = 36000
			oShape.CircleKind = oLocs(i)
		next i
		oShape.RotateAngle = 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

GSSP-)[General / Calc]Shape反転(1)[ 水平/垂直 ]


Sub  MirrorObject()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oPage as object
	Dim oLine as Object, oShape as Object
	Dim oPosition As New com.sun.star.awt.Point
	Dim oSize As New com.sun.star.awt.Size
	Dim oDispatcher as Object
  		oDoc = ThisComponent 
  		oPage = oDoc.DrawPages().getByIndex(0)
  		' Line Object
  		oLine = oDoc.createInstance( "com.sun.star.drawing.LineShape" )
  			oLine.LineColor = RGB( 255, 0, 0 )
  			oLine.LineWidth = 100
  		' Position
			oPosition.X = 500
  			oPosition.Y = 500
  		oLine.setPosition(oPosition)
  		' Size
  			oSize.width = 2500
  			oSize.height= 2500
  		oLine.setSize(oSize)
  	oPage.add( oLine )
  	' 両端形状
  		oLine.LineStartName = "Square"
		oLine.LineStartWidth = 500
		oLine.LineEndName = "Small Arrow"
		oLine.LineEndWidth = 500
	msgbox "Draw Line !!",0,"Initial"
	'
	' Selected Object
    	oCtrl = oDoc.CurrentController()
    	oCtrl.select(oLine)
		'
	' The Mirroring in the horizontal direction
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorHorizontal", "", 0, Array())
		msgbox "Horizontal",0,"Mirroring"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorVertical", "", 0, Array())
		msgbox "Vertical",0,"Mirroring"
End Sub

GSSP-)[General / Calc]Shape反転(2)[ 垂直方向のみ ]


Sub MirrorObject()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oPage as Object
	Dim oShape as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		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(3000, 1000))
			oShape.setString("LibreOffice")
			'
		' Selected Object
    	oCtrl = oDoc.CurrentController()
    	oCtrl.select(oShape)
    	'
		' The Mirroring in the horizontal direction
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		wait 10
		oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorHorizontal", "", 0, Array())
		msgbox "文字を記入している為" & Chr$(10) & "Horizontalの反転は不可",0,"Mirroring"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ObjectMirrorVertical", "", 0, Array())
		msgbox "Verticalは文字も反転する" & Chr$(10) & "180°回転した結果と同じ",0,"Mirroring"
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


GSSP-)[General / Calc]Text Animation( Calc )

Sub oShapeText()
	Dim oPage as Object, oShape as Object
	Dim oDoc as Object
		oDoc = ThisComponent
		oPage = oDoc.DrawPages().getByIndex(0)
		' Only Text
		oShape = oDoc.createInstance("com.sun.star.drawing.TextShape")
			oPage.add(oShape)
			oShape.setPosition(createPoint(100, 400))
			oShape.setSize(createSize(5000, 1000))
			oShape.setString("TextShape")
		' Text Animation	
			oShape.TextAnimationKind = com.sun.star.drawing.TextAnimationKind.SCROLL
			'
		msgbox "Success",0,"LO4.3.1"
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
'
' [ Note ]
' com.sun.star.drawing.TextAnimationKind
' 
' NONE : なし
' BLINK : 点滅
' SCROLL : 通過
' ALTERNATE : 前方に進行
' SLIDE : 流し込み




[ ConnectorShape ]

GSCS-)[General / Draw]ConnectorShape


Sub oDShapeProp
	Dim oPage
	Dim oRectangleShape
	Dim oShape    'Shape to insert
	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(2400, 2000))
		next i
		oRectangleShape(0).setPosition(CreatePoint(3000, 7000)
		oRectangleShape(1).setPosition(CreatePoint(8000, 4000)
		oRectangleShape(2).setPosition(CreatePoint(14000, 5000)
		oRectangleShape(3).setPosition(CreatePoint(8000, 9000)
	'
	' 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)
			oShape.LineWidth = 50
			'Dash
			oShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
    		Dim oDash1 as New com.sun.star.drawing.LineDash
			Select Case i
				case 0
		   			With oDash1
    					.Style = com.sun.star.drawing.DashStyle.RECT
    					.Dots = 2
    					.DotLen = 100
    					.Dashes = 1    							
    					.DashLen = 750
    					.Distance = 100
    				End With
    				oShape.LineDash = oDash1
					'
					oShape.LineColor = RGB(255,0,0)
					'
					oShape.StartGluePointIndex = 0
					oShape.EndShape = oRectangleShape(i+1)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 0
					'
					oShape.LineStartName = "Arrow"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Square"
					oShape.LineEndWidth = 500
				case 1
					With oDash1
    					.Style = com.sun.star.drawing.DashStyle.ROUND
    					.Dots = 1
    					.DotLen = 100
    					.Dashes = 1
    					.DashLen = 750
    					.Distance = 200
    				End With
    				oShape.LineDash = oDash1
    				'
					oShape.LineColor = RGB(0,255,0)
					'
					oShapeStartGluePointIndex = 1
					oShape.EndShape = oRectangleShape(i+1)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 4
					'
					oShape.LineStartName = "Small Arrow"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Double Arrow"
					oShape.LineEndWidth = 500
				case 2
					With oDash1
    					.Style = com.sun.star.drawing.DashStyle.ROUND
    					.Dashes = 1
    					.DashLen = 200
    					.Distance = 200
    				End With
    				oShape.LineDash = oDash1
    				'
					oShape.LineColor = RGB(0,0,255)
					'
					oShape.StartGluePointIndex = 2
					oShape.EndShape = oRectangleShape(i+1)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 1
					'
					oShape.LineStartName = "Rounded short Arrow"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Line Arrow"
					oShape.LineEndWidth = 500
				case 3
					With oDash1
    					.Style = com.sun.star.drawing.DashStyle.RECT
    					.Dots = 3
    					.DotLen = 100
    					.Dashes = 1
    					.DashLen = 750
    					.Distance = 100
    				End With
    				oShape.LineDash = oDash1
    				'
					oShape.LineColor = RGB(0,0,0)
					'
					oShape.StartGluePointIndex = 3
					oShape.EndShape = oRectangleShape(0)
					oShape.EdgeKind = oConnType(i)
					oShape.EndGluePointIndex = 1
					'
					oShape.LineStartName = "Square 45"
					oShape.LineStartWidth = 500
					oShape.LineEndName = "Arrow concave"
					oShape.LineEndWidth = 500
			End Select
		next i
		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 bForceNew Then
				oPages.remove(oPages.getByName(sName))
			Else
				createDrawPage = oPages.getByName(sName)
				Exit Function
			End If
		End If
		'
		oPage = oPages.getByIndex(oPages.getCount()-1)
		oPage.setName(sName)
		createDrawPage = oPage
End Function

GSCS-)[General / Calc](未完成)ConnectorShape




GSCS-)[General / Writer](未完成)ConnectorShape











[ GraphicObjectShape ]

GSGOb-)[General / Draw]GraphicObjectShape


Sub oGraphicObj
	Dim oDoc
	Dim oPage As Object
	Dim oGraphicObjectShape As Object
	Dim oPoint As New com.sun.star.awt.Point
	Dim oSize As New com.sun.star.awt.Size
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_blank", 0, Dummy())
		oPage = oDoc.getdrawPages().getByIndex(0)
		'
		oPoint.x = 1000        
		oPoint.y = 1000
		oSize.Width = 10000
		oSize.Height = 10000
		' 
		oGraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
			oGraphicObjectShape.Size = oSize
			oGraphicObjectShape.Position = oPoint
		'
			oGraphicObjectShape.GraphicURL = "file:///c:/temp/graph.jpg"
			oGraphicObjectShape.AdjustBlue = -50
			oGraphicObjectShape.AdjustGreen = 5
			oGraphicObjectShape.AdjustBlue = 10
			oGraphicObjectShape.AdjustContrast = 20
			oGraphicObjectShape.AdjustLuminance = 50
			oGraphicObjectShape.Transparency = 40
			oGraphicObjectShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
		'
		oPage.add(oGraphicObjectShape)
End Sub

GSGOb-)[General / Calc]GraphicObjectShape


Sub oGraphicObj()
	Dim oDoc as Object
	Dim oPage As Object
	Dim oGraphicObjectShape As Object
	Dim oPoint As New com.sun.star.awt.Point
	Dim oSize As New com.sun.star.awt.Size
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
		oPage = oDoc.getdrawPages().getByIndex(0)
		'
		oPoint.x = 1000        
		oPoint.y = 1000
		oSize.Width = 10000
		oSize.Height = 10000
		' 
		oGraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
			oGraphicObjectShape.Size = oSize
			oGraphicObjectShape.Position = oPoint
		'
			oGraphicObjectShape.GraphicURL = "file:///c:/temp/graph.jpg"
			oGraphicObjectShape.AdjustBlue = -50
			oGraphicObjectShape.AdjustGreen = 5
			oGraphicObjectShape.AdjustBlue = 10
			oGraphicObjectShape.AdjustContrast = 20
			oGraphicObjectShape.AdjustLuminance = 50
			oGraphicObjectShape.Transparency = 40
			oGraphicObjectShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
		'
		oPage.add(oGraphicObjectShape)
End Sub

GSGOb-)[General / Writer]GraphicObjectShape


Sub oGraphicObj()
	Dim oDoc as Object
	Dim oPage As Object
	Dim oGraphicObjectShape As Object
	Dim oPosX as Integer, oPosY as Integer, oWidth as Integer, oHieght as Integer
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oPage = oDoc.getDrawPage()
		'
		oPosX = 1000        
		oPosY = 1000
		oWidth = 10000
		oHieght = 10000
		' 
		oGraphicObjectShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
			'
			oGraphicObjectShape.GraphicURL = "file:///c:/temp/graph.jpg"
			oGraphicObjectShape.AdjustBlue = -50
			oGraphicObjectShape.AdjustGreen = 5
			oGraphicObjectShape.AdjustBlue = 10
			oGraphicObjectShape.AdjustContrast = 20
			oGraphicObjectShape.AdjustLuminance = 50
			oGraphicObjectShape.Transparency = 40
			oGraphicObjectShape.GraphicColorMode = com.sun.star.drawing.ColorMode.STANDARD
			'
		oPage.add(oGraphicObjectShape)
		'
		oPositionShape( oGraphicObjectShape, oPosX, oPosY,  oWidth, oHieght ) 
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


[ OLE Shape ]

GSOLE-)[General/Writer]Writer Doc挿入


Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oSelections
  	Dim oSel
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oSelections =  oDoc.currentController().Selection
		oSel = oSelections.getByIndex(0)
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "8bc6b165-b1b2-4edd-aa47-dae2ee689dd6"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		oObj.attach(oSel)
		'
		oObjModel = oObj.Model
		'
		oObjModel.getText().setString("OLE Embedded Writer")
		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

' CLSIDの値
' 挿入するOLE Object( Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6	Service name => com.sun.star.text.TextDocument
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f	Service name => com.sun.star.sheet.SpreadsheetDocument
' Chart		:	12dcae26-281f-416f-a234-c3086127382e	Service name => com.sun.star.chart.ChartDocument
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3	Service name => com.sun.star.drawing.DrawingDocument
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047	Service name => com.sun.star.presentation.PresentationDocument
' Math		:	078b7aba-54fc-457f-8551-6147e776a997	Service name => com.sun.star.formula.FormulaProperties

GSOLE-)[General/Writer]Calc Doc挿入


Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oCur = oText.createTextCursor()
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "47bbb4cb-ce4c-4e80-a591-42d9ae74950f"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		'
		' Chart 枠size
		oSize = CreateUnoStruct("com.sun.star.awt.Size")
  			oSize.Width = 10000
  			oSize.Height = 5000
  		oObj.setSize(oSize)
		'  
  		 oText.insertTextContent(oCur, oObj, False) 
		'
		Dim oSpreadSheetDoc
			oSpreadSheetDoc = oObj.getEmbeddedObject 
			oSheets = oSpreadSheetDoc.getSheets 
			oSheet = oSheets.getByIndex(0) 
			oSheet.getCellByPosition(0, 0).String = "OLE Calc Document in Writer" 
			oSheet.getCellByPosition(0, 1).Value = 10
			oSheet.getCellByPosition(0, 2).Value = 20
			oSheet.getCellByPosition(0, 3).Formula = "=A2+A3"
		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

' CLSIDの値
' 挿入するOLE Object( Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f
' Chart		:	12dcae26-281f-416f-a234-c3086127382e
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047
' Math		:	078b7aba-54fc-457f-8551-6147e776a997

GSOLE-)[General/Writer]Chart挿入


Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oCur = oText.createTextCursor()
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "12dcae26-281f-416f-a234-c3086127382e"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		'
		' Chart 枠size
		oSize = CreateUnoStruct("com.sun.star.awt.Size")
  			oSize.Width = 10000
  			oSize.Height = 10000
  		oObj.setSize(oSize)
		'  
  		oText.insertTextContent(oText.getEnd, oObj,False)
  		'
  		oChart = oObj.Model
  		oDiagram = oChart.createInstance("com.sun.star.chart.StackableDiagram")
		'
  		oChart.setDiagram(oDiagram)
  		oDiagram = oChart.getDiagram()
  		With oDiagram
    		.Stacked = True
    		.Percent = True
    		.Vertical = True
  		End With
		'
  		oChartData = oChart.getData()
  			Dim oData(1,3) As Double
  			' X Axis
  				oData(0,0) = 100.0
  				oData(0,1) = 50.0
  				oData(0,2) = 25.0
  				oData(0,3) = 12.5
  			' Y Axis
  				oData(1,0) = 100.0
  				oData(1,1) = 50.0
  				oData(1,2) = 25.0
  				oData(1,3) = 12.5
			'  			
  				oChartData.setData(oData)
  			'
  			' Cellの位置を設定
  				oChartData.setRowDescriptions(Array("Data 1", "Data 2"))
  				oChartData.setColumnDescriptions(Array("A", "B", "C", "D"))
			'
  				oChart.HasMainTitle = True
  				oTitle = oChart.Title
  				oTitle.String = "OLE Chart in Writer" 
		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

' CLSIDの値
' 挿入するOLE Object( Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f
' Chart		:	12dcae26-281f-416f-a234-c3086127382e
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047
' Math		:	078b7aba-54fc-457f-8551-6147e776a997

GSOLE-)[General/Writer]Draw Doc挿入




GSOLE-)[General/Writer]Impress Doc挿入












GSOLE-)[General/Writer]Math Doc挿入


Sub oWriterShapeOLE
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oCur = oText.createTextCursor()
		'
  		oObj   = oDoc.createInstance("com.sun.star.text.TextEmbeddedObject")
		'
		oObj.CLSID = "078b7aba-54fc-457f-8551-6147e776a997"
		'
		oObj.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER	
		'
		oText.insertTextContent(oCur, oObj, true)
  		oObj.EmbeddedObject.Formula = "{1}over{2}" 
		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

' CLSIDの値
' 挿入するOLE Object( Writer / Calc / Chart / Draw / Impress / Math )によって値が異なる
' Writer	:	8bc6b165-b1b2-4edd-aa47-dae2ee689dd6
' Calc		:	47bbb4cb-ce4c-4e80-a591-42d9ae74950f
' Chart		:	12dcae26-281f-416f-a234-c3086127382e
' Draw		:	4bab8970-8a3b-45b3-991c-cbeeac6bd5e3
' Impress	:	9176e48a-637a-4d1f-803b-99d9bfac1047
' Math		:	078b7aba-54fc-457f-8551-6147e776a997

GSOLE-)[General]OLE Objectを挿入Dialog表示


Sub InstOleObjDialog()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:InsertObject", "", 0, Array())
End Sub

GSOLE-)[General]





[ Anchor ]

{{ Writer }}

GSAhWr-)[General / Writer ]





{{ Calc }}

GSAhWr-)[General / Calc ]AnchorをCellに設定(1)


Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oDispatcher 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)
    	'
    ' AnchorをCell に設定
    	oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToCell", "", 0, Array())
		'
	' Anchor 
		oCtrl.ShowAnchor = true
    msgbox "Anchorを Cell に設定" 
End Sub

GSAhWr-)[General / Calc ]AnchorをCellに設定(2)


Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oObj as Object
	Dim oObjAnchor 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)
    '
    ' Anchorを B3 Cell に設定( Shapeを移動させて設定 )
    	oObjAnchor = oShape.Anchor
    	with oShape
    		.Anchor = oObjAnchor.getCellRangeByName("B3")
    	end with
		'
	' Dispay Anchor
		oCtrl = oDoc.getCurrentController()	
		oCtrl.ShowAnchor = true
		oCtrl.select(oShape)
		'
	' AnchorがCellにあるかCheck → Cellに設定後 Anchor Objectを取得する必要がある
		oChk = oDrawP.getByindex(0).Anchor
		if oChk.supportsService("com.sun.star.sheet.SheetCell") then
    		oDisp = "Anchorを Cell に設定 → 成功"
    	else
    		oDisp = "Anchorを Cell に設定 → 失敗"
    	end if
    	msgbox oDisp,0,"Shape Anchor"
End Sub

GSAhWr-)[General / Calc ]AnchorをPageに設定[Default値]


Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object, oFrame
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oDispatcher 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)
    	'
    ' AnchorをCell に設定
    	oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToCell", "", 0, Array())
		'
	' Anchor 
		oCtrl.ShowAnchor = true
    msgbox "Anchorを Cell に設定",0,"Shape Anchor"
    '
    ' Anchorを Page に設定
    	oDispatcher.executeDispatch( oFrame, ".uno:SetAnchorToPage", "", 0, Array())
    msgbox "Anchorを Page に設定",0,"Shape Anchor"
End Sub

GSAhWr-)[General / Calc ]AnchorをPageに設定(2)[Default値]


Sub oDShapeAnchor()
	Dim oDoc as Object, oCtrl as Object
	Dim oDrawP as Object
	Dim oShape as Object
	Dim oObj as Object
	Dim oObjAnchor 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 = 2000
		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)
    '
    ' AnchorをCurrnt PositionにてPageに設定
    	oObjAnchor = oShape.Anchor
    	with oShape
    		.Anchor = oObjAnchor.getSpreadsheet()
  			.HoriOrientPosition = oShape.HoriOrientPosition + oObjAnchor.Position.X
   			.VertOrientPosition = oShape.VertOrientPosition + oObjAnchor.Position.Y
    	end with
		'
	' Dispay Anchor
		oCtrl = oDoc.getCurrentController()	
		oCtrl.ShowAnchor = true
		oCtrl.select(oShape)
		'
	' AnchorがPageにあるかCheck → Cellに設定後 Anchor Objectを取得する必要がある
		oChk = oDrawP.getByindex(0).Anchor
		if oChk.supportsService("com.sun.star.sheet.Spreadsheet") then
    		oDisp = "Anchorを Page に設定 → 成功"
    	else
    		oDisp = "Anchorを Page に設定 → 失敗"
    	end if
    	msgbox oDisp,0,"Shape Anchor"
End Sub

GSAhWr-)[General / Calc ]





Top of Page

inserted by FC2 system