Code: Select all

' Cover As Wallpaper script v.0.4
' By Wonda Waay, updated 2011-05-11
' 
' This script sets the cover of the current song as wallpaper
' if needed and a picture is available
' enable/disable switch in the view menu.
' In fact the job is done by the splendid program IrfanView
' that has to be installed (http://www.irfanview.com/)

' Tested with MediaMonkey 3.2.5 and Irfanview 4.30
'
' Location: MediaMonkey\Scripts\Auto\CoverAsWallpaper.vbs
'---------------------
Option Explicit

Dim AppTitle : AppTitle = "CoverAsWallpaper"
Dim Version : Version = "0.4"
Dim WallpaperEnabled : WallpaperEnabled = True
Dim MenuItem, PreviousAlbumArtist, PreviousAlbum

' To customize:
' Location where Irfanview has been installed; add (x86) for Win7 64b
Dim Irfanview : Irfanview = "C:\Program Files\IrfanView\i_view32.exe"
' Name of cover picture file (can be left blank to allways use embedded cover)
Dim WallPicName : WallPicName = "Cover.jpg"
' Two temporary files
Dim WallInfo : WallInfo = "C:\Temp\Cover.txt"	' to get Irfanview closed
Dim WallTemp : WallTemp = "C:\Temp\Cover.jpg"	' external copy of embedded image

'---------------------
Sub OnStartup()
   SDB.IniFile.StringValue(AppTitle,"Version") = Version

    If Not SDB.IniFile.ValueExists(AppTitle,"Enabled") Then
       SDB.IniFile.BoolValue(AppTitle,"Enabled") = WallpaperEnabled
    End If
    WallpaperEnabled = SDB.IniFile.BoolValue(AppTitle,"Enabled")

	Set MenuItem = SDB.UI.AddMenuItem(SDB.UI.Menu_View,1,8)
    MenuItem.Caption = "Wallpaper"
    Script.RegisterEvent MenuItem, "OnClick", "ToggleWallpaper"
    MenuItem.Visible = True
    MenuItem.Checked = WallpaperEnabled

	PreviousAlbumArtist = PreviousAlbum = ""	' fresh start

	If WallpaperEnabled Then
		Script.RegisterEvent SDB, "OnPlay", "WallpaperRefresh"
	End If
End Sub

Sub ToggleWallpaper(q)
    WallpaperEnabled = Not WallpaperEnabled
    MenuItem.Checked = WallpaperEnabled
    SDB.IniFile.BoolValue(AppTitle,"Enabled") = WallpaperEnabled

    If WallpaperEnabled Then
		Script.RegisterEvent SDB, "OnPlay", "WallpaperRefresh"
		WallpaperRefresh
    Else
        Script.UnregisterEvents SDB
		PreviousAlbumArtist = PreviousAlbum = ""	' fresh start next time
    End If
End Sub

Sub WallpaperRefresh()

	Dim itm, albumartist, album
	Set itm = SDB.Player.CurrentSong
	albumartist = itm.AlbumArtistName
	album = itm.AlbumName

	If albumartist = PreviousAlbumArtist And album = PreviousAlbum Then	 ' same album, same cover
		Exit Sub
	End If

	Dim jpgpath, fso, path, dir, albumart, image, tmpcover
	jpgpath = ""
	Set fso = SDB.Tools.FileSystem  
	If WallPicName <> "" Then	'	separate file in current directory?
		path =  itm.Path
		dir = Left(path,InStrRev(path,"\"))
		jpgpath = dir & WallPicName
		If fso.FileExists(jpgpath) = False Then
			jpgpath = ""
		End If
	End If
	If jpgpath = "" Then	'	now try image in the tag
		Set albumart = itm.AlbumArt 
		If albumart.count > 0 Then	'	is there any image 
			Set image = AlbumArt.Item(0).Image 
			Set tmpcover = fso.CreateTextFile( WallTemp, True) 
			tmpcover.WriteData Image.ImageData, Image.ImageDataLen 
			tmpcover.close 
			jpgpath = WallTemp
		End If
	End If
	Set fso = Nothing

	If jpgpath = "" Then	 '	No cover found: end of story
		Exit Sub
	End If

	Dim winshell, irfantask
	Set winshell = CreateObject("WScript.Shell")
	irfantask =  "/bf /wall=3 /info=" & Chr(34) & WallInfo & Chr(34)
	winshell.Run Chr(34) & Irfanview  & Chr(34) & " " & Chr(34) & jpgpath & Chr(34) & " " & irfantask, 7, 1
'	To prevent screen saver timeout
	winshell.SendKeys "%{F12}"
	Set winshell = Nothing

	PreviousAlbumArtist = albumartist
	PreviousAlbum = album

End Sub

Code: Select all

[ShowCover]
FileName=ShowCover.vbs
ProcName=ShowCover
Order=1
DisplayName=&ShowCover
Description=ShowCover
Language=VBScript
ScriptType=2

Code: Select all

Sub ShowCover 
  Set fso = SDB.Tools.FileSystem 

  Set itm = SDB.Player.CurrentSong

  Set AlbumArt = itm.AlbumArt

  if (AlbumArt.count > 0) Then

      Set Image = AlbumArt.Item(0).Image

      fname = "Cover.jpg"
      Set falbum = fso.CreateTextFile( "C:\tmp\Cover.jpg", True) 
      falbum.WriteData Image.ImageData, Image.ImageDataLen 

      falbum.close

      ' Prepare WScript.Shell object, which can be used for execution of applications
      Set WShell = CreateObject("WScript.Shell") 

      ' This WShell.Run is one long line, do not LINE WRAP
      WShell.Run "c:\bin\irfanview\i_view32.exe c:\tmp\Cover.jpg /silent /convert=c:\tmp\Cover.bmp", 7, 1

      WShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", "c:\tmp\Cover.bmp"
      WShell.RegWrite "HKCU\Control Panel\Desktop\TileWallpaper","1"
      WShell.run "rundll32.exe user32.dll,UpdatePerUserSystemParameters 1,True"

  end if

end sub