<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Shape" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
REM === The SFDocuments library is one of the associated libraries. ===
REM === Full documentation is available on https://help.libreoffice.org/ ===
REM =======================================================================================================================
Option Compatible
Option ClassModule
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_Shape
''' ========
'''
''' The SF_Shape module is focused on the description of shapes/images/drawing objects
''' stored in documents.
''' In the actual release only shapes in Calc sheets are considered.
''' Charts are a special type of shapes. The "Chart" service is a subclass of the actual service.
'''
''' Definitions
''' Shapes have 2 distinct names:
''' - an internal name, given by the LibreOffice application
''' - an optional user-defined name
''' In the scope of the ScriptForge libraries, the Shape name is the name given by the user.
''' Only when there is no user name, the internal name may be used instead.
''' The name of a shape must be unique within the sheet where it is located.
'''
''' Service invocation from the "Calc" service
''' Either make a new Shape
''' calc.CreateShapeFromFile(ShapeName, SheetName, ImageFile, AsLink := False)
''' or select an existing one within a given sheet
''' calc.Shapes(SheetName, ShapeName)
'''
''' Detailed user documentation:
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_shape.html?DbPAR=BASIC
'''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
Private Const SHAPEEXPORTERROR = "SHAPEEXPORTERROR"
REM ============================================================= PRIVATE MEMBERS
Private [Me] As Object
Private [_Parent] As Object ' Parent Calc document
Private ObjectType As String ' Must be SHAPE
Private ServiceName As String
' Shape description
Private _SheetName As String ' Name of the Calc sheet containing the Shape
Private _DrawIndex As Long ' Index of the Shape in the sheet's draw page
Private _ShapeName As String ' User name
Private _PersistentName As String ' Internal name
Private _Shape As Object ' com.sun.star.drawing.XShape
Private _XPos As Long ' Initial X position
Private _YPos As Long ' Initial Y position
Private _IsChart As Boolean ' When True, instance is a superclass of a chart instance
REM ============================================================ MODULE CONSTANTS
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
Set [Me] = Nothing
Set [_Parent] = Nothing
ObjectType = "SHAPE"
ServiceName = "SFDocuments.Shape"
_SheetName = ""
_DrawIndex = -1
_ShapeName = ""
_PersistentName = ""
Set _Shape = Nothing
_XPos = -1
_YPos = -1
_IsChart = False
End Sub ' SFDocuments.SF_Shape Constructor
REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
Call Class_Initialize()
End Sub ' SFDocuments.SF_Shape Destructor
REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
Call Class_Terminate()
Set Dispose = Nothing
End Function ' SFDocuments.SF_Shape Explicit Destructor
REM ================================================================== PROPERTIES
REM -----------------------------------------------------------------------------
Property Get XRectangle() As Variant
''' A com.sun.star.awt.XRectangle object. Distances are expressed in 1/100th mm.
XRectangle = _PropertyGet("XRectangle")
End Property ' SFDocuments.SF_Shape.XRectangle (get)
REM -----------------------------------------------------------------------------
Property Get XShape() As Variant
''' com.sun.star.drawing.XShape
XShape = _PropertyGet("XShape")
End Property ' SFDocuments.SF_Shape.XShape (get)
REM ===================================================================== METHODS
REM -----------------------------------------------------------------------------
Public Function Anchor(Optional ByVal AnchorType As Variant _
, Optional ByVal Cell As Variant _
) As Boolean
''' Define the anchor type and the cell to which the shape has to be anchored.
''' Args:
''' AnchorType: next strings are accepted,
''' CELL: the shape is anchored "to cell"
''' CELLRESIZE: the shape is anchored "to cell (resize with cell)"
''' PAGE: the shape is anchored to the sheet
''' Cell: a unique cell or a cell range in the sheet where the shape is located.
''' Only the top-left cell of a range will be considered.
''' The argument is ignored and may be omitted when AnchorType = "PAGE"
''' Returns:
''' True when successful
''' Examples:
''' oShape.Anchor("CELL", Cell := "B6")
Dim bAnchor As Boolean ' Return value
Dim oCell As Object ' Alias of cell argument
Dim oPosition As New com.sun.star.awt.Point ' Position of shape when anchor type is "PAGE"
Const cstThisSub = "SFDocuments.Shape.Anchor"
Const cstSubArgs = "AnchorType=""CELL""|""CELLRESIZE""|""PAGE"", [Cell]"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bAnchor = False
Check:
If IsMissing(Cell) Or IsEmpty(Cell) Then Cell = "~.A1"
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not [_Parent]._IsStillAlive() Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(AnchorType, "AnchorType", V_STRING, Array("CELL", "CELLRESIZE", "PAGE")) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(Cell, "Cell", V_STRING) Then GoTo Finally
End If
Try:
Set oCell = [_Parent]._ParseAddress(Cell)
With _Shape
Select Case UCase(AnchorType)
Case "CELL", "CELLRESIZE"
.Anchor = oCell.XCellRange.getCellByPosition(0, 0)
.ResizeWithCell = ( UCase(AnchorType) = "CELLRESIZE" )
bAnchor = True
Case "PAGE"
Set oPosition = .getPosition()
.Anchor = oCell.XSpreadsheet
.ResizeWithCell = False
.setposition(oPosition) ' Restore the initial position (if not, position = A1)
bAnchor = True
Case Else
End Select
End With
Finally:
Anchor = bAnchor
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SF_Documents.SF_Shape.Anchor
REM -----------------------------------------------------------------------------
Public Function ExportToFile(Optional ByVal FileName As Variant _
, Optional ByVal ImageType As Variant _
, Optional ByVal Overwrite As Variant _
) As Boolean
''' Store the shape as an image to the given file location
''' Args:
''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
''' ImageType: the name of the targeted image type
''' Allowed values: gif, jpeg, png (default), svg and tiff
''' Overwrite: True if the destination file may be overwritten (default = False)
''' Returns:
''' False if the document could not be saved
''' Exceptions:
''' SHAPEEXPORTERROR The destination has its readonly attribute set or overwriting rejected
''' Examples:
''' oShape.ExportToFile("C:\Me\Shape2.gif", ImageType := "gif", Overwrite := True)
Dim bSaved As Boolean ' return value
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
Dim sFile As String ' Alias of FileName
Dim vStoreArguments As Variant ' Array of com.sun.star.beans.PropertyValue
Dim FSO As Object ' SF_FileSystem
Dim oExport As Object ' com.sun.star.drawing.GraphicExportFilter
Dim vImageTypes As Variant ' Array of permitted image types
Dim vMimeTypes As Variant ' Array of corresponding mime types in the same order as vImageTypes
Const cstImageTypes = "gif,jpeg,png,svg,tiff"
Const cstMimeTypes = "image/gif,image/jpeg,image/png,image/svg+xml,image/tiff"
Const cstThisSub = "SFDocuments.Shape.ExportToFile"
Const cstSubArgs = "FileName, [ImageType=""png""|""gif""|""jpeg""|""svg""|""tiff""], [Overwrite=False]"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
bSaved = False
Check:
If IsMissing(ImageType) Or IsEmpty(ImageType) Then ImageType = "png"
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
vImageTypes = Split(cstImageTypes, ",")
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not [_Parent]._IsStillAlive() Then GoTo Finally
If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(ImageType, "ImageType", V_STRING, vImageTypes) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
End If
' Check destination file overwriting
Set FSO = CreateScriptService("FileSystem")
sFile = FSO._ConvertToUrl(FileName)
If FSO.FileExists(FileName) Then
If Overwrite = False Then GoTo CatchError
Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess")
If oSfa.isReadonly(sFile) Then GoTo CatchError
End If
Try:
' Setup arguments
vMimeTypes = Split(cstMimeTypes, ",")
vStoreArguments = Array( _
ScriptForge.SF_Utils._MakePropertyValue("URL", sFile) _
, ScriptForge.SF_Utils._MakePropertyValue("MediaType" _
, vMimeTypes(ScriptForge.SF_Array.IndexOf(vImageTypes, ImageType, CaseSensitive := False))) _
)
' Export with the com.sun.star.drawing.GraphicExportFilter UNO service
Set oExport = ScriptForge.SF_Utils._GetUNOService("GraphicExportFilter")
With oExport
.setSourceDocument(_Shape)
.filter(vStoreArguments)
End With
bSaved = True
Finally:
ExportToFile = bSaved
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchError:
ScriptForge.SF_Exception.RaiseFatal(SHAPEEXPORTERROR, "FileName", FileName, "Overwrite", Overwrite)
GoTo Finally
End Function ' SFDocuments.SF_Shape.ExportToFile
REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Returns:
''' The actual value of the property
''' If the property does not exist, returns Null
''' Exceptions:
''' ARGUMENTERROR The property does not exist
Const cstThisSub = "SFDocuments.Shape.GetProperty"
Const cstSubArgs = ""
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
GetProperty = Null
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
GetProperty = _PropertyGet(PropertyName)
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Shape.GetProperty
REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list of public methods of the Shape service as an array
Methods = Array( _
"Anchor" _
, "ExportToFile" _
, "Pick" _
, "Resize" _
)
End Function ' SFDocuments.SF_Shape.Methods
REM -----------------------------------------------------------------------------
Public Function Pick() As Boolean ' "Select" would have been more convenient but is a reserved word in Basic
''' Make the actual shape the current selection
''' Args:
''' Returns:
''' True when successful
''' Examples:
''' oShape.Pick()
Dim bPick As Boolean ' Return value
Const cstThisSub = "SFDocuments.Shape.Pick"
Const cstSubArgs = ""
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bPick = False
Check:
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not [_Parent]._IsStillAlive() Then GoTo Finally
End If
Try:
[_Parent]._Component.CurrentController.select(_Shape)
bPick = True
Finally:
Pick = bPick
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SF_Documents.SF_Shape.Pick
REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the Shape class as an array
Properties = Array( _
"XRectangle" _
, "XShape" _
)
End Function ' SFDocuments.SF_Shape.Properties
REM -----------------------------------------------------------------------------
Public Function Resize(Optional ByVal XPos As Variant _
, Optional ByVal YPos As Variant _
, Optional ByVal Width As Variant _
, Optional ByVal Height As Variant _
) As Boolean
''' Move the topleft corner of a shape to new coordinates and/or modify its dimensions
''' Missing arguments are ignored.
''' All distances are expressed in 1/100th mm
''' Args:
''' XPos : the vertical distance from the topleft corner
''' YPos : the horizontal distance from the topleft corner
''' Width : the horizontal width of the shape
''' Height : the vertical height of the shape
''' Negative or missing arguments are left unchanged
''' Returns:
''' True when successful
''' Examples:
''' oShape.Resize(1000, 2000, Height := 6000) ' Width is not changed
Dim bResize As Boolean ' Return value
Dim oPosition As Object ' com.sun.star.awt.Point
Dim oSize As Object ' com.sun.star.awt.Size
Const cstThisSub = "SFDocuments.Shape.Resize"
Const cstSubArgs = "[XPos], [YPos], [Width], [Height]"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bResize = False
Check:
If IsMissing(XPos) Or IsEmpty(XPos) Then XPos = -1
If IsMissing(YPos) Or IsEmpty(YPos) Then YPos = -1
If IsMissing(Height) Or IsEmpty(Height) Then Height = -1
If IsMissing(Width) Or IsEmpty(Width) Then Width = -1
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not [_Parent]._IsStillAlive() Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(XPos, "XPos", ScriptForge.V_NUMERIC) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(YPos, "YPos", ScriptForge.V_NUMERIC) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
End If
Try:
With _Shape
' Get the current values
Set oPosition = .Position
Set oSize = .Size
' Modify relevant elements
If XPos >= 0 Then
_XPos = CLng(XPos)
oPosition.X = _XPos
End If
If YPos >= 0 Then
_YPos = CLng(YPos)
oPosition.Y = _YPos
End If
If Width > 0 Then oSize.Width = CLng(Width)
If Height > 0 Then oSize.Height = CLng(Height)
' Rewrite
.setPosition(oPosition)
.setSize(oSize)
End With
bResize = True
Finally:
Resize = bResize
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SF_Documents.SF_Shape.Resize
REM -----------------------------------------------------------------------------
Public Function Rotate(Optional ByVal Angle As Variant _
, Optional ByRef Pivot As Variant _
) As Boolean
''' Rotate the shape using a given pivot point with a given angle.
''' Args:
''' Angle : the magnitude of the rotation, expressed in degrees.
''' An angle may be positive or negative. Positive = counterclockwise.
''' Angle is to be understood as absolute vs. the usual X-axis orientation.
''' Pivot: the point about which the rotation will take place.
''' It can be
''' - either an array (x, y) being the coordinates of the pivot point in 1/100 mm
''' - or, when the intent is to use the shape's natural pivot points,
''' a string combining 2 of next uppercase characters (other characters are ignored):
''' L Left
''' R Right
''' C Center
''' T Top
''' B Bottom
''' M Middle
''' Returns:
''' True when successful
''' Examples:
''' oShape.Rotate(30, "Middle,Right")
''' ' Rotate about the middle-right pivot point
''' oShape.Rotate(90, Array(1000, 2500)
''' ' Rotate about the given pivot. The origin is the top-left corner of the sheet where the shape is located.
Dim bRotate As Boolean ' Return value
Dim dTheta As Double ' Angle in radians
Dim dSTheta As Double ' Sin(θ)
Dim dCTheta As Double ' Cos(θ)
Dim lPivotX As Long ' The pivot X-coordinate in 1mm/100
Dim lPivotY As Long ' The pivot Y-coordinate in 1mm/100
Dim lWidth As Long ' Actual shape's width
Dim lHeight As Long ' Actual shape's height
Dim lXPos As Long ' Actual top-left point position
Dim lYPos As Long ' Actual top-left point position
Dim lX As Long ' Future top-left point position
Dim lY As Long ' Future top-left point position
Dim oTransform As New com.sun.star.drawing.HomogenMatrix3 ' Transformation matrix
Const cstThisSub = "SFDocuments.Shape.Rotate"
Const cstSubArgs = "Angle, Pivot=""CM"""
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bRotate = False
Check:
If IsMissing(Pivot) Or IsEmpty(Pivot) Then Pivot = "CM"
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not [_Parent]._IsStillAlive() Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(Angle, "Angle", ScriptForge.V_NUMERIC) Then GoTo Finally
If IsArray(Pivot) Then
If Not ScriptForge.SF_Utils._ValidateArray(Pivot, "Pivot", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
Else
If Not ScriptForge.SF_Utils._Validate(Pivot, "Pivot", V_STRING) Then GoTo Finally
If Len(Pivot) <= 1 Then Pivot = "CM"
End If
End If
Try:
REM Derived from https://en.wikipedia.org/wiki/Rotation_matrix and similar sources
REM https://forum.openoffice.org/en/forum/viewtopic.php?t=57754
REM The objective is to inject a transformation (3x3) matrix into the XShape.Transformation property
REM with next values:
REM W * cos θ H * sin θ X
REM W * -sin θ H * cos θ Y
REM 0 0 1
REM where W, H = the width and height of the shape BEFORE rotation
REM θ = the rotation angle in radians
REM X, Y = the coordinates of the shape(s position AFTER rotation about the pivot point
REM the last row states that only the z-axis is involved in the rotation
' Determine the angle in radians
dTheta = CDbl(Angle) * PI() / 180.0
dSTheta = Sin(dTheta)
dCTheta = Cos(dTheta)
With _Shape
' Determine the pivot point
lWidth = .Size.Width
lHeight = .Size.Height
' Prefer initial positions for the case shape has already been rotated
lXPos = _XPos
lYPos = _YPos
If IsArray(Pivot) Then
lPivotX = CLng(Pivot(0))
lPivotY = CLng(Pivot(1))
Else
If InStr(1, Pivot, "L", 0) > 0 Then lPivotX = lXPos
If InStr(1, Pivot, "C", 0) > 0 Then lPivotX = lXPos + lWidth / 2
If InStr(1, Pivot, "R", 0) > 0 Then lPivotX = lXPos + lWidth
If InStr(1, Pivot, "T", 0) > 0 Then lPivotY = lYPos
If InStr(1, Pivot, "M", 0) > 0 Then lPivotY = lYPos + lHeight / 2
If InStr(1, Pivot, "B", 0) > 0 Then lPivotY = lYPos + lHeight
End If
' Determine the position of the top-left point of the shape after location
' The general expression computing the coordinates (x′,y′) of a point (x,y) after a rotation
' of an angle θ about a pivot P=(xp,yp), when the Y-axis is oriented downwards, is:
' x′= (x − xp).cos θ + (y − yp).sin θ + xp
' y′= −(x − xp).sin θ + (y − yp).cos θ + yp
' This includes
' (1) consider the pivot as the new origin (0,0)
' (2) rotate the point about the new origin
' (3) reset the origin
lX = CLng((lXPos - lPivotX) * dCTheta + (lYPos - lPivotY) * dSTheta) + lPivotX
lY = CLng(-(lXPos - lPivotX) * dSTheta + (lYPos - lPivotY) * dCTheta) + lPivotY
' Feed the rotation matrix row by row
With oTransform ' All Long items
.Line1.Column1 = CLng(lWidth * dCTheta)
.Line1.Column2 = CLng(lHeight * dSTheta)
.Line1.Column3 = lX
.Line2.Column1 = CLng(lWidth * -dSTheta)
.Line2.Column2 = CLng(lHeight * dCTheta)
.Line2.Column3 = lY
.Line3.Column1 = 0
.Line3.Column2 = 0
.Line3.Column3 = 1
End With
' Inject the matrix into the Transformation property
Set .Transformation = oTransform
End With
bRotate = True
Finally:
Rotate = bRotate
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Shape.Rotate
REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
, Optional ByRef Value As Variant _
) As Boolean
''' Set a new value to the given property
''' Args:
''' PropertyName: the name of the property as a string
''' Value: its new value
''' Exceptions
''' ARGUMENTERROR The property does not exist
Const cstThisSub = "SFDocuments.Shape.SetProperty"
Const cstSubArgs = "PropertyName, Value"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
SetProperty = False
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If
Try:
SetProperty = _PropertySet(PropertyName, Value)
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' SFDocuments.SF_Shape.SetProperty
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Public Function _Initialize()
''' Achieve the creation of a SF_Form instance.
''' The _Shape object (com.sun.star.drawing.XShape) must be defined before calling this routine.
' Store the initial (x, y) coordinates of the shape.
' They are needed for smooth successive rotations
If Not IsNull(_Shape) Then
With _Shape
_XPos = .Position.X
_YPos = .Position.Y
End With
End If
End Function ' SFDocuments.SF_Shape._Initialize
REM -----------------------------------------------------------------------------
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
''' Return the value of the named property
''' Args:
''' psProperty: the name of the property
Dim oRectangle As Object ' com.sun.star.awt.Rectangle
Dim cstThisSub As String
Const cstSubArgs = ""
cstThisSub = "SFDocuments.Shape.get" & psProperty
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
If Not [_Parent]._IsStillAlive() Then GoTo Finally
Select Case UCase(psProperty)
Case UCase("XRectangle")
With _Shape
Set oRectangle = New com.sun.star.awt.Rectangle
oRectangle.X = .Position.X
oRectangle.Y = .Position.Y
oRectangle.Width = .Size.Width
oRectangle.Height = .Size.Height
End With
Set _PropertyGet = oRectangle
Case UCase("XShape")
Set _PropertyGet = _Shape
Case Else
_PropertyGet = Null
End Select
Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
End Function ' SFDocuments.SF_Shape._PropertyGet
REM -----------------------------------------------------------------------------
Private Function _PropertySet(Optional ByVal psProperty As String _
, Optional ByVal pvValue As Variant _
) As Boolean
''' Set the new value of the named property
''' Args:
''' psProperty: the name of the property
''' pvValue: the new value of the given property
Dim bSet As Boolean ' Return value
Const cstShape = "com.sun.star.Shape."
Dim cstThisSub As String
Const cstSubArgs = "Value"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bSet = False
cstThisSub = "SFDocuments.Shape.set" & psProperty
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
If Not [_Parent]._IsStillAlive() Then GoTo Catch
bSet = True
Finally:
_PropertySet = bSet
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
bSet = False
GoTo Finally
End Function ' SFDocuments.SF_FormControl._PropertySet
REM -----------------------------------------------------------------------------
Private Function _Repr() As String
''' Convert the Shape instance to a readable string, typically for debugging purposes (DebugPrint ...)
''' Args:
''' Return:
''' "[Shape]: Name
_Repr = "[Shape]: " & _ShapeName
End Function ' SFDocuments.SF_Shape._Repr
REM ============================================ END OF SFDOCUMENTS.SF_SHAPE
</script:module>