7,762
社区成员
发帖
与我相关
我的任务
分享请问这样的选择列表(A->B,A->>B,A<<-B,A<-B)该如何做？
我看到某产品上有个功能很实用，两个列表框，估计是DataGrid之类控件做的，因为有两列数据，点击字段名会执行排序，但它可以多选，并可从列表框A转到列表框B，两列表内容不重复。最终目的是将列表框B的值赋给另一Text控件.
这个功能也应该很常见吧，却找不到什么好方法解决，所以请大家帮帮忙，谢谢！
这个功能也应该很常见吧，却找不到什么好方法解决，所以请大家帮帮忙，谢谢！
...全文
请发表友善的回复…
发表回复
zjchao 2003-03-05
- 打赏
- 举报
我要找的就是它了，实在是太好了。
但Add key的时候总是出错，暂时用不着，不管了。还有取Dblclick item和sort order的问题，看了之前的贴子，都解决了。我的程序如下:
Private mItem As ListItem
Dim myItem As MSComctlLib.ListItem
Private Sub Form_Load()
Dim txtSQL As String
Dim MsgText As String
lvwDB.View = lvwReport
lvwDB.MultiSelect = True
lvwDB.FullRowSelect = True
lvwDB.Checkboxes = True
lvwDB.GridLines = True
lvwDBto.View = lvwReport
lvwDBto.MultiSelect = True
lvwDBto.FullRowSelect = True
lvwDBto.Checkboxes = True
lvwDBto.GridLines = True
Call MakeColumns
lvwDB.ListItems.Clear
lvwDBto.ListItems.Clear
txtSQL = "select cu_code as 编号,cu_name as 名称 from Cu_customer"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Do Until mrc.EOF
Set mItem = lvwDB.ListItems.Add()
' mItem.Key = CStr(mrc!编号)
mItem.Text = CStr(mrc!编号)
mItem.SubItems(1) = CStr(mrc!名称)
mrc.MoveNext
Loop
End Sub
Private Sub MakeColumns()
lvwDB.ColumnHeaders.Clear
lvwDB.ColumnHeaders.Add , , "编号", lvwDB.Width / 3
lvwDB.ColumnHeaders.Add , , "名称", (lvwDB.Width / 3) * 2
lvwDBto.ColumnHeaders.Clear
lvwDBto.ColumnHeaders.Add , , "编号", lvwDB.Width / 3
lvwDBto.ColumnHeaders.Add , , "名称", (lvwDB.Width / 3) * 2
End Sub
'>键
Private Sub LtoR_Click()
Dim i As Integer
For i = lvwDB.ListItems.Count To 1 Step -1
If lvwDB.ListItems.Item(i).Selected = True Or lvwDB.ListItems.Item(i).Checked = True Then
moveItem i, 1
End If
Next
End Sub
Private Sub lvwDB_DblClick()
moveItem myItem.Index, 1
End Sub
Private Sub lvwDB_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set myItem = Item
End Sub
Private Sub lvwDBto_DblClick()
moveItem myItem.Index, 2
End Sub
Private Sub lvwDBto_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set myItem = Item
End Sub
'>>键
Private Sub LtoRall_Click()
Dim i As Integer
For i = lvwDB.ListItems.Count To 1 Step -1
moveItem i, 1
Next
End Sub
'<键
Private Sub RtoL_Click()
Dim i As Integer
For i = lvwDBto.ListItems.Count To 1 Step -1
If lvwDBto.ListItems.Item(i).Selected = True Or lvwDBto.ListItems.Item(i).Checked = True Then
moveItem i, 2
End If
Next
End Sub
'<<键
Private Sub RtoLall_Click()
Dim i As Integer
For i = lvwDBto.ListItems.Count To 1 Step -1
moveItem i, 2
Next
End Sub
Private Sub moveItem(PID As Integer, Flag As Integer)
If Flag = 1 Then
Set mItem = lvwDBto.ListItems.Add()
mItem.Text = lvwDB.ListItems(PID).Text
mItem.SubItems(1) = lvwDB.ListItems.Item(PID).ListSubItems(1).Text
lvwDB.ListItems.Remove PID
End If
If Flag = 2 Then
Set mItem = lvwDB.ListItems.Add()
mItem.Text = lvwDBto.ListItems(PID).Text
mItem.SubItems(1) = lvwDBto.ListItems.Item(PID).ListSubItems(1).Text
lvwDBto.ListItems.Remove PID
End If
End Sub
'排序
Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim lngCnt As Long
On Error GoTo lvwDB_ColumnClickErr
lvwDB.SortKey = ColumnHeader.Index - 1
lngCnt = ColumnHeader.Index - 1
If lvwDB.SortOrder = lvwDescending Then
lvwDB.SortOrder = lvwAscending
Else
lvwDB.SortOrder = lvwDescending
End If
lvwDB.Sorted = True
Exit_Proc:
Exit Sub
lvwDB_ColumnClickErr:
Resume Exit_Proc
End Sub
Private Sub lvwDBto_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim lngCnt As Long
On Error GoTo lvwDBto_ColumnClickErr
lvwDBto.SortKey = ColumnHeader.Index - 1
lngCnt = ColumnHeader.Index - 1
If lvwDBto.SortOrder = lvwDescending Then
lvwDBto.SortOrder = lvwAscending
Else
lvwDBto.SortOrder = lvwDescending
End If
lvwDBto.Sorted = True
Exit_Proc:
Exit Sub
lvwDBto_ColumnClickErr:
Resume Exit_Proc
End Sub
但Add key的时候总是出错，暂时用不着，不管了。还有取Dblclick item和sort order的问题，看了之前的贴子，都解决了。我的程序如下:
Private mItem As ListItem
Dim myItem As MSComctlLib.ListItem
Private Sub Form_Load()
Dim txtSQL As String
Dim MsgText As String
lvwDB.View = lvwReport
lvwDB.MultiSelect = True
lvwDB.FullRowSelect = True
lvwDB.Checkboxes = True
lvwDB.GridLines = True
lvwDBto.View = lvwReport
lvwDBto.MultiSelect = True
lvwDBto.FullRowSelect = True
lvwDBto.Checkboxes = True
lvwDBto.GridLines = True
Call MakeColumns
lvwDB.ListItems.Clear
lvwDBto.ListItems.Clear
txtSQL = "select cu_code as 编号,cu_name as 名称 from Cu_customer"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Do Until mrc.EOF
Set mItem = lvwDB.ListItems.Add()
' mItem.Key = CStr(mrc!编号)
mItem.Text = CStr(mrc!编号)
mItem.SubItems(1) = CStr(mrc!名称)
mrc.MoveNext
Loop
End Sub
Private Sub MakeColumns()
lvwDB.ColumnHeaders.Clear
lvwDB.ColumnHeaders.Add , , "编号", lvwDB.Width / 3
lvwDB.ColumnHeaders.Add , , "名称", (lvwDB.Width / 3) * 2
lvwDBto.ColumnHeaders.Clear
lvwDBto.ColumnHeaders.Add , , "编号", lvwDB.Width / 3
lvwDBto.ColumnHeaders.Add , , "名称", (lvwDB.Width / 3) * 2
End Sub
'>键
Private Sub LtoR_Click()
Dim i As Integer
For i = lvwDB.ListItems.Count To 1 Step -1
If lvwDB.ListItems.Item(i).Selected = True Or lvwDB.ListItems.Item(i).Checked = True Then
moveItem i, 1
End If
Next
End Sub
Private Sub lvwDB_DblClick()
moveItem myItem.Index, 1
End Sub
Private Sub lvwDB_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set myItem = Item
End Sub
Private Sub lvwDBto_DblClick()
moveItem myItem.Index, 2
End Sub
Private Sub lvwDBto_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set myItem = Item
End Sub
'>>键
Private Sub LtoRall_Click()
Dim i As Integer
For i = lvwDB.ListItems.Count To 1 Step -1
moveItem i, 1
Next
End Sub
'<键
Private Sub RtoL_Click()
Dim i As Integer
For i = lvwDBto.ListItems.Count To 1 Step -1
If lvwDBto.ListItems.Item(i).Selected = True Or lvwDBto.ListItems.Item(i).Checked = True Then
moveItem i, 2
End If
Next
End Sub
'<<键
Private Sub RtoLall_Click()
Dim i As Integer
For i = lvwDBto.ListItems.Count To 1 Step -1
moveItem i, 2
Next
End Sub
Private Sub moveItem(PID As Integer, Flag As Integer)
If Flag = 1 Then
Set mItem = lvwDBto.ListItems.Add()
mItem.Text = lvwDB.ListItems(PID).Text
mItem.SubItems(1) = lvwDB.ListItems.Item(PID).ListSubItems(1).Text
lvwDB.ListItems.Remove PID
End If
If Flag = 2 Then
Set mItem = lvwDB.ListItems.Add()
mItem.Text = lvwDBto.ListItems(PID).Text
mItem.SubItems(1) = lvwDBto.ListItems.Item(PID).ListSubItems(1).Text
lvwDBto.ListItems.Remove PID
End If
End Sub
'排序
Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim lngCnt As Long
On Error GoTo lvwDB_ColumnClickErr
lvwDB.SortKey = ColumnHeader.Index - 1
lngCnt = ColumnHeader.Index - 1
If lvwDB.SortOrder = lvwDescending Then
lvwDB.SortOrder = lvwAscending
Else
lvwDB.SortOrder = lvwDescending
End If
lvwDB.Sorted = True
Exit_Proc:
Exit Sub
lvwDB_ColumnClickErr:
Resume Exit_Proc
End Sub
Private Sub lvwDBto_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim lngCnt As Long
On Error GoTo lvwDBto_ColumnClickErr
lvwDBto.SortKey = ColumnHeader.Index - 1
lngCnt = ColumnHeader.Index - 1
If lvwDBto.SortOrder = lvwDescending Then
lvwDBto.SortOrder = lvwAscending
Else
lvwDBto.SortOrder = lvwDescending
End If
lvwDBto.Sorted = True
Exit_Proc:
Exit Sub
lvwDBto_ColumnClickErr:
Resume Exit_Proc
End Sub
northwolves 2003-03-04
- 打赏
- 举报
try:
listview
listview
zjchao 2003-03-04
- 打赏
- 举报
OK了，用MSHFlexGrid做
但也要考虑到很多问题，麻烦
但也要考虑到很多问题，麻烦
chanet 2003-03-01
- 打赏
- 举报
UP
zjchao 2003-03-01
- 打赏
- 举报
Thanks!
可ListBox只实现部分的功能，
我说的那个效果有如 ListBox+DataGrid，即一个列表框内可有多栏内容，如：
--------------
编号 | 名称 |
--------------
1 | A |
--------------
2 | B |
--------------
可ListBox只实现部分的功能，
我说的那个效果有如 ListBox+DataGrid，即一个列表框内可有多栏内容，如：
--------------
编号 | 名称 |
--------------
1 | A |
--------------
2 | B |
--------------
Girl1983 2003-03-01
- 打赏
- 举报
c:\Program Files\Microsoft Visual Studio\VB98\Template\Controls\移动钮列表框.frm
Girl1983 2003-03-01
- 打赏
- 举报
Private Sub cmdUp_Click()
On Error Resume Next
Dim nItem As Integer
With lstSelected
If .ListIndex < 0 Then Exit Sub
nItem = .ListIndex
If nItem = 0 Then Exit Sub '不能将第一个项目向上移动
'向上移动项目
.AddItem .Text, nItem - 1
'删除旧的项目
.RemoveItem nItem + 1
'选择刚刚被移动的项目
.Selected(nItem - 1) = True
End With
End Sub
Private Sub cmdDown_Click()
On Error Resume Next
Dim nItem As Integer
With lstSelected
If .ListIndex < 0 Then Exit Sub
nItem = .ListIndex
If nItem = .ListCount - 1 Then Exit Sub '不能将最后的项目向下移动
'向下移动项目
.AddItem .Text, nItem + 2
'删除旧的项目
.RemoveItem nItem
'选择刚刚被移动的项目
.Selected(nItem + 1) = True
End With
End Sub
Private Sub cmdRightOne_Click()
On Error Resume Next
Dim i As Integer
If lstAll.ListCount = 0 Then Exit Sub
lstSelected.AddItem lstAll.Text
i = lstAll.ListIndex
lstAll.RemoveItem lstAll.ListIndex
If lstAll.ListCount > 0 Then
If i > lstAll.ListCount - 1 Then
lstAll.ListIndex = i - 1
Else
lstAll.ListIndex = i
End If
End If
lstSelected.ListIndex = lstSelected.NewIndex
End Sub
Private Sub cmdRightAll_Click()
On Error Resume Next
Dim i As Integer
For i = 0 To lstAll.ListCount - 1
lstSelected.AddItem lstAll.List(i)
Next
lstAll.Clear
lstSelected.ListIndex = 0
End Sub
Private Sub cmdLeftOne_Click()
On Error Resume Next
Dim i As Integer
If lstSelected.ListCount = 0 Then Exit Sub
lstAll.AddItem lstSelected.Text
i = lstSelected.ListIndex
lstSelected.RemoveItem i
lstAll.ListIndex = lstAll.NewIndex
If lstSelected.ListCount > 0 Then
If i > lstSelected.ListCount - 1 Then
lstSelected.ListIndex = i - 1
Else
lstSelected.ListIndex = i
End If
End If
End Sub
Private Sub cmdLeftAll_Click()
On Error Resume Next
Dim i As Integer
For i = 0 To lstSelected.ListCount - 1
lstAll.AddItem lstSelected.List(i)
Next
lstSelected.Clear
lstAll.ListIndex = lstAll.NewIndex
End Sub
Private Sub Form_Load()
lstAll.AddItem "aaa"
lstAll.AddItem "bbb"
lstAll.AddItem "ccc"
lstAll.ListIndex = 0
End Sub
Private Sub lstAll_DblClick()
cmdRightOne_Click
End Sub
Private Sub lstSelected_DblClick()
cmdLeftOne_Click
End Sub
