Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How can I speed up this class ?

Status
Not open for further replies.

davidd31415

Programmer
Jan 25, 2006
154
US
I have a class that stores a list of values (filenames) and allows the user to re-order them (move up/move down). The problem I am having is that it is very slow- in the time it takes me to click "move up" three or four times the program only moves up twice.

Any advice on how to increase the speed that the move up/move down sub routines execute at would be appreciated. I thought about posting only those two routines but decided to include the whole class in case there is confusion.

Thanks,

David

Code:
Option Explicit

Private m_Path As String                    'path to files
Private m_FileIndex As Integer              'points to a filename, 0-indexed
Private m_Files() As String                 'filenames are stored here
Private m_FilesArrayEmpty As Boolean        'true if there are no filenames stored in object

'Set path to st_Path or "" if st_Path is not valid
Public Property Let SetPath(st_Path As String)
    m_Path = st_Path
    If Mid(m_Path, Len(m_Path), 1) <> "\" Then m_Path = m_Path + "\"      'Append \ if it is not there
    
    If Len(Dir(m_Path, vbDirectory)) = 0 Then
        m_Path = ""
        MsgBox ("Error in CFileList Object: invalid path supplied to SetPath function")
    End If
End Property

'Return the path
Public Property Get GetPath() As String
    GetPath = m_Path
End Property

'Return count of number of files stored
Public Property Get GetFileCount() As Integer
    GetFileCount = UBound(m_Files) + 1
End Property

'Return the current filename index
Public Property Get GetFileIndex() As Integer
    GetFileIndex = m_FileIndex
End Property

'Set the current filename index to aIndex or display error if outside bounds
Public Property Let SetFileIndex(aIndex As Integer)
    'Set file index... Set it to -1 to make it invalid
    If aIndex > -2 And aIndex <= UBound(m_Files) Then
        m_FileIndex = aIndex
    Else
        MsgBox ("Error in CFileList Object: unable to set index to requested value.")
    End If
End Property

'Return boolean value indicating if the m_Files() array is empty
Public Function IsFilesArrayEmpty() As Boolean
    IsFilesArrayEmpty = m_FilesArrayEmpty
End Function

'Reset file name index to 0
Function ResetFileIndex()
    If m_FilesArrayEmpty = False Then
        m_FileIndex = 0
    Else
        MsgBox ("No files stored in object")
    End If
End Function

'Return the currently indexed filename and increase the filename index
'Return "" if fileindex is not valid
Public Function FileNext() As String
    If m_FileIndex > -1 Then
        FileNext = m_Files(m_FileIndex)
        IncrementIndex
    Else
        FileNext = ""
    End If
End Function

'Populate the m_Files() string array with all file names in the m_Path directory
Function ReadFiles()
    Dim DirFile As String                                   'result from Dir()
    Erase m_Files                                           'clear m_Files
    ReDim m_Files(0)
    DirFile = m_Path & Dir(m_Path, vbReadOnly Or vbHidden)  'set mode of Dir() function
    Do While (DirFile <> m_Path)
        If Right(DirFile, 2) <> "\." And Right(DirFile, 3) <> "\.." And GetAttr(DirFile) <> vbDirectory Then
            'filename found, save in array
            If m_Files(0) <> "" Then
                ReDim Preserve m_Files(UBound(m_Files) + 1) 'do not redim if it is the first element
            Else
                m_FilesArrayEmpty = False
            End If
            m_Files(UBound(m_Files)) = DirFile
        End If
        DirFile = m_Path & Dir()
    Loop
End Function

'Move the currently indexed filename up one spot in the array (closer to the beginning)
Function MoveUp()
    Dim tempFile As String
    If m_FileIndex > 0 Then
        tempFile = m_Files(m_FileIndex - 1)
        m_Files(m_FileIndex - 1) = m_Files(m_FileIndex)
        m_Files(m_FileIndex) = tempFile
        DecrementIndex
    Else
        MsgBox ("Error in CFileList Object MoveUp() function - m_FileIndex not valid for function")
    End If
End Function

'Move the currently indexed filename down one spot in the array (closer to the end)
Function MoveDown()
    Dim tempFile As String
    If m_FileIndex < UBound(m_Files) And m_FileIndex > -1 Then
        tempFile = m_Files(m_FileIndex + 1)
        m_Files(m_FileIndex + 1) = m_Files(m_FileIndex)
        m_Files(m_FileIndex) = tempFile
        IncrementIndex
    Else
        MsgBox ("Error in CFileList Object MoveDown() function - m_FileIndex not valid for function")
    End If
End Function

'Delete the currently indexed filename unless it is the only filename
Function Delete()
    If GetFileCount > 1 Then
        Do While (m_FileIndex < GetFileCount - 1)
            m_Files(m_FileIndex) = m_Files(m_FileIndex + 1)
            IncrementIndex
        Loop
        ReDim Preserve m_Files(GetFileIndex - 1)
    Else
        MsgBox ("Can not delete last item")
    End If
End Function
'Increment the filename index if not at the end of the list
Private Function IncrementIndex()
    If m_FileIndex < UBound(m_Files) Then
        m_FileIndex = m_FileIndex + 1
    Else
        m_FileIndex = -1        'set index to -1 to notify loops that list read is complete
    End If
End Function

'Decrement the filename index if not at the beginning of the list
Private Function DecrementIndex()
    If m_FileIndex > 0 Then
        m_FileIndex = m_FileIndex - 1
    End If
End Function

Private Sub Class_Initialize()
    m_Path = ""
    m_FileIndex = -1
    Erase m_Files
    ReDim m_Files(0)            'Set size of m_Files to 1 element (index 0)
    m_FilesArrayEmpty = True
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top