求自定义选项(从左边list移动到右边list)的思路

Question

可能说得不清楚,
就是类似 IE 自定义工具栏时,可以从左边列表中选中一个项,点"添加"后就可以移到右边列表,我试着用 ListView 控件(没用过这个东东), 遇到以下问题:     1. ListView 显示如何控制它只显示一列从上到下显示
     2. 移到右边的项目我如何得到各个项目的顺序(行序)?  Index 吗? 左边右边,都乱套了
     3. 右边项目如何改变顺序?

Answer 1

将View设为lvwList(列表形式)就OK了.

Answer 2

Dim ItemX As ListItem
Private Sub Command1_Click()
ListView1.ColumnHeaders.Clear '清除列标题
ListView1.ListItems.Clear
ListView1.View = lvwList
ListView1.SmallIcons = ImageList1
Set ItemX = ListView1.ListItems.Add(, , "第一个项目", , 1)
Set ItemX = ListView1.ListItems.Add(, , "第二个项目", , 2)
Set ItemX = ListView1.ListItems.Add(, , "第三个项目", , 3)
Set ItemX = ListView1.ListItems.Add(, , "第四个项目", , 4)
Set ItemX = ListView1.ListItems.Add(, , "第五个项目", , 5)
Set ItemX = ListView1.ListItems.Add(, , "第6个项", , 6)
End Sub'后面那个数字就是图片索引.你要加一个ImageList1控件,加几个图片.

Answer 3

由于项目比较多 lvwList 的话还是会分为两列来显示,只显示 listView 下面横向的滚动条

Answer 4

1. ListView 显示如何控制它只显示一列从上到下显示
//将View属性设为lvwList(列表形式)就OK了
2. 移到右边的项目我如何得到各个项目的顺序(行序)?  Index 吗? 左边右边,都乱套了
//其实ListView有一个ListItems集全,每个Item就是一个ListItem,它有你需要的所有功能.
LVW.ListItems(i),这个i就是你要的顺序了.
3. 右边项目如何改变顺序?
//            '向已处理列表添加数据
                Set yItem = LVY.ListItems.Add()
                yItem.Text = myItem.Text
                yItem.SubItems(1) = myItem.SubItems(1)
                yItem.SubItems(2) = myItem.SubItems(2)
                yItem.SubItems(3) = myItem.SubItems(3)
                yItem.SubItems(4) = myItem.SubItems(4)
                yItem.SubItems(5) = myItem.SubItems(5)
就是让Set yItem = LVY.ListItems.Add()
然后设定Yitem的属性.你要改变顺序就只能用一个中间的临时的ListItem对象,然后互调两个ListItem.

Answer 5

给你一段我用于盘点时候的代码.给你看一下关于ListView的代码:
我的窗体中一共两个ListView,一个用于显示,且是要用户进行Check的,就是第一列显示CheckBox
另一个用于将第一个ListView处理过的,显示到它中.
通用-声明中
Dim Rst As New ADODB.Recordset
Dim ColHeader As ColumnHeader   'ListView的表头对象
Dim myItem As ListItem
Dim yItem As ListItem           '用于已处理ListView的Item
Dim myOperation As New clsOperation         '我自已的自定义量,可以删掉
Dim myDataprocess As New clsDataProcess     '我自已的自定义量,可以删掉
'-------------------------------------定义表头---------------------------
Private Sub SetGridStyle()
    Dim sTmp As String
    sTmp = "商品编号|商品名称|盘点数量|库存数量|盘亏|盘盈|货位|货位描述|生成人|执行人|盘点日期"
    Dim aTmp() As String
    aTmp = Split(sTmp, "|")
    LVW.ColumnHeaders.Clear
    Dim i As Integer
    For i = 0 To UBound(aTmp)
        If i = 0 Then
            LVW.ColumnHeaders.Add , , aTmp(i), LVW.width / UBound(aTmp), lvwColumnLeft
        Else
            LVW.ColumnHeaders.Add , , aTmp(i), LVW.width / UBound(aTmp), lvwColumnCenter
        End If
    Next
    sTmp = "商品编号|商品名称|盘点数量|库存数量|盘亏|盘盈|状态|货位|货位描述|生成人|执行人|盘点日期"
    aTmp = Split(sTmp, "|")
    LVY.ColumnHeaders.Clear
    For i = 0 To UBound(aTmp)
        If i = 0 Then
            LVY.ColumnHeaders.Add , , aTmp(i), LVY.width / UBound(aTmp), lvwColumnLeft
        Else
             LVY.ColumnHeaders.Add , , aTmp(i), LVY.width / UBound(aTmp), lvwColumnCenter
        End If
    Next
End Sub
'----------------------------------------加载数据---------------------------------
Private Function LoadData() As Boolean
    LoadData = False
    On Error GoTo errHandle:
    LVW.ListItems.Clear
    If myOperation.GetCheckGoodsData(CInt(OC), Rst) = False Then
        MsgBox "装载盘点数据出错!", vbOKOnly + vbInformation, "错误"
        Exit Function
    End If
    If Rst.EOF = True Then Exit Function
    Rst.MoveFirst
    Do While Not Rst.EOF
        Set myItem = LVW.ListItems.Add(, "N" + Rst!Goods_ID, Rst!Goods_ID)
        myItem.Tag = CStr(Rst!plan_id) + "|" & CStr(Rst!rec_id) & "|" & _
                    checkNull(Rst!rec_oper) & "|" & checkNull(Rst!plan_oper)     '用Tag保存主表及自身ID,盘点生成人,盘点执行人ID号
        myItem.SubItems(1) = checkNull(Rst!Goods_name)
        myItem.SubItems(2) = checkNull(Rst!checknum)
        myItem.SubItems(3) = checkNull(Rst!store_num)
        myItem.SubItems(4) = checkNull(Rst!CheckLess)
        myItem.SubItems(5) = checkNull(Rst!CheckMore)
        myItem.SubItems(6) = checkNull(Rst!Lctn_ID)
        myItem.SubItems(7) = checkNull(Rst!des)
        myItem.SubItems(8) = checkNull(Rst!rec_opername)
        myItem.SubItems(9) = checkNull(Rst!plan_opername)
        myItem.SubItems(10) = checkNull(Rst!rec_date)
        Rst.MoveNext
    Loop
    Exit Function
errHandle:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
    LoadData = False
End Function
'--------------------------遍历第一个ListView,查找所有选中的ListItem项,然后处理盘亏等,再将处理过的加到第二个ListView中,这段代码比较长,你参考一下吧.我就不删了.
Public Function CheckManage() As Boolean
    Dim ok As Boolean
    Dim sTmpA As String     '保存此次入库单编号
    Dim sTmpB As String     '保存此次出库单编号
    Dim j As Integer
    Dim i As Integer
    Dim k As Integer        '保存当前是盘盈还是盘亏处理,或是正常数据,取值为:2:盘盈;3盘亏;4正常数据
                            '供myOperation.DelCheckOkGoodsData使用,此方法实现了删任务表时,自动更新t_checkresult_dta表中相关记录
    Dim aTmp() As String
    For i = Me.LVW.ListItems.Count To 1 Step -1
        Set myItem = LVW.ListItems(i)
        If myItem.Checked = True Then
            aTmp = Split(myItem.Tag, "|")       '保存任务主表ID,子表明细,任务生成人,任务执行人ID
            ok = True
            If CDbl(myItem.SubItems(2)) = CDbl(myItem.SubItems(3)) Then
                k = 4
            End If
            If CDbl(myItem.SubItems(4)) > 0 Then      '盘亏出理
                k = 3
                If sTmpB = "" Then                      '如果首次增加盘亏出库
                    sTmpB = myOperation.GetNewBillCode("B")         'B-->获取出库单号
                    If myDataprocess.AddNewOutM(sTmpB, IoType.PanKunChu, CInt(OC), aTmp(2), checkNull(myItem.SubItems(10))) = False Then
                        MsgBox myDataprocess.strError, vbOKOnly + vbCritical, "错误"
                        Exit Function
                    End If
                End If
                j = myOperation.GetGoodsDigt(myItem.Text)
                If myDataprocess.AddNewOutD(sTmpA, myItem.Text, CDbl(myItem.SubItems(4)), j, , myItem.SubItems(6)) = False Then
                    MsgBox myDataprocess.strError, vbOKOnly + vbInformation, "错误"
                    Exit Function
                End If
            End If
            If CDbl(myItem.SubItems(5)) > 0 Then    '盘盈出理
                k = 2
                If sTmpA = "" Then
                    sTmpA = myOperation.GetNewBillCode("A")     '获取入库单编号
                    If myDataprocess.AddNewInM(sTmpA, IoType.PanYingRu, CInt(OC), aTmp(2), checkNull(myItem.SubItems(10))) = False Then
                        MsgBox myDataprocess.strError, vbOKOnly + vbCritical, "错误"
                        Exit Function
                    End If
                End If
                j = myOperation.GetGoodsDigt(myItem.Text)
                If myDataprocess.AddNewInD(sTmpA, myItem.Text, CDbl(myItem.SubItems(5)), j, , , , , , myItem.SubItems(6)) = False Then
                    MsgBox myDataprocess.strError, vbOKOnly + vbInformation, "错误"
                    Exit Function
                End If
            End If
            If myOperation.DelCheckOkGoodsData(CInt(OC), aTmp(0), aTmp(1), k) = True Then
            '向已处理列表添加数据
                Set yItem = LVY.ListItems.Add()
                yItem.Text = myItem.Text
                yItem.SubItems(1) = myItem.SubItems(1)
                yItem.SubItems(2) = myItem.SubItems(2)
                yItem.SubItems(3) = myItem.SubItems(3)
                yItem.SubItems(4) = myItem.SubItems(4)
                yItem.SubItems(5) = myItem.SubItems(5)
                Select Case k
                    Case 4
                        yItem.SubItems(6) = "库/盘一致"
                    Case 3
                        yItem.SubItems(6) = "已盘亏处理"
                    Case 5
                        yItem.SubItems(6) = "已盘盈处理"
                End Select
                yItem.SubItems(7) = myItem.SubItems(6)
                yItem.SubItems(8) = myItem.SubItems(7)
                yItem.SubItems(9) = myItem.SubItems(8)
                yItem.SubItems(10) = myItem.SubItems(9)
                yItem.SubItems(11) = myItem.SubItems(10)
                LVW.ListItems.Remove myItem.Index
            Else
                MsgBox myOperation.strError, vbOKOnly + vbInformation, "错误"
            End If
        End If
    Next
    If ok = False Then
        MsgBox "没有任何数据可以处理!", vbOKOnly + vbInformation, "警告"
        Exit Function
    End If
End Function