VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRecent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'
'   project     :   AddToRecent
'
'   description :   automatic create recent menu items
'                   you just need to define file at load
'                   at close (call SaveData sub), and on
'                   oppening some file call AddItem.
'
'   note        :   menu button defined for recent items
'                   must have index 0, other buttons
'                   (control array) will be created automaticly
'
'   author      :   ivan stimac
'
'   web         :   http://mysource.50webs.com
'
'   mail        :   [[Email Removed]]



Option Explicit


Private Const int_buffer As Integer = 10
Private arr_data() As String
Private arr_names() As String
Private int_dataCount As String, int_maxCount As Integer

'**********
Public Property Get MaxCount() As Integer
   
    MaxCount = int_maxCount
   
End Property

Public Property Let MaxCount(ByVal nV As Integer)

    int_maxCount = nV

End Property

'**********
Public Property Get ItemsCount() As Integer
   
    If int_dataCount > int_maxCount Then
        ItemsCount = int_maxCount
    Else
        ItemsCount = int_dataCount
    End If
   
End Property

Public Property Get Data(ByVal Index As Integer) As String
   
    If Index > int_maxCount Then
        Index = int_maxCount
    End If
   
    If Index > int_dataCount Then
        Index = int_dataCount
    End If
       
    Index = int_dataCount - 1 - Index
    Data = arr_data(Index)

End Property

Public Property Get Name(ByVal Index As Integer) As String
   
    If Index > int_maxCount Then
        Index = int_maxCount
    End If
   
    If Index > int_dataCount Then
        Index = int_dataCount
    End If
       
    Index = int_dataCount - 1 - Index
    Name = arr_names(Index)

End Property


Public Sub AddItem(ByVal str_name As String, ByVal str_data As String)

    If int_dataCount > UBound(arr_names) Then
       
        ReDim Preserve arr_data(int_dataCount + int_buffer)
        ReDim Preserve arr_names(int_dataCount + int_buffer)
       
    End If
   
    arr_names(int_dataCount) = str_name
    arr_data(int_dataCount) = str_data
    int_dataCount = int_dataCount + 1
   
    Call removeCopies
   
    If int_dataCount > int_maxCount Then

        Call RemoveItem(int_dataCount - 1)
       
    End If
   

End Sub


Public Sub RemoveItem(ByVal Index As Integer)

    Dim i As Integer, j As Integer, arr_tmp1() As String, arr_tmp2() As String
   
    j = 0
    ReDim arr_tmp1(int_dataCount - 1)
    ReDim arr_tmp2(int_dataCount - 1)
    Index = int_dataCount - Index - 1
   
    For i = 0 To int_dataCount - 1
       
        If i <> Index Then
       
            arr_tmp1(j) = arr_names(i)
            arr_tmp2(j) = arr_data(i)
            j = j + 1
       
        End If
       
    Next i
   
    int_dataCount = int_dataCount - 1
    For i = 0 To int_dataCount - 1
   
        arr_names(i) = arr_tmp1(i)
        arr_data(i) = arr_tmp2(i)
       
    Next i
   
   
    Erase arr_tmp1
    Erase arr_tmp2
   
End Sub


Public Function LoadFile(ByVal str_file As String) As Boolean
    On Error GoTo errH
    Dim FF As Integer, str_ln As String, str_nam As String, str_dat As String
   
    LoadFile = True
    FF = FreeFile
    Open str_file For Input As #FF
       
        Do Until EOF(FF)
           
            Input #FF, str_ln
            'MsgBox str_ln
            If Left$(str_ln, 4) = "nam=" Then
                str_nam = Mid$(str_ln, 5)
            ElseIf Left$(str_ln, 4) = "dat=" Then
                str_dat = Mid$(str_ln, 5)
                Call AddItem(str_nam, str_dat)
            'if is'n comments
            ElseIf Left$(str_ln, 2) <> "//" Then
                LoadFile = False
                Exit Function
            End If
           
        Loop
       
    Close #FF
errH:

End Function


Public Function SaveData(ByVal str_file As String)

    Dim FF As Integer, i As Integer
    FF = FreeFile
   
    Open str_file For Output As #FF
       
        For i = 0 To int_dataCount - 1
       
            Print #FF, "nam=" & arr_names(i)
            Print #FF, "dat=" & arr_data(i)
           
        Next i
       
    Close #FF

End Function

Private Sub Class_Initialize()
   
    ReDim arr_data(int_buffer)
    ReDim arr_names(int_buffer)
    int_dataCount = 0
    int_maxCount = 10
   
End Sub

Private Sub Class_Terminate()

    Erase arr_data
    Erase arr_names
    'Set objMenu = Nothing
   
End Sub

Public Sub setMenu(ByRef objMenu As Object)

    Dim i As Integer
   
    For i = 1 To objMenu.Count - 1
   
        Unload objMenu(i)
       
    Next i
   
   
    For i = 0 To int_dataCount - 1
       
        If i > 0 Then
            Load objMenu(i)
            objMenu(i).Visible = True
        End If
        objMenu(i).Caption = arr_names(int_dataCount - i - 1)
        objMenu(i).Tag = arr_data(int_dataCount - i - 1)
       
    Next i
   
End Sub


Private Sub removeCopies()

    Dim i As Integer
   
    For i = 0 To int_dataCount - 2
   
        If arr_data(int_dataCount - 1) = arr_data(i) Then
           
            Call RemoveItem(int_dataCount - i - 1)
            Exit Sub
           
        End If
       
    Next i
   
End Sub