Create hotspot buttons on the fly using DXL
Using DXL, learn how to create a hotspot button dynamically and add it to a rich text field on the fly.
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.