RecentView

Option Explicit

Private m_sAppName As String
Private m_nNumFiles As Integer
Private ma_sFiles() As String
Private Const ERR_RULIST = 6000
Private Const ERR_INVALIDINDEX = 1

Public Property Get FileName(Index As Integer) As String
'This property returns the filename in the specified position

'If the index is out of bounds then an error is raised

If Index > m_nNumFiles Or Index < 1 Then
Err.Raise ERR_RULIST + ERR_INVALIDINDEX, , "Index out of bounds."
Else
FileName = ma_sFiles(Index)
End If
End Property

Public Sub Init(byVal sAppName As String, byVal nFiles As Integer)
'Public sub to Initialise the object and should only be

'run once Params :

'sAppName = name to store files under in registry

'nFiles = number of files to track

Dim nX As Integer
'Copy parameters into module level variables for use elsewhere

m_sAppName = sAppName
m_nNumFiles = nFiles
'Dimension array of files so that we have the right number of slots

ReDim ma_sFiles(m_nNumFiles) As String
'Retrieve existing RU list from registry

For nX = 1 To m_nNumFiles
ma_sFiles(nX) = GetSetting(sAppName, "Recent Files", CStr(nX), "")
Next nX
End Sub

Public Function Propose(ByVal sFilename As String) As Boolean
' This is the public mechanism for adding a new item to the list

' It will do one of three things depending on the file passed in

' 1 - If its a new filename then it gets added to top of list

' 2 - If it exists lower down the list then it gets moved

' to the top of the list and others get shuffled

' 3 - If its already at the top of the list, nothing happens

' The function returns true if the list has been affected

Dim nX As Integer
Dim sNew As String
Dim nExistingIndex As Integer
'Convert to upper case - just to ensure it matches

sNew = Trim(UCase$(sFilename))
'If its already the first item in the list then we don't need

'to change anything

If Trim(UCase$(ma_sFiles(1))) = sNew Then
Propose = False
Exit Function
End If

'Look to see if its in the list already,but in a lower position

For nX = 2 To m_nNumFiles
If UCase$(ma_sFiles(nX)) = sNew Then
nExistingIndex = nX
Exit For
End If
Next nX
If nExistingIndex <> 0 Then
'It is already in the list but lower down :

'Move it to the top of the list

Call PromoteFile(nExistingIndex)
Else
'It isn't in the list yet :

'Add it to the top and demote others

Call InsertFile(sFilename)
End If
'update values in registry

Call WriteToReg
Propose = True
End Function

Private Sub PromoteFile(nIndex As Integer)
' This private subroutine moves the file residing at the specified

' position to the top of the list and moves all others downwards

Dim a_sNewSet() As String
Dim nNewPosition As Integer
Dim nOldPosition As Integer
Dim nX As Integer
ReDim a_sNewSet(1 To m_nNumFiles)
' Set first item in new array

a_sNewSet(1) = Trim$(ma_sFiles(nIndex))
nNewPosition = 2
' Step through each item of the original set and

' copy into the new set unless its the specified file

For nOldPosition = 1 To m_nNumFiles
If nOldPosition <> nIndex Then
a_sNewSet(nNewPosition) = ma_sFiles(nOldPosition)
nNewPosition = nNewPosition + 1
End If
Next nOldPosition
' Copy the new array back into the old array

For nX = 1 To m_nNumFiles
ma_sFiles(nX) = a_sNewSet(nX)
Next nX
End Sub


Private Sub InsertFile(sFilename As String)
' This is a private procedure which places the

' specified file at the

' top of the list and moves all other items down

Dim nX As Integer
' Copy each item into the next slot down

For nX = m_nNumFiles To 2 Step -1
ma_sFiles(nX) = ma_sFiles(nX - 1)
Next nX
ma_sFiles(1) = Trim$(sFilename)
End Sub

Private Sub WriteToReg()
' Private sub to save values back from array to registry

Dim nX As Integer
For nX = 1 To m_nNumFiles
Call SaveSetting(m_sAppName, "Recent Files", _
Format$(nX), ma_sFiles(nX))
Next nX
End Sub