 |
 |
 | |
 | |
 | |
 |
|
|
| |
| |
| |
|
Last updated: 24 Sep 2010
This script comes care of Paul Bent at XpertSS.com. He has kindly provided use with an example .apr (http://www.johnbrown.com.au/approach/LBoxes.exe ) containing the script so that you can see it in action (41k self-extracting archive. Just download and execute it. The default unzip directory is c:\lotus\approach\demo).
Paul explains:
<Blockquote>
This shows how to design a control using two list boxes and use LotusScript to pop selections from one list and push them into the other list.
I created the control using a dialog form. On the form I added two unbound fields, made them List Boxes then resized them vertically so they will display the full list without a scroll bar. When I changed them to List Boxes I just typed a z as the list item because an empty list isn't allowed by the Info Box. In this example the list box objects are named UpdList and SelList. UpdList contains the items available for selection and SelList contains items that have been selected already.
In a real application I would set the UpdList from a script attached to the dialog form's Switchto event. For this demo you could type in the UpdList items using the Info Box - Apple, Banana, Cherry, Orange, Pear and Peach would do fine.
Placed between the two list boxes are four command buttons:
Select One >>
<< Remove One
Select All >>
<< Remove All
Once the selections have been made you would have a "Done" button that runs
a script to read the selections from SelList and batch processes them as
required.
The following global subs are called from the click events of the
respective buttons. The public sub, StrSort, bubble sorts arrays containing the list items.
</Blockquote>
Public Sub AddAll 'Pops all items from lbxUpdList and pushes them into lbxSelList Dim aUpdList() As String Dim RV As Integer, UB As Integer, NB As Integer, C1 As Integer, CurItem As String, CurTag As Integer On Error Goto ErrTrap 'Exit if no items in the list If CurrentView.Body.lbxUpdList.Count = 0 Then Goto ExitSub 'Store the updates list items CurrentView.Body.lbxUpdList.SetFocus UB = CurrentView.Body.lbxUpdList.Count - 1 Redim aUpdList(UB) For C1 = 0 To UB CurrentView.Body.lbxUpdList.CurrentSelection = C1 aUpdList(C1) = CurrentView.Body.lbxUpdList.Text Next 'Pop the items from the updates list For C1 = 0 To UB CurrentView.Body.lbxUpdList.RemoveListItem(0) Next 'If there are already items in the selected list then add them to the array If CurrentView.Body.lbxSelList.Count > 0 Then CurrentView.Body.lbxSelList.SetFocus NB = CurrentView.Body.lbxSelList.Count UB = Ubound(aUpdList) Redim Preserve aUpdList(UB + NB) For C1 = 0 To NB - 1 CurrentView.Body.lbxSelList.CurrentSelection = C1 aUpdList(C1 + UB + 1) = CurrentView.Body.lbxSelList.Text Next End If 'Push the items into the selected list Call StrSort(aUpdList) RV = CurrentView.Body.lbxSelList.SetList(aUpdList) 'Make sure there is a selected item in the selected list CurrentView.Body.lbxSelList.SetFocus CurrentView.Body.lbxSelList.Text = aUpdList(0) Goto ExitSub ErrTrap: Msgbox "Error " & Str$(Err) & " - message: " & Error$, 16, "System Error" Resume ExitSub ExitSub: Exit Sub End Sub