listviewcode.bas

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

Attribute VB_Name = "ListViewCode"
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Function lvSwapItems(lv As ListView, topIndex As Integer, bottomIndex As Integer) As Boolean
    
    On Error GoTo eHandler
    Dim bottomNode As ListItem, topNode As ListItem
    
    ' Get references to the two items we want to swap.
    Set bottomNode = lv.ListItems(bottomIndex)
    Set topNode = lv.ListItems(topIndex)
    
    ' Remove the bottom item.
    lv.ListItems.Remove bottomIndex
    
    ' Change the displayed index of the top item to be the bottom item.
    topNode.SubItems(1) = bottomIndex
    
    ' Re-add the bottom node, above the top node.
    Set bottomNode = lv.ListItems.Add(topIndex, bottomNode.key, bottomNode.Text)
    
    lvSwapItems = True
    Exit Function
eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next
    
    LogError "ListViewCode", "lvSwapItems", Error(Err), False
'
End Function


Public Sub lvMoveSelectedActionDown(acts As CActions, lst As ListView)
    
    On Error GoTo eHandler
    
    '********************************************************
    ' First, change the item order in our internal structure.
    '********************************************************
    
    Dim top As Object, bottom As Object
    Dim topIndex As Integer, bottomIndex As Integer
    
    If lst Is Nothing Then Exit Sub
    If acts Is Nothing Then Exit Sub
    If lst.SelectedItem Is Nothing Then Exit Sub
    
    ' Get the item we want to move down.
    Set top = acts(lst.SelectedItem.key)
    If top Is Nothing Then Exit Sub
    If top.index = acts.Count Then GoTo done
    
    ' Get the item above the item we want to move up.
    Set bottom = acts(top.index + 1)
    If bottom Is Nothing Then GoTo done
    
    ' Change the indexes so bottom becoms top, and top bottom.
    topIndex = top.index
    bottomIndex = bottom.index
    top.index = bottomIndex
    bottom.index = topIndex
    acts.Reorder

    '*******************************************
    ' Fix the list so top is bottom, bottom top.
    '*******************************************
    
    lvSwapItems lst, topIndex, bottomIndex
    
    ' Fix the displayed indexes.
    lst.ListItems(topIndex).SubItems(1) = topIndex
    lst.ListItems(bottomIndex).SubItems(1) = bottomIndex
    
    ' Keep the newly moved item as the selected item.
    Set lst.SelectedItem = lst.ListItems(bottomIndex)

done:
    Set top = Nothing
    Set bottom = Nothing

    Exit Sub

eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next
    
    LogError "ListViewCode", "lvMoveSelectedActionDown", Error(Err), False
'
End Sub
Public Sub lvMoveSelectedActionUp(acts As CActions, lst As ListView)
    
    On Error GoTo eHandler
    
    '********************************************************
    ' First, change the item order in our internal structure.
    '********************************************************
        
    If acts Is Nothing Then Exit Sub
    If lst Is Nothing Then Exit Sub
    If lst.SelectedItem Is Nothing Then GoTo done
    
    Dim top As Object, bottom As Object
    Dim topIndex As Integer, bottomIndex As Integer
    
    ' Get the item we want to move up.
    Set bottom = acts(lst.SelectedItem.key)
    If bottom Is Nothing Then Exit Sub
    If bottom.index = 1 Then GoTo done
    
    ' Get the item above the item we want to move up.
    Set top = acts(bottom.index - 1)
    If top Is Nothing Then GoTo done
    
    ' Change the indexes so bottom becoms top, and top bottom.
    topIndex = top.index
    bottomIndex = bottom.index
    top.index = bottomIndex
    bottom.index = topIndex
    acts.Reorder
    
    '*******************************************
    ' Fix the list so top is bottom, bottom top.
    '*******************************************
    
    lvSwapItems lst, topIndex, bottomIndex
    
    ' Fix the displayed indexes.
    lst.ListItems(topIndex).SubItems(1) = topIndex
    lst.ListItems(bottomIndex).SubItems(1) = bottomIndex
    
    ' Keep the newly moved item as the selected item.
    Set lst.SelectedItem = lst.ListItems(topIndex)

done:
    Set acts = Nothing
    Set top = Nothing
    Set bottom = Nothing
    Exit Sub
eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next

    LogError "ListViewCode", "lvMoveSelectedActionUp", Error(Err), False
'
End Sub

Public Sub lvMoveSelectedDataItemUp(cp As CInputRecord, lst As ListView)
    On Error GoTo eHandler
    
    If cp Is Nothing Then Exit Sub
    If lst Is Nothing Then Exit Sub
    If lst.SelectedItem Is Nothing Then Exit Sub
    
    '********************************************************
    ' First, change the item order in our internal structure.
    '********************************************************
    
    Dim top As CInputField, bottom As CInputField
    Dim topIndex As Integer, bottomIndex As Integer
    Dim di As CInputField
    
    ' Get the item we want to move up.
    Set bottom = cp.GetDataPoint(lst.SelectedItem.key)
    If bottom Is Nothing Then GoTo done
    If bottom.index = 1 Then GoTo done  ' Already at the top.
    
    ' Get the item above the item we want to move up.
    Set top = cp.GetDataPoint(bottom.index - 1)
    If top Is Nothing Then GoTo done
    
    ' Change the indexes so bottom becoms top, and top bottom.
    topIndex = top.index
    bottomIndex = bottom.index
    top.index = bottomIndex
    bottom.index = topIndex
    cp.GetDataPoints.Reorder

    '*******************************************
    ' Fix the list so top is bottom, bottom top.
    '*******************************************
    
    lvSwapItems lst, topIndex, bottomIndex
    
    ' Fix the displayed indexes.
    lst.ListItems(topIndex).SubItems(1) = topIndex
    lst.ListItems(bottomIndex).SubItems(1) = bottomIndex
    
    ' Keep the newly moved item as the selected item.
    Set lst.SelectedItem = lst.ListItems(topIndex)
    
done:
    Set top = Nothing
    Set bottom = Nothing
    Exit Sub

eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next
    
    LogError "ListViewCode", "lvMoveSelectedDataItemUp", Error(Err), False
End Sub

Public Sub lvMoveSelectedDataItemDown(cp As CInputRecord, lst As ListView)
    On Error GoTo eHandler
    If cp Is Nothing Then Exit Sub
    If lst Is Nothing Then Exit Sub
    If lst.SelectedItem Is Nothing Then Exit Sub
    
    '********************************************************
    ' First, change the item order in our internal structure.
    '********************************************************
    
    Dim top As CInputField, bottom As CInputField
    Dim topIndex As Integer, bottomIndex As Integer

    ' Get the item we want to move down.
    Set top = cp.GetDataPoint(lst.SelectedItem.key)
    If top Is Nothing Then Exit Sub
    If top.index = cp.GetDataPoints.Count() Then GoTo done

    ' Get the item above the item we want to move up.
    Set bottom = cp.GetDataPoint(top.index + 1)
    If bottom Is Nothing Then GoTo done
    
    ' Change the indexes so bottom becoms top, and top bottom.
    topIndex = top.index
    bottomIndex = bottom.index
    top.index = bottomIndex
    bottom.index = topIndex
    cp.GetDataPoints.Reorder

    '*******************************************
    ' Fix the list so top is bottom, bottom top.
    '*******************************************
    
    lvSwapItems lst, topIndex, bottomIndex
    
    ' Fix the displayed indexes.
    lst.ListItems(topIndex).SubItems(1) = topIndex
    lst.ListItems(bottomIndex).SubItems(1) = bottomIndex
    
    ' Keep the newly moved item as the selected item.
    Set lst.SelectedItem = lst.ListItems(bottomIndex)
    
done:
    Set top = Nothing
    Set bottom = Nothing
    Exit Sub
eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next

    LogError "ListViewCode", "lvMoveSelectedActionDown", Error(Err), False
    

End Sub

Public Sub lvMoveSelectedCheckpointUp(Import As CImport, lst As ListView)
    On Error GoTo eHandler
    
    If Import Is Nothing Then Exit Sub
    If lst Is Nothing Then Exit Sub
    If lst.SelectedItem Is Nothing Then Exit Sub
    
    '********************************************************
    ' First, change the item order in our internal structure.
    '********************************************************
    
    Dim top As CInputRecord, bottom As CInputRecord
    Dim topIndex As Integer, bottomIndex As Integer
    
    ' Get the item we want to move up.
    Set bottom = Import.GetCheckPoint(lst.SelectedItem.key)
    If bottom Is Nothing Then Exit Sub
    If bottom.index = 1 Then Exit Sub
    
    ' Get the item above the item we want to move up.
    Set top = Import.GetCheckPoint(bottom.index - 1)
    If top Is Nothing Then Exit Sub
    
    ' Change the indexes so bottom becoms top, and top bottom.
    topIndex = top.index
    bottomIndex = bottom.index
    top.index = bottomIndex
    bottom.index = topIndex
    Import.GetCheckPoints.Reorder

    Set top = Nothing
    Set bottom = Nothing

    '*******************************************
    ' Fix the list so top is bottom, bottom top.
    '*******************************************
    
    lvSwapItems lst, topIndex, bottomIndex
    
    ' Fix the displayed indexes.
    lst.ListItems(topIndex).SubItems(1) = topIndex
    lst.ListItems(bottomIndex).SubItems(1) = bottomIndex
    
    ' Keep the newly moved item as the selected item.
    Set lst.SelectedItem = lst.ListItems(topIndex)
    Exit Sub
    
eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next
    LogError "ListViewCode", "lvMoveSelectedCheckpointUp", Error(Err), False
End Sub

Public Sub lvMoveSelectedCheckpointDown(Import As CImport, lst As ListView)
    On Error GoTo eHandler
    
    If Import Is Nothing Then Exit Sub
    If lst Is Nothing Then Exit Sub
    If lst.SelectedItem Is Nothing Then Exit Sub

    '********************************************************
    ' First, change the item order in our internal structure.
    '********************************************************
    
    Dim top As CInputRecord, bottom As CInputRecord
    Dim topIndex As Integer, bottomIndex As Integer

    ' Get the item we want to move down.
    Set top = Import.GetCheckPoint(lst.SelectedItem.key)
    If top Is Nothing Then Exit Sub
    If top.index = Import.GetCheckPoints().Count Then GoTo done
    
    ' Get the item below the item we want to move down.
    Set bottom = Import.GetCheckPoint(top.index + 1)
    If bottom Is Nothing Then GoTo done
    
    ' Change the indexes so bottom becoms top, and top bottom.
    topIndex = top.index
    bottomIndex = bottom.index
    top.index = bottomIndex
    bottom.index = topIndex
    Import.GetCheckPoints.Reorder

    '*******************************************
    ' Fix the list so top is bottom, bottom top.
    '*******************************************
    
    lvSwapItems lst, topIndex, bottomIndex
    
    ' Fix the displayed indexes.
    lst.ListItems(topIndex).SubItems(1) = topIndex
    lst.ListItems(bottomIndex).SubItems(1) = bottomIndex
    
    ' Keep the newly moved item as the selected item.
    Set lst.SelectedItem = lst.ListItems(bottomIndex)
    
done:
    Set top = Nothing
    Set bottom = Nothing
    Exit Sub
    
eHandler:
    ' This is if there are no subitems in the listbox.
    If Err = 380 Then Resume Next
    LogError "ListViewCode", "lvMoveSelectedCheckpointDown", Error(Err), False
    
End Sub