注册 登录
编程论坛 VB6论坛

vb6 ListBox 项目移至顶部或底部

Ez330阿牛 发布于 2014-03-18 21:42, 342 次点击
Private Sub Comm_底_Click()
    Dim a, b
    Indexs = List_待选.ListIndex
    If Indexs >= 0 Then
        a = List_待选.List(Indexs)
        b = List_待选.Selected(Indexs)
        For i = Indexs To List_待选.ListCount - 2
            List_待选.List(i) = List_待选.List(i + 1)
            List_待选.Selected(i) = List_待选.Selected(i + 1)
            DoEvents
        Next
        List_待选.List(List_待选.ListCount - 1) = a
        List_待选.Selected(List_待选.ListCount - 1) = b
    End If
    Indexs = -1
End Sub

Private Sub List_待选_GotFocus()
    Client = False
    Command_Save_Click
End Sub
Private Sub List_待选_LostFocus()
    Client = True
End Sub
Private Sub Command_Save_Click()
    Lista = ""
    For xf = 0 To List_待选.ListCount - 1
        Lista = Lista & List_待选.List(xf) & "<>" & List_待选.Selected(xf) & "|"
        DoEvents
    Next
    If Lista <> "" Then WriteInI "List", "List_待选", Lista, BasePath & "\Uservar(勿删).ini"
End Sub
Private Sub Comm_顶_Click()
    Dim a, b
    Indexs = List_待选.ListIndex
    If Indexs > 0 Then
        a = List_待选.List(Indexs)  '记住上一个的位置
        b = List_待选.Selected(Indexs)
        For i = Indexs To 1 Step -1
            List_待选.List(i) = List_待选.List(i + 1)
            List_待选.Selected(i) = List_待选.Selected(i + 1)
        Next
        List_待选.List(0) = a
        List_待选.Selected(0) = b
    End If
    Indexs = -1
End Sub
我这个存在问题就是移至顶部或者底部时间会产生重复项,研究了n天一直找到不解决办法,请大神帮忙(注:不要单纯两个位置的交换,那样的没有意义,要排列非常费时间)
3 回复
#2
lowxiong2014-03-18 23:38
把到顶的+1改成-1,如下:
Private Sub Comm_顶_Click()
    Dim a, b
    Indexs = List_待选.ListIndex
    If Indexs > 0 Then
        a = List_待选.List(Indexs)  '记住上一个的位置
        b = List_待选.Selected(Indexs)
        For i = Indexs To 1 Step -1
            List_待选.List(i) = List_待选.List(i - 1)
            List_待选.Selected(i) = List_待选.Selected(i - 1)
        Next
        List_待选.List(0) = a
        List_待选.Selected(0) = b
    End If
    Indexs = -1
End Sub

其实,可以更简单些,如下:
Private Sub Comm_底_Click()
    Dim a As String, i As Integer
    i = List_待选.ListIndex
    If i >= 0 Then
        a = List_待选.List(i)
        List_待选.RemoveItem (i)
        List_待选.AddItem a
        List_待选.Selected(List_待选.ListCount - 1) = True
    End If
End Sub

Private Sub Comm_顶_Click()
    Dim a As String, i As Integer, j As Integer
    j = List_待选.ListIndex
    If j > 0 Then
        For i = j To 1 Step -1
          a = List_待选.List(i)
          List_待选.List(i) = List_待选.List(i - 1)
          List_待选.List(i - 1) = a
        Next
        List_待选.Selected(0) = True
    End If
End Sub

[ 本帖最后由 lowxiong 于 2014-3-18 23:41 编辑 ]
#3
bczgvip2014-03-19 03:13
推荐用按键控制:
vbKeyHome
vbKeyEnd
vbKeyPageUp
vbKeyPageDown
#4
Ez330阿牛2014-03-19 23:24
回复 2楼 lowxiong
谢谢了,你写的目前测试比我的好用,现在要怎么把分给你,3楼的建议也不错
1