Based on http://www.mediamonkey.com/forum/viewtopic.php?t=9151 (thanks Steegy) I've created a modified version of this script, which allows the modification of all classification criteria and not only the mood.
Additionally, the state "None" will be recognized correctly in the menu.
Code
Code: Select all
'====================================================================================
'
' MEDIAMONKEY SCRIPT: TrayClassification v1.1 (last updated 2007-02-04)
'
' Original by Steegy: http://www.mediamonkey.com/forum/viewtopic.php?t=9151
' Extended by streawkceur: http://www.mediamonkey.com/forum/viewtopic.php?t=15047
'
'
' TrayClassification will add submenus for the classification (temp, mood, occasion,
' quality)of the current songs to the tray menu.
'
'====================================================================================
Option Explicit
Public ClassificationTypes(4)
ClassificationTypes(1) = "Tempo"
ClassificationTypes(2) = "Mood"
ClassificationTypes(3) = "Occasion"
ClassificationTypes(4) = "Quality"
'Store the classification class for each menu entry in this dictionary
'as we otherwise don't know to which class a menu item belongs
Public ClassByMenuItem
Set ClassByMenuItem = CreateObject("Scripting.Dictionary")
Sub OnStartup
Dim i
For i = 1 To 4
Dim MenuItem
Set MenuItem = SDB.UI.AddMenuItemSub(SDB.UI.Menu_TrayIcon, 1, 2)
MenuItem.Caption = SDB.Localize(ClassificationTypes(i))
MenuItem.IconIndex = 42
Script.RegisterEvent MenuItem, "OnClick", "ClassMenuClick"
ClassByMenuItem.Add MenuItem, i
Next
End Sub
Sub ClassMenuClick(MI)
'Which classification menu has been clicked?
Dim ClassificationType
ClassificationType = ClassByMenuItem.Item(MI)
'Fill the tray classification list
Dim Iter, MSI, Localised, ObjectPrefix, ObjectName
Set Iter = SDB.Database.OpenSQL("SELECT TextData FROM Lists WHERE IDListType = " & ClassificationType & " ORDER BY SortOrder")
ObjectPrefix = "Tray_" & ClassificationTypes(ClassificationType) & "_"
Do While Not Iter.EOF
Localised = SDB.LocalizeGen("DB", Iter.StringByIndex(0))
ObjectName = ObjectPrefix & Localised
If SDB.Objects(ObjectName) Is Nothing Then
Set MSI = SDB.UI.AddMenuItem(MI, 0, 0)
MSI.Caption = Localised
MSI.IconIndex = 64
Script.RegisterEvent MSI, "OnClick", "ClassSubmenuClick"
Set SDB.Objects(ObjectName) = MSI
ClassByMenuItem.Add MSI, ClassificationType
End If
SDB.Objects(ObjectName).Checked = False
Iter.Next
Loop
'Check the classification for the currently playing song
Dim CurrentSong : Set CurrentSong = SDB.Player.CurrentSong
If Not CurrentSong Is Nothing Then
Dim Value
Select Case ClassificationType
Case 1 'Tempo
Value = CurrentSong.Tempo
Case 2 'Mood
Value = CurrentSong.Mood
Case 3 'Occasion
Value = CurrentSong.Occasion
Case 4 'Quality
Value = CurrentSong.Quality
End Select
If Value = "" Then Value = SDB.LocalizeGen("DB", "None")
If Not SDB.Objects(ObjectPrefix & Value) Is Nothing Then
SDB.Objects(ObjectPrefix & Value).Checked = True
End If
End If
End Sub
Sub ClassSubmenuClick(MSI)
'In which classification submenu has an item been clicked?
Dim ClassificationType
ClassificationType = ClassByMenuItem.Item(MSI)
'Store the chosen categorization to the song's properties
Dim CurrentSong : Set CurrentSong = SDB.Player.CurrentSong
If Not CurrentSong Is Nothing Then
Select Case ClassificationType
Case 1 'Tempo
CurrentSong.Tempo = MSI.Caption
Case 2 'Mood
CurrentSong.Mood = MSI.Caption
Case 3 'Occasion
CurrentSong.Occasion = MSI.Caption
Case 4 'Quality
CurrentSong.Quality = MSI.Caption
End Select
Dim SongList : Set SongList = SDB.NewSongList
Call SongList.Add(CurrentSong)
Call SongList.UpdateAll
End If
End Sub
Just put it in the MediaMonkey\Scripts\Auto folder.
Limitations
- The icons do not fit very well. Unfortunately you cannot use folder icons for menu entries. At least I don't know how you could. Anyone else?