Apache OpenOffice Community Forum

Code: Select all

REM ****************************************************************************
REM *** Class Cell Annotations
REM ***
REM *** Purpose: (a) Creates comments in a selected CALC cell 
REM ***          (b) deletes a comment from selected CALC cell
REM ***
REM *** Parent Class: PracticeTime
REM *** Child Class(es): N/A
REM ***
REM ****************************************************************************

Option Compatible
Option ClassModule

Option Explicit


REM ============================================================================
REM === Private variables

private _AnnotationText as string


REM ============================================================================
REM === Constructor & Destructor
REM ===

private sub Class_Initialize()
	_AnnotationText = getCellComment()
end sub

private sub Class_Terminate()
	_AnnotationText = ""
end sub


REM ============================================================================
REM === Set private variables

Public Property Let AnnotationText (ByVal pValue As String)
   _AnnotationText = pValue
End Property


REM ============================================================================
REM === Get private variables

Public Property Get AnnotationText As String
   AnnotationText = _AnnotationText
End Property


REM ============================================================================
REM ===  Public  Methods
REM ===

REM ----------------------------------------------------------------------
REM --- Set text, shape, transparency and color of _Annotation (comment)
REM ---   for a selected cell
REM --- Project# P002m
REM ---
public Sub setCellComment
	
	dim oDoc,oSheet,oCell,oCellAddr,oAnnotations,_
		oAnnotation,oAnnotationShape as object
	dim lenComment,widthBox as integer
	
	oDoc = ThisComponent  
	oSheet= oDoc.getcurrentcontroller.activesheet 
	oCell = oDoc.getCurrentSelection

	lenComment = len( _AnnotationText )
	
	if lenComment > 0 then
	
		select case lenComment
			case > 501:
				widthBox = 12000
			case 251 to 500:
				widthBox = 10000
			case 101 to 250:
				widthBox = 8000
			case 51 to 100:
				widthBox = 6000
			case 0 to 50:
				widthBox = 4000
		end select
		
		oCellAddr = oCell.getCellAddress
		oAnnotations = oSheet.getAnnotations
		
		'/Create a new _Annotation to the active cell
		oAnnotations.insertNew(oCellAddr, _AnnotationText)
		
		'/Get the newly created _Annotation for modify properties
		oAnnotation = oCell.getAnnotation
		
		'/Set it "allways visible":
		oAnnotation.setIsVisible false

		'/Set color, transparence, fill style, inner margin
		oAnnotationShape = oAnnotation.getAnnotationShape
		oAnnotationShape.FillBackground = True
		oAnnotationShape.FillColor = RGB(251, 246, 99)
		oAnnotationShape.FillStyle = 1 '(0: nothing; 1: solid color; 2: gradient; 3: lined)
		oAnnotationShape.FillTransparence = 15
		
		oAnnotationShape.TextLeftDistance  = 200
		oAnnotationShape.TextLowerDistance = 200
		oAnnotationShape.TextRightDistance = 200
		oAnnotationShape.TextUpperDistance = 200
		
		'/Set size of the _Annotation
		Dim aSize As New com.sun.star.awt.Size
		asize.Height = 1000
		asize.Width  = widthBox
		oAnnotationShape.Size = asize
		oAnnotationShape.SizeProtect = False
		
		'/Set absolute position of the _Annotation
		'Dim apoint As New com.sun.star.awt.Point
		'apoint.x = 1000
		'apoint.y = 1000
		
		'oAnnotationShape.setPosition apoint 
	else
		deleteComments
	end if

End Sub


REM ============================================================================
REM ===  Private  Methods
REM ===

REM ----------------------------------------------------------------------
REM --- Read the _Annotation from selected cell
REM ---
private function getCellComment()
	getCellComment = ThisComponent.getCurrentSelection().getAnnotation().string
end function

private sub deleteComments
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "Flags"
	args1(0).Value = "N"
	dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args1())
end sub