Source code download: http://blog.blogchina.com/upload/2004-12-07/20041207171618774482.rar2002, because of a large number of lists to choose data, then a module. After so many years of testing, it is absolutely stable and fast. Provide single item functions: cmddel_clickcmdadd_click multi ITEM function: cmddeLall_Clickcmdaddall_click ----------------------------------------- -------------------------------------------------- ---------------------------- 'Option Explicit
'Author: Nyb'time: 2002-04-05' Incoming List1, List2, then we can process the Item in List1, and List2. '* All Areas of code Where modifications Are Necessary' * To Integrate this Object with A Project Are Documented'with Comments Denoted by Note:. '* to locate these Comments, search for' * Note ::. '********************************** *********************************************************** *****************
Public SUB CMDDELALL_CLICK (List1 as listbox, list2 as listbox) '<<' * purpose: delete all list2.Item '* accept: list1 is useless, List2 processing object for i = (list2.listcount - 1) to 0 step -1 List2.RemoveItem i Next iEnd SubPublic Sub CmdAdd2To1_Click (List1 As ListBox, List2 As ListBox, list3 As ListBox) '>>' * purpose: all item of list1 and list2 are inputed to list3 '* Accept: list1, list2 For i = 0 To (List1.ListCount - 1) list3.additem list1.list (i) Next I for i = 0 to (list2.listcount - 1) list3.additem list2.list (i) Next IEND SUB
Public Sub cmdAddAll_Click (List1 As ListBox, List2 As ListBox, Index As Integer) '>>' * purpose: add all item of list1 inputed to list2.if item had been there, It will not be inputed '* Accept: list1, List2 if list2.listcount = 0 Then for i = 0 TO (list1.listcount - 1) list2.additem list1.list (i) Next I else for i = 0 to (list1.listcount - 1) flag = checkselected (List1, List2, list1.list (i)) f f = "notbe" the list2.additem list1.list (i) Next I end iFend Subpublic Sub cmddel_click (listbox) '<---' * purpose: THE SELECTED ITEMS OF LIST2 Are Cleared '* Accept: List1 No, List2 Processing Object DIM I AS Integer if List2.Selcount> 0 Then for i = (List2.ListCount - 1) TO 0 Step -1 if List2.selected (i = True Then List2.removeItem i Next I end ingnd sub
Public Sub cmdadd_Click (List1 As ListBox, List2 As ListBox, Index As Integer) '--->' * purpose: the selected items of list1 is inputed into list2 'list2 is empty, List2 and can be selected, then the items selected in list1 Are INPUTED TO LIST2 'LIST2 is not empty, List2 can be selected, then check if Item is in List2, if, then do not add List2' List2 set to radio, then List2 only adds the number in List1 One choice item '* accept: list1 selected item, List2 is the ListBox Dim I as Integer Dim Flag As String if Indeter Dim Flag As String if INDEGER DIM FLAG AS STRING INDEX> 0 THEN if List2.ListCount> = 1 Then IF INDEX = 2 Then if list2.listcount> = 2 Then if list1.multiselect = 0 THEN MSGBOX "You can only select two comparisons!", Vbexclamation, "Operating tips!" EXIT SUB END IF END IF END IF END IF LIST2.ListCount = 0 and list2.MultiSelect = 2 THEN for i = 0 to (list1.listcount - 1) if list1.selected (i) = true dam2.additem list1.list (i) Next I elseif list2.listcount > 0 and list2.multiselect = 2 Then for i = 0 to (list1.listcount - 1) Flag = Checkselected (List1, list2, list1.list (i)) if list1.selected (i) = true and flag = "NOTBE "THEN LIST2.ADDITEM LIST1.LIST (i) Next I elseif list2.multiselect = 0 Then Call cmddeLall_Click (List1, list2) for i = 0 to (list1.listcount - 1) if list1.selected (i) = true kil1n List2 .Additem list1.list (i) Next I end if call clearslect (list1) End Sub
Private Function Checkselected (List1 As ListBox, List2 As ListBox, CityItem As String) AS String '* purpose:' Check that Item has been added, then checkselected = "be" '* accept: list1 selected item, List2 is to Joined listbox, cityitem is a selected item in List1 '* feedback: checkselected, "be" means that this item is for i = (list2.listcount - 1) to 0 step2 = limited = list2.list (i) Then CheckSelected = "be" Exit For Else: CheckSelected = "notbe" End If Next iEnd FunctionPrivate Sub ClearSelect (List1) '* purpose: Clear List1's selected' * Accept: list1, the list box to clear selected For i = 0 to list1.listcount - 1 if List1.selected (i) = true dam1.selected (i) = false end if Next IEND SUB
