Test script for rotating album art [#10406]

[Wim]

Hello All,

This a script (first try please be gentile ) to rotate the album art. It works ... but I have a problem.

I could not get access to the popup menu of the "Album Art (Now Playing)" so I change the album art of the song and do an update. This gives a small hick up during the play.

So my question, does anybody have an idea if (and how) I can influence the popup menu (so I can select the "next" picture)?

The script (no guarantees jadajadaja ...)

Code: Select all

'-----------------------------OPEN-------------------------------------
Dim FSO : Set FSO=CreateObject("Scripting.FileSystemObject")
Dim SDB : Set SDB=CreateObject("SongsDB.SDBApplication")
While Not SDB.isRunning : WScript.Sleep 500 : Wend
'----------------------------------------------------------------------
Prepare
InstallScriptTo "Auto\RotateArtSetting.vbs" ,066, 140,"none"
InstallScriptTo "RotateArt.vbs"             ,142, 217,_
"Script Successfully Installed!"            &vbLf&_
"Go to "                                    &vbLf&_
"Tools - Rotate Art"                        &vbLf&_
"to change the settings."
'------------------------------CLOSE-----------------------------------
SDB.ShutdownAfterDisconnect=True
Set FSO=Nothing : Set SDB=Nothing : Wscript.Quit

'%%%%%%%%%%%%%%%%% START OF SCRIPT INSTALLER %%%%%%%%%%%%%%%%%%

Sub InstallScriptTo(ScriptName, LineBegin, LineEnd, Message)

	ScriptName=SDB.ApplicationPath & "Scripts\" & ScriptName

	RenameOldScript(ScriptName)

	Set TXT=FSO.OpenTextFile(WScript.ScriptFullName,1)
	STR=TXT.ReadAll
	TXT.Close

	LNS=Split(STR,vbNewLine)

	Set TXT=FSO.CreateTextFile(ScriptName, True)
	For i=LineBegin-1 To LineEnd-1
	TXT.WriteLine LNS(i)
Next
TXT.Close

If FSO.FileExists(ScriptName) And Message<>"none" Then _
	SDB.MessageBox Message , 2, Array(4)
End Sub

Sub RenameOldScript(ScriptName)
	If FSO.FileExists(ScriptName) Then _
		FSO.MoveFile ScriptName, BakFile(ScriptName)
	End Sub

	Function BakFile(ScriptName)
	Do
		TMP=Left(ScriptName, Len(ScriptName)-3) & "old" & v
		v=v+1
	Loop While FSO.FileExists(TMP)
	BakFile=TMP
End Function

Sub Prepare
	RenameOldScript(SDB.ApplicationPath&"Scripts\RotateArt.vbs")

	Set INI=SDB.Tools.IniFileByPath(SDB.ApplicationPath&"Scripts\Scripts.ini")
	INI.StringValue("RotateArt","FileName")="RotateArt.vbs"
	INI.StringValue("RotateArt","ProcName")="RotateArt"
	INI.StringValue("RotateArt","Language")="VBScript"
	INI.IntValue("RotateArt","ScriptType")=2


End Sub
'%%%%%%%%%%%%%%%%%% END OF SCRIPT INSTALLER %%%%%%%%%%%%%%%%%%%
'-------------------------------------------------------------------------------
' file to create a settings form for RotateArt
' Version 1.0
' date 12 nov 2006.
'-------------------------------------------------------------------------------

Sub OnStartup
	MyScript = SDB.ApplicationPath & "scripts\RotateArt.vbs"
	' setup menu values on tools
	Set UI = SDB.UI
	' Add a submenu to the Tools menu...
	Set Mnu = UI.AddMenuItem( UI.Menu_Tools, -1, 1)
	Mnu.Caption = "Rotate Art"
	Mnu.Caption = "Rotate"
	Mnu.OnClickFunc = "RotateNow"
	Mnu.UseScript=MyScript
	Mnu.IconIndex = 25

  ' and on the now playing popup.
	Set Mnu = UI.AddMenuItem( UI.Menu_Pop_NP, -1, 1)
	Mnu.Caption = "Rotate"
	Mnu.OnClickFunc = "RotateNow"
	Mnu.UseScript=MyScript
	Mnu.IconIndex = 25
  ' Create our own option sheet
  ind = SDB.UI.AddOptionSheet( "Rotate Art", Script.ScriptPath, "InitSheet", "SaveSheet", 0)
End Sub

Sub InitSheet( Sheet)
  ' Create a simple sheet with an edit line and a button
  Set UI=SDB.UI
  ' checkbox want it ?
  Set CbActive = UI.NewCheckBox(Sheet)
  CbActive.Caption="Activate Rotate Art"
  Cbactive.Common.ControlName = "cbActive"
  Cbactive.Common.SetRect 50, 20, 200, 20
  ' Create a label on the form
  Set Lbl = UI.NewLabel( Sheet)
  Lbl.Common.SetRect 50, 40, 200, 20
  Lbl.Caption = "Please set a value for the rotate time (in seconds)"

  ' Create an edit line
  Set Edt = UI.NewEdit( Sheet)
  Edt.Common.SetRect 50, 60, 30, 20
  Edt.Text = "40"
  Edt.Common.ControlName = "tbTime"

  ' Retrieve already entered value from registry
  Set Regs = SDB.Registry
  If Regs.OpenKey( "Rotate Art", True) Then
    If Regs.ValueExists( "RTime") Then
      Edt.Text = Regs.StringValue( "RTime") / 1000
    End If
    If Regs.ValueExists( "Active") Then
      CbActive.checked = Regs.StringValue( "Active")
    End If
    Regs.CloseKey
  End If
End Sub

Sub SaveSheet( Sheet)
   ' Save entered value to registry in order to be able to shown it next time
  Set Regs = SDB.Registry
  Set Edt = Sheet.Common.ChildControl( "tbTime")
  Set CbActive = Sheet.Common.ChildControl( "cbActive")
  If IsNumeric(edt.text) Then
  	If Regs.OpenKey( "Rotate Art", True) Then
    	Regs.StringValue("RTime") = Edt.Text * 1000
    	Regs.StringValue( "Active") = CbActive.checked
    	Regs.CloseKey
  	End If
  Else
  	SDB.MessageBox "Value '" & edt.text & "' is not a valid number'" , mtInformation, Array(mbOk)
  End If
End Sub

'-------------------------------------------------------------------------------
' Script to rotate the album art in mediamonkey
' Version 1.0
' date 12 nov 2006.
'-------------------------------------------------------------------------------

Sub RotateArt
  ' less than 2 picture, nothing to rotate ...
	Set Sng=SDB.Player.CurrentSong
	Set art=sng.AlbumArt
	If art.count < 2 Then
		Exit Sub
	End If
	' have a setting and want to run?
	Set REG=SDB.Registry
  If REG.ValueExists( "Active") Then
    If REG.StringValue( "Active") Then
    	Exit Sub ' Not active
    End If
  End If

  If REG.ValueExists( "RTime") Then
    Rtime = Regs.StringValue( "RTime")
  Else
  	Rtime = 40000 ' Default is 40 seconds
  End If
	Script.UnRegisterAllEvents ' Terminate any running timer
' Got enough song, start timer
	Set Tmr = SDB.CreateTimer( Rtime )   ' Pop up a message in "Rtime" seconds
	Script.RegisterEvent Tmr, "OnTimer", "TestTimer"
End Sub

Sub TestTimer( Timer)
	' timer event fired, rotate the picture
	Dim MyPic
	Dim ThisSong
	Dim TmpPic
	Set REG=SDB.Registry
	If REG.OpenKey("Rotate Art", True) Then
		ThisSong = REG.IntValue("CurrSong")
		MyPic = REG.IntValue("LastPic")
	End If
	Set Sng=SDB.Player.CurrentSong
	Set art=sng.AlbumArt
	' set MyPic to 0 (first pic) when last pic, or new song
	If  ThisSong <> Sng.ID Then
		MyPic = 0
	Else
		MyPic = MyPic + 1
	End If
	If MyPic >= art.count Then
		MyPic = 0
	End If
	' restarted, nothing to switch
	If MyPic <> 0 Then
		' the rotate, change picture 0 with MyPic
		Set tmppic = art.item(0)
		Set art.item(0) = art.item(MyPic)
		Set art.item(MyPic)  = tmppic
		art.UpdateDB
	End If
	'Script.UnregisterEvents Timer  ' Terminate usage of this timer
	' save the current state
	ThisSong = Sng.ID
	REG.IntValue("CurrSong") = ThisSong
	REG.IntValue("LastPic") = MyPic
	REG.CloseKey
End Sub

Function RotateNow(Item)
	RotateArt
End Function

Sub OnStartup
	RotateArt
End Sub

[Wim]

Hmm,

My script still has some bugs, use with care ....

Wim

[Guest]

Why do you want to do this?

[Steegy]

"Rotating" album art is a bit confusing, you know...
I thought this was a script to rotate (in degrees) the images. Maybe you should consider using another topic title.

[Wim]

Hello,

The script I made cycles trough all the pictures associated with a track (the album art). If more than one picture is available it changed the picture every x seconds (configurable).

New problem is (I found when it runs longer) to many times ... I'll work on that.

The original question stays,

I could not get access to the popup menu of the "Album Art (Now Playing)" so I change the album art of the song and do an update. This gives a small hick up during the play.

So my question, does anybody have an idea if (and how) I can influence the popup menu (so I can select the "next" picture)?

[paulmt]

"Rotating" album art is a bit confusing, you know...
I thought this was a script to rotate (in degrees) the images. Maybe you should consider using another topic title.

Is what I thought also...
I see now you mean the differing album art views that can currently be manually shuffled through, this script is to automate that??

Perhaps "AlbumArtShuffle" would be a more descriptive title.

Good idea though as it add a bit more visual interest to a playing song.

[powerpill-pacman]

I've really been waiting for this. Thanks very much.

[Wim]

Hi people,

I changed the script to avoid the timer problem. Seams to work
The original problem is still there (the hick up, no new info on that).

This script cycles through all pictures (album art) of the current song (if it has any) it always works in sequence (hence not renamed to AlbumArtShuffle).

Enjoy ...

Code: Select all

'-----------------------------OPEN-------------------------------------
Dim FSO : Set FSO=CreateObject("Scripting.FileSystemObject")
Dim SDB : Set SDB=CreateObject("SongsDB.SDBApplication")
While Not SDB.isRunning : WScript.Sleep 500 : Wend
'----------------------------------------------------------------------
Prepare
InstallScriptTo "Auto\CycleArtSetting.vbs" ,066, 141,"none"
InstallScriptTo "CycleArt.vbs"             ,143, 246,_
"Script Successfully Installed!"            &vbLf&_
"Go to "                                    &vbLf&_
"Tools - Cycle Art"                        &vbLf&_
"to change the settings."
'------------------------------CLOSE-----------------------------------
SDB.ShutdownAfterDisconnect=True
Set FSO=Nothing : Set SDB=Nothing : Wscript.Quit

'%%%%%%%%%%%%%%%%% START OF SCRIPT INSTALLER %%%%%%%%%%%%%%%%%%

Sub InstallScriptTo(ScriptName, LineBegin, LineEnd, Message)

	ScriptName=SDB.ApplicationPath & "Scripts\" & ScriptName

	RenameOldScript(ScriptName)

	Set TXT=FSO.OpenTextFile(WScript.ScriptFullName,1)
	STR=TXT.ReadAll
	TXT.Close

	LNS=Split(STR,vbNewLine)

	Set TXT=FSO.CreateTextFile(ScriptName, True)
	For i=LineBegin-1 To LineEnd-1
	TXT.WriteLine LNS(i)
Next
TXT.Close

If FSO.FileExists(ScriptName) And Message<>"none" Then _
	SDB.MessageBox Message , 2, Array(4)
End Sub

Sub RenameOldScript(ScriptName)
	If FSO.FileExists(ScriptName) Then _
		FSO.MoveFile ScriptName, BakFile(ScriptName)
	End Sub

	Function BakFile(ScriptName)
	Do
		TMP=Left(ScriptName, Len(ScriptName)-3) & "old" & v
		v=v+1
	Loop While FSO.FileExists(TMP)
	BakFile=TMP
End Function

Sub Prepare
	RenameOldScript(SDB.ApplicationPath&"Scripts\CycleArt.vbs")

	Set INI=SDB.Tools.IniFileByPath(SDB.ApplicationPath&"Scripts\Scripts.ini")
	INI.StringValue("CycleArt","FileName")="CycleArt.vbs"
	INI.StringValue("CycleArt","ProcName")="CycleArt"
	INI.StringValue("CycleArt","Language")="VBScript"
	INI.IntValue("CycleArt","ScriptType")=2


End Sub
'%%%%%%%%%%%%%%%%%% END OF SCRIPT INSTALLER %%%%%%%%%%%%%%%%%%%
'-------------------------------------------------------------------------------
' file to create a settings form for CycleArt
' Version 1.1
' date 16 nov 2006.
' Version 1.1 changed name from Rotate to Cycle
'-------------------------------------------------------------------------------

Sub OnStartup
	MyScript = SDB.ApplicationPath & "scripts\CycleArt.vbs"
	' setup menu values on tools
	Set UI = SDB.UI
	' Add a submenu to the Tools menu...
	Set Mnu = UI.AddMenuItem( UI.Menu_Tools, -1, 1)
	Mnu.Caption = "Cycle Art"
	Mnu.Caption = "Cycle"
	Mnu.OnClickFunc = "CycleNow"
	Mnu.UseScript=MyScript
	Mnu.IconIndex = 25

  ' and on the now playing popup.
	Set Mnu = UI.AddMenuItem( UI.Menu_Pop_NP, -1, 1)
	Mnu.Caption = "Cycle"
	Mnu.OnClickFunc = "CycleNow"
	Mnu.UseScript=MyScript
	Mnu.IconIndex = 25
  ' Create our own option sheet
  ind = SDB.UI.AddOptionSheet( "Cycle Art", Script.ScriptPath, "InitSheet", "SaveSheet", 0)
End Sub

Sub InitSheet( Sheet)
  ' Create a simple sheet with an edit line and a button
  Set UI=SDB.UI
  ' checkbox want it ?
  Set CbActive = UI.NewCheckBox(Sheet)
  CbActive.Caption="Activate Cycle Art"
  Cbactive.Common.ControlName = "cbActive"
  Cbactive.Common.SetRect 50, 20, 200, 20
  ' Create a label on the form
  Set Lbl = UI.NewLabel( Sheet)
  Lbl.Common.SetRect 50, 40, 200, 20
  Lbl.Caption = "Please set a value for the Cycle time (in seconds)"

  ' Create an edit line
  Set Edt = UI.NewEdit( Sheet)
  Edt.Common.SetRect 50, 60, 30, 20
  Edt.Text = "40"
  Edt.Common.ControlName = "tbTime"

  ' Retrieve already entered value from registry
  Set Regs = SDB.Registry
  If Regs.OpenKey( "Cycle Art", True) Then
    If Regs.ValueExists( "RTime") Then
      Edt.Text = Regs.StringValue( "RTime") / 1000
    End If
    If Regs.ValueExists( "Active") Then
      CbActive.checked = Regs.StringValue( "Active")
    End If
    Regs.CloseKey
  End If
End Sub

Sub SaveSheet( Sheet)
   ' Save entered value to registry in order to be able to shown it next time
  Set Regs = SDB.Registry
  Set Edt = Sheet.Common.ChildControl( "tbTime")
  Set CbActive = Sheet.Common.ChildControl( "cbActive")
  If IsNumeric(edt.text) Then
  	If Regs.OpenKey( "Cycle Art", True) Then
    	Regs.StringValue("RTime") = Edt.Text * 1000
    	Regs.StringValue( "Active") = CbActive.checked
    	Regs.CloseKey
  	End If
  Else
  	SDB.MessageBox "Value '" & edt.text & "' is not a valid number'" , mtInformation, Array(mbOk)
  End If
End Sub

'-------------------------------------------------------------------------------
' Script to Cycle the album art in mediamonkey
' Version 1.1
' date 16 nov 2006.
' Version 1.1 new setup, to get the timer right
'   changed name from Rotate to Cycle
'-------------------------------------------------------------------------------

Sub OnStartup
	CycleArt
End Sub

' Called from the menubars
Function CycleNow(Item)
	If CanCycle Then
		CycleArt
	End If
End Function

Sub CycleArt
	If CanCycle Then
		StartTimer
	End If
End Sub

Function CanCycle
	CanCycle=true
	' are all settings correct?
	Set REG=SDB.Registry
	If REG.OpenKey( "Cycle Art", True) Then
		If REG.ValueExists( "Active") Then
  		CanCycle = REG.StringValue( "Active")
		End If
	End If
	' pictures available
	Set Sng=SDB.Player.CurrentSong
	Set art=sng.AlbumArt
	If art.count < 2 Then
  	CanCycle=false
	End If
	' don't cycle when stopped
	If Not SDB.Player.isPlaying Then
  	CanCycle=false
	End If
End Function

Sub StartTimer
	Set REG=SDB.Registry
	If REG.OpenKey("Cycle Art", True) Then
		If REG.ValueExists( "RTime") Then
			Rtime = REG.StringValue( "RTime")
		Else
			Rtime = 40000 ' Default is 40 seconds
		End If
	End If
	Set Tmr = SDB.CreateTimer( Rtime )   ' Cycle in "Rtime" seconds
	Script.RegisterEvent Tmr, "OnTimer", "TestTimer"
End Sub

Sub TestTimer( Timer)
	' timer fired, do we still need it?
  If canCycle Then
  	' yes, cycle picture
  	Cycle
  Else
  	' no, stop the timer
  	Script.UnregisterEvents Timer  ' Terminate usage of this timer
 	End If
End Sub

Sub Cycle
	Dim MyPic
	Dim ThisSong
	Dim TmpPic
	Set REG=SDB.Registry
	If REG.OpenKey("Cycle Art", True) Then
		ThisSong = REG.IntValue("CurrSong")
		MyPic = REG.IntValue("LastPic")
	End If
	Set Sng=SDB.Player.CurrentSong
	Set art=sng.AlbumArt
	' set MyPic to 0 (first pic) when last pic, or new song
	If  ThisSong <> Sng.ID Then
		MyPic = 0
	Else
		MyPic = MyPic + 1
	End If
	If MyPic >= art.count Then
		MyPic = 0
	End If
	' if MyPic = 0, restarted, nothing to switch
	If MyPic <> 0 Then
		' the Cycle, change picture 0 with MyPic
		Set tmppic = art.item(0)
		Set art.item(0) = art.item(MyPic)
		Set art.item(MyPic)  = tmppic
		art.UpdateDB
	End If

	' save the current state
	REG.IntValue("CurrSong") = Sng.ID
	REG.IntValue("LastPic") = MyPic
	REG.CloseKey
End Sub

[Guest]

don't work here, but i like the idea
in future maybe i can use this to hear the music and see photos of the band/artist in mm.
sorry for my english and good luck

[Wim]

Hello Guest,

Wat does not work? You need at least 2 pictures as albumart with a track (else there's nothing to cycle ) and you have to set the albumart image screen to "now playing". And of course you have to activate the script from the tools->option sheet ...

Doe any of the guru's out there have an answer to my question?

I could not get access to the popup menu of the "Album Art (Now Playing)" so I change the album art of the song and do an update. This gives a small hick up during the play.

So my question, does anybody have an idea if (and how) I can influence the popup menu (so I can select the "next" picture)?

Wim[/quote]

[Steegy]

I don't know any way to do what you want (except from using an external application that simulates a right-click on the album art window, and then figures out a way to simulate a left-click on the pop-up menu, to show the next image... but hey ).
Considering that what your script does is a know wish, I thought it might come in a future MM version natively. If this will take long (you should ask the MM devs about that), you can ask them a way to change the displayed album art in MediaMonkey, through scripting: Post your new scripting functionality wishes here.

Cheers
Steegy

[rovingcowboy]

How the world did i miss this thread i been wanting this now ever since mm3 when i got in to album art.

[SchulA]

sounds cool - that´s what I ´ve been waiting for.

It even would be cool to have a button for manually switching through the different album arts of a given song (not having to use the popup)...

[Peke]

Added as http://www.ventismedia.com/mantis/view.php?id=10406

[samatriXdigitaL]

I'm not able to install this script.
I've named it "CycleArt.vbs" and placed it in my MM "scripts" directory.
When I double click it I get the following error message.

Line: 3
Char: 11
Error: The requested operation requires elevation.
Code: 800702E4
Source: (null)

Running MM v 4.0.7.1511

Any help would be appreciated. It's a great idea.