Create hotspot buttons on the fly using DXL

In R6, there have been some great improvements in the accessibility of rich text fields and the various items that can exist within them (for example, tables and doc links) through LotusScript, but hotspot buttons are not one of them.

However, using DXL, you can create a hotspot button dynamically and add it to a rich text field on the fly. In this example, the user selects a number of entries from a database library, and buttons to open up each database are created in a new memo.

The code within the buttons is created when a temporary document is processed and imported, each button including the Replica ID for the individual database. The function of the buttons is not as important as the fact that each button was created from scratch.

NOTE: Similar code can be used for creating other design elements on the fly. The easiest way to learn the DXL format is to use the DXL Viewer under Tools in Designer.

Code:

(Options)
Option Public
Option Explicit

(Declarations)
' Change this to the ReplicaID of a 
valid Database Library
Const LibraryDBRepID = 
"0000000000000000"

Sub Initialize
' Purpose: Compose a memo with 
one or more buttons containing
' dynamically-created LotusScript using DXL
 
 On Error Goto ErrorHandler
 
 Dim s As New NotesSession
 Dim ws As New NotesUIWorkspace
 Dim this_db As NotesDatabase
 
 Set this_db = s.currentdatabase
 
' Open the Database Library
 Dim library_db As New NotesDatabase( "", "" )
 If library_db.OpenByReplicaID
( this_db.Server, LibraryDBRepID ) Then
  Print( library_db.Title &
 " was successfully opened" )
 Else
  Print( "Unable to open database" )
  Exit Sub
 End If
 
' Prompt user to select Database documents
 Dim db_coll As NotesDocumentCollection
 Set db_coll = ws.PickListCollection
(PICKLIST_CUSTOM, True, 
this_db.Server, _
library_db.FilePath, "Databases by _Title",_
 "Select Database(s)", "Please select 
at least one database:" )
 If db_coll.Count = 0 Then
  Messagebox "No databases selected", 0, "Error"
  Exit Sub
 End If
 
 Dim strDBRepID As String
 Dim strDBTitle As String
 Dim doc As NotesDocument
 Dim newdoc As NotesDocument
 Dim rtitem As NotesRichTextItem
 Dim nitem As NotesItem
 
' Open current user's mail file and 
create a new document
 Dim maildb As New NotesDatabase( "", "" )
 Call maildb.OpenMail
 
 Dim memodoc As 
New NotesDocument(maildb)
 memodoc.form = "Memo"
 memodoc.subject = "Database Access Email"
 
 Dim body As New NotesRichTextItem
(memodoc, "Body")
 
 Call body.AppendText
("Here are some database links:")
 Call body.AddNewLine(2)
 
' Get the first database library document
 Set doc = db_coll.GetFirstDocument
 
' Loop through all the selected documents, 
creating buttons for each
 While Not ( doc Is Nothing )
  
' Get the Replica ID of the Database
  strDBRepID = doc.ReplicaID(0)
  
' It's necessary to replace any ampersands 
in the Database Title with its
' HTML equivalent as DXL can't convert 
special characters such as &, <, and >
' < less than = <
' > greater than = >
' & ampersand = &
  strDBTitle = Replace(doc.Title(0), "&", "&")
  
  If (strDBRepID = "") Or (strDBTitle = "") Then
  Else
' Call the function to create the new 
document with the button and return the 
new document
   Set newdoc = CreateNewButton(s, ws, this_db,
strDBRepID, strDBTitle)
   
' Get the Rich Text field
   Set nitem = newdoc.GetFirstItem
( "tmpButtonBody" )
   If ( nitem.Type = RICHTEXT ) Then
    Set rtitem = nitem
' Append the newly created button
    Call body.AppendRTItem( rtitem )
   Else
' If there's a problem getting the 
Rich Text field, print to the memo
    Call body.AppendText("Error creating button.")
   End If
   
' Delete the imported document
   Call newdoc.Remove(True)
   
' Append the Database Title and Owner
   Call body.AddTab(1)
   Call body.AppendText(doc.Title(0))
   Call body.AddTab(1)
   Call body.AppendText("DB Owner: " 
+ doc.DBOwner(0))
   Call body.AddNewLine(1)
  End If
  
' Get the next document in the collection
  Set doc = db_coll.GetNextDocument (doc)
 Wend
 
' Update the Rich Text field
 Call body.Update
 
' Open the current memo in the UI
 Dim uidoc As NotesUIDocument
 Set uidoc = ws.EditDocument(True, memodoc)
 
 Exit Sub
 
ErrorHandler:
 
 Print Lsi_info(2) + " - Error #" 
& Format$(Err) & " at line " & 
Format$(Erl) & ": " & Error$
 Messagebox Lsi_info(2) + " - Error #"
 & Format$(Err) & " at line " &
Format$(Erl) & ": " & Error$, 0, "Error"
 Exit Sub
 
End Sub

Function CreateNewButton(s As 
NotesSession, ws As NotesUIWorkspace, 
this_db As
NotesDatabase, strDBRepID As String, 
strDBTitle As String) As NotesDocument
' Purpose: Build a document using DXL 
and import into the current database and
return the new document
 
 On Error Goto ErrorHandler
 
 Dim newdoc As NotesDocument
 Dim stream As NotesStream
 Dim dmp As NotesDXLImporter
 
 Set stream = s.CreateStream
 
' Build the DXL document including the 
button in the Rich Text field
 stream.WriteText {<&xml
 version='1.0' encoding='utf-8' ?>
  <database xmlns=
"http://www.lotus.com/dxl"
 version="1.01">
   <databaseinfo replicaid="} + 
this_db.ReplicaID +
{"/>
   <document form="tmpButtonProfile">
     <item name='tmpButtonBody'>
      <richtext>
       <par>

<button width="2in" widthtype="fitcontent"
 wraptext="true" bgcolor="system"
name="AccessButton"
 type="normal" default="false" edge=
"rounded" readingorder="lefttoright">
<font size="9pt" style="bold" name="Arial" 
pitch="variable" truetype="true"
familyid="20" />
<code event="options">
<lotusscript>Option
Explicit</lotusscript></code>
<code event="click"><lotusscript>
Sub Click(Source As Button)
'} + strDBTitle + { Access Button

 On Error Goto ErrorHandler

 Dim ws As New NotesUIWorkspace
 Dim session As New NotesSession
 Dim this_db As NotesDatabase
 Dim strDBRepID As String, strDBTitle
 As String, CurrentServer As String
 Dim newdb As New NotesDatabase("", "")

 Set this_db = session.CurrentDatabase
 CurrentServer = this_db.Server
 
' build internal variables from external variables
 strDBRepID = ModRepID("} + strDBRepID + {")
 strDBTitle = "} + strDBTitle + {"
 
' attempt to open database on current server
 If newdb.OpenByReplicaID
( CurrentServer, strDBRepID ) Then
  Call ws.OpenDatabase 
( CurrentServer, newdb.FilePath, "", "",
True, False )
 Else
' prompt user if unsuccessful
  Messagebox "Can't open " + 
strDBTitle + Chr(10) + " on " +
CurrentServer + _
   ".  Please contact the Help Desk."
 End If
 
 Exit Sub

ErrorHandler:

 Messagebox "Error #" + 
Format$(Err) + " at line " + Format$(Erl) + ": "
+ Error$, 0, "ERROR"
 Print "Error #" + Format$(Err) + " 
at line " + Format$(Erl) + ": " +
Error$
 Exit Sub
</lotusscript></code>
<code event="ModRepID">
<lotusscript>
Function ModRepID
(strDatabaseRepID As String) As String
' remove colon from Replica ID 
and return result

 Dim FindColon As Integer
 Dim RepIDStart As String
 Dim RepIDEnd As String

 FindColon = Instr(1, strDatabaseRepID, ":")
 If FindColon > 0 Then
  RepIDStart = Mid(strDatabaseRepID, 1, 
FindColon - 1)
  RepIDEnd = Mid(strDatabaseRepID, 
FindColon + 1)
  strDatabaseRepID = RepIDStart + 
RepIDEnd
 End If
 ModRepId = strDatabaseRepID

End Function
</lotusscript></code>Open 
Database</button>

       </par>
      </richtext>
     </item>
   </document>
  </database>}
 
' Import new document with button
 into current database
 Set dmp = s.CreateDXLImporter
(stream, this_db)
 dmp.DocumentImportOption = 
DXLIMPORTOPTION_CREATE
 dmp.Process
 
' Get the NoteID of the newly created document
 Dim tmpNoteID As String
 tmpNoteID = dmp.GetFirstImportedNoteID( )
 
' Get the document by the NoteID and return it
 Set newdoc = 
this_db.GetDocumentByID(tmpNoteID)
 If Not (newdoc Is Nothing) Then
  Set CreateNewButton = newdoc
 Else
  Messagebox "New document could
 not be found.", 0, "ERROR"
 End If
 
 Exit Function
 
ErrorHandler:
 
' If there's a problem processing the 
DXL, you will be prompted with the Row
and Column
 Msgbox dmp.Log
 
 Print Lsi_info(2) + " - Error #" & Format$(Err) 
& " at line " & 
Format$(Erl) & ": " & Error$
 Messagebox Lsi_info(2) + " - Error #" 
& Format$(Err) & " at line " &
Format$(Erl) & ": " & Error$, 0, "Error"
 Exit Function
 
End Function

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip exchange by member Bryce Berry. Please let others know how useful it is via the rating scale at the end of the tip. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.