'RichTextButton Class: 

Option Public
Option Explicit


'** possible languages we can use with SetButtonLanguage
Const RTB_LOTUSSCRIPT = 1
Const RTB_FORMULA = 2

'** possible types we can use with SetEdgeType
Const RTB_SQUARE = 1
Const RTB_ROUNDED = 2


Class RichTextButton
	'** This class makes it easy to create a button that can be appended
	'** to a NotesRichTextField. Here's an example of use:
	
	'** Dim rtbutton As New RichTextButton
	'** Call rtbutton.SetLabel("Formula Button")
	'** Call rtbutton.SetButtonLanguage(RTB_FORMULA)
	'** Call rtbutton.SetCode( |@Prompt([ok]; "My Button"; "You clicked my button");| )
	'** Set rtitem = doc.GetFirstItem("Body")
	'** Call rtbutton.AppendButton(rtitem)
	
	'** version 1.2
	'** September 2, 2005
	'** Julian Robichaux -- http://www.nsftools.com
	Private label As String
	Private edgeType As Integer
	Private buttonLanguage As Integer
	Private code As String
	
	Public Sub New ()
		label = "Button"
		edgeType = RTB_ROUNDED
		buttonLanguage = RTB_LOTUSSCRIPT
	End Sub
	
	Public Sub SetLabel (labelText As String)
		label = labelText
	End Sub
	
	Public Sub SetEdgeType (edgeType As Integer)
		Me.edgeType = edgeType
	End Sub
	
	Public Sub SetButtonLanguage (buttonLanguage As Integer)
		Me.buttonLanguage = buttonLanguage
	End Sub
	
	Public Sub SetCode (code As String)
		Me.code = code
	End Sub
	
	Public Function XmlConvert (txt As String) As String
		'** get rid of the text characters that XML doesn't like (accented
		'** characters are usually okay, as long as you use an encoding
		'** like ISO-8859-1
		XmlConvert = txt
		XmlConvert = Replace(XmlConvert, "&", "&")
		XmlConvert = Replace(XmlConvert, "<", "&lt;")
		XmlConvert = Replace(XmlConvert, ">", "&gt;")
	End Function
	
	Function AppendButton (rtitem As NotesRichTextItem) As String
		'** This function will attempt to append a button to a given
		'** NotesRichTextItem, using code that has been assigned
		'** to this object after it has been created (using the SetCode
		'** method). The code language (as set with the SetLanguageType
		'** method) can be either LotusScript or Formula language.
		
		'** If there is an error creating the button (often because the code
		'** doesn't compile correctly), this function will return the error
		'** message. If the button is created properly, an empty string
		'** will be returned.
		On Error Goto processError
		
		'** if no rich text item was given to us, just exit without doing anything
		If (rtitem Is Nothing) Then
			Exit Function
		End If
		
		Dim session As New NotesSession
		Dim db As NotesDatabase
		Dim doc As NotesDocument
		Dim body As NotesRichTextItem
		Dim importer As NotesDXLImporter
		
		Dim buttonCode As String
		Dim buttonTag As String
		Dim dxl As String
		
		'** set up the DXL to be used for the code in the button
		If (buttonLanguage = RTB_LOTUSSCRIPT) Then
			buttonCode = |<lotusscript>Sub Click(Source As Button)
| & XmlConvert(code) & |
End Sub</lotusscript>|
		Else
			buttonCode = |<formula>| & XmlConvert(code) & |</formula>|
		End If
		
		buttonTag = |<button width='2in' widthtype='fitcontent' wraptext='true' |
		If (edgeType = RTB_SQUARE) Then
			buttonTag = buttonTag & | edge='square' |
		Else
			buttonTag = buttonTag & | edge='rounded' |
		End If
		buttonTag = buttonTag & | bgcolor='system'>|
		
		'** DXL that will create a temporary doc with the button we want.
		'** We're adding the current user name in an Author field on
		'** this temporary document because we'll be deleting it at the end
		'** of this function, and the user may only have Author access to
		'** this database.
		dxl = |<?xml version='1.0' encoding='ISO-8859-1'?>
		<!DOCTYPE document SYSTEM 'xmlschemas/domino_6_5.dtd'>
<document xmlns='http://www.lotus.com/dxl' version='6.5' 
 replicaid='0123456789ABCDEF' form='ButtonMaker'>
<item name='DocAuthor' authors='true' names='true'>
<text>| & XmlConvert(session.CommonUserName) & |</text></item>
		<item name='Body'><richtext>
<pardef id='1'/>
<par def='1'>
| & buttonTag & XmlConvert(label) & |
<code event='click'>| & buttonCode & |</code></button></par></richtext>
		</item>
</document>|
		
		'** create a new doc using the DXL above
		Set db = session.CurrentDatabase
		Set importer = session.CreateDXLImporter(dxl, db)
		importer.ReplicaRequiredForReplaceOrUpdate = False
		importer.DocumentImportOption = DXLIMPORTOPTION_CREATE
		Call importer.Process
		
		'** get the button from the doc we just created and append it to
		'** the rich text item we were given
		Set doc = db.GetDocumentByID(importer.GetFirstImportedNoteId)
		Set body = doc.GetFirstItem("Body")
		Call rtitem.AppendRTItem(body)
		
		'** try to delete the temporary doc. In case we can't delete it for some 
		'** reason, a scheduled agent should be written to globally delete
		'** docs that use the form name specified in the DXL above.
		On Error Resume Next
		Call doc.RemovePermanently(True)
		
		Exit Function
		
		
processError:
		If (importer.Log <> "") Then
			AppendButton = importer.Log
		Else
			AppendButton = "Error " & Err & " on line " & Erl & ": " & Error$
		End If
		Exit Function
	End Function
	
	
End Class




Sub Initialize
%REM
	'** here's an example of how to call the class
	Dim session As New NotesSession
	Dim doc As NotesDocument
	Dim rtitem As NotesRichTextItem
	Dim button1 As New RichTextButton
	Dim button2 As New RichTextButton
	Dim result As String
	
	'** grab the first selected doc in the view
	Set doc = session.CurrentDatabase.UnprocessedDocuments.GetFirstDocument
	Set rtitem = doc.GetFirstItem("Body")
	If (rtitem Is Nothing) Then
		Set rtitem = New NotesRichTextItem(doc, "Body")
	End If
	
	'** append a LotusScript button to the body
	Call button1.SetLabel("LotusScript Button & Stuff")
	Call button1.SetButtonLanguage(RTB_LOTUSSCRIPT)
	Call button1.SetCode( |
Use "SomeLibrary"
Messagebox "This is my <button>. " & "Don't wear it out."
| )
	Call rtitem.AddNewline(1)
	result = button1.AppendButton(rtitem)
	If (result <> "") Then
		Call rtitem.AppendText("There was an error creating the button. " & result)
	End If
	
	'** append a Formula button to the body
	Call button2.SetLabel("Formula Button")
	Call button2.SetEdgeType(RTB_SQUARE)
	Call button2.SetButtonLanguage(RTB_FORMULA)
	Call button2.SetCode( |@Prompt([ok]; "My Button"; "You clicked my button");| )
	Call rtitem.AddNewline(1)
	result = button2.AppendButton(rtitem)
	If (result <> "") Then
		Call rtitem.AppendText("There was an error creating the button. " & result)
	End If
	
	'** save and exit
	Call doc.Save(True, True)
%END REM
	
End Sub