davidd31415
Programmer
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
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