Lyric Timer 4.0 - Updated 03/08/2014

Teknojnky · Post by **Teknojnky** » Tue Mar 07, 2006 12:32 pm

Thats pretty nifty, but I get the following error when I try to run it..

Guest · Post by **Guest** » Tue Mar 07, 2006 6:50 pm

Trix,

I've just installed version 2 (having previously reported problems with prior version), and it's working a dream. Thank you.

The dockable panel also functions excellently. Thought I'd mention it, because I think this script is one of the first (that I've installed) which uses this. I understand it's a recent addition by the Developers.

I've now installed the Inline Lyrics script and tested with a newly timed set of Lyrics. It's brilliant.

One thought I had. Is it possible to hide the time brackets in the Lyrics tag?

Will continue to test out when more time available.

Thanks again.

trixmoto · Post by **trixmoto** » Wed Mar 08, 2006 4:54 am

@Teknojnky - This is a security issue, the script is being blocked from connecting to MM.

@Guest - "hide the time time brackets in the Lyrics tag" - I don't understand. You mean from the display panel? Or from the tag in the track? Or are you talking about Inline Lyrics?

Guest · Post by **Guest** » Wed Mar 08, 2006 5:32 am

Sorry I wasn't clear.

Right click properties of song; Lyrics tab. When viewing the Lyrics there, the time for each line is displayed before each line. Rather than just the Lyrics text. It strikes me that other scripts eg Detailed Song Info Panel which can display the Lyrics would also show this. Cosmetic thing.

trixmoto · Post by **trixmoto** » Wed Mar 08, 2006 5:36 am

So where would you like the time tags to be stored? They need to be stored somewhere.

Guest · Post by **Guest** » Wed Mar 08, 2006 6:56 am

It's not a problem. It's fine as it is.

Thanks.

Guest · Post by **Guest** » Wed Mar 15, 2006 6:43 pm

Trix,

The fixes on Inline lyrics have done wonders for the Lyric Timer. Thanks.

But I'm still getting the Com Server warning due to the Com object still running (despite closing). Trouble is, sometimes, but not always, this causes MM to lock up even though I've already closed it. The desktop freezes. It's no big deal, as I just close MM (Not responding) from the Task Manager to return control.

Even so, MM isn't always closing properly because of the (still) active Com object.

Is this one for the Developers?

NB I'm now running RC3.

trixmoto · Post by **trixmoto** » Thu Mar 16, 2006 4:08 am

No, I am currently fixing this problem. It's because the second script is still trying to access MM whilst MM's trying to close. This should be fixed in the next version.

trixmoto · Post by **trixmoto** » Mon Mar 20, 2006 11:32 am

New version (2.1) has been condensed into a single, more stable script file.

Code: Select all

'
' MediaMonkey Script
'
' NAME: LyricTimer 2.1
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 20/03/2006
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately
'
' FIXES: Combine with helper to create single script file
'
' [LyricTimer]
' FileName=LyricTimer.vbs
' ProcName=LyricTimer
' Order=17
' DisplayName=Lyric Timer
' Description=Add timings to lyrics
' Language=VBScript
' ScriptType=0
'

Option Explicit
Public styleOn
Dim Tmr,Data
Dim classname,curr,trax,isong
Dim OddColour, EvenColour, TextColour, HighlightColour

OddColour = "#FFFFFF"		'white
EvenColour = "#EFEFEF"		'silver
TextColour = "#000000"		'black
HighlightColour = "#FFFF77"	'yellow

Sub LyricTimer
  Dim Form
  Set Form = SDB.Objects("LyricTimer")
  If Form is Nothing Then
    Set Form = SDB.UI.NewDockablePersistentPanel("LyricPanel") 
    If Form.IsNew Then
      Form.DockedTo = 2
      Form.Common.Width = 250
    End If
    Form.Caption = "Lyric Timer"
  
    Dim Head
    Set Head = SDB.UI.NewPanel(Form)
    Head.Common.Align = 1
    Head.Common.Height = 25
    
    Dim Btn1
    Set Btn1 = SDB.UI.NewButton(Head)
    Btn1.Caption = "Revert back"
    Btn1.Common.Height = 25
    Btn1.Common.Width = 100
    Btn1.Common.Left = 0
    Btn1.UseScript = Script.ScriptPath
    Btn1.OnClickFunc = "BackClick"
  
    Dim Btn2
    Set Btn2 = SDB.UI.NewButton(Head)
    Btn2.Caption = "Save changes"
    Btn2.Common.Height = 25
    Btn2.Common.Width = 100
    Btn2.Common.Left = 100
    Btn2.UseScript = Script.ScriptPath
    Btn2.OnClickFunc = "SaveClick"
  
    Dim Btn3
    Set Btn3 = SDB.UI.NewButton(Head)
    Btn3.Caption = "Loop: No"
    Btn3.Common.ControlName = "Btn3"
    Btn3.Common.Height = 25
    Btn3.Common.Width = 100
    Btn3.Common.Left = 200
    Btn3.UseScript = Script.ScriptPath
    Btn3.OnClickFunc = "LoopClick"

    Dim WB
    Set WB = SDB.UI.NewActiveX(Form, "Shell.Explorer") 
    WB.Common.Align = 5
    WB.Common.ControlName = "WB" 
    If SDB.VersionHi=2 and SDB.VersionLo<5 Then WB.Interf.Navigate "about:"
    SDB.Objects("LyricDoc") = WB.Interf.Document
  Else
    If Form.Common.Visible Then
      Form.Common.Visible = False
      Exit Sub
    End If
  End If

  Form.Common.Visible = True
  SDB.Objects("LyricTimer") = Form
  SDB.Objects("LyricData") = Nothing
  
  Set Tmr = SDB.CreateTimer(100)
  Script.RegisterEvent Tmr, "OnTimer", "Update"
End Sub 

Sub Update(Timer)
  'update track list
  Dim song
  Set song = SDB.Player.CurrentSong
  If song is Nothing Then
    If classname = "" Then
      classname = "nosong"
      curr = 0
      trax = 0
      writedocument()
      Set Data = CreateObject("Scripting.Dictionary")
    End If
  Else
    If not song.ID = isong Then
      classname = ""
      curr = 0      
      isong = song.ID
      trax = extractlyrics()
      writedocument()
      SDB.Objects("LyricData") = Data
    End If
  End If
  
  'update track highlight
  Dim newcurr,doc
  newcurr = getcurr()
  If newcurr <> curr Then
    Set doc = SDB.Objects("LyricDoc")
    If curr > 0 Then
      doc.getElementById("row"&curr).className = classname
    End If
    classname = doc.getElementById("row"&newcurr).className
    doc.getElementById("row"&newcurr).className = "highlight"
    curr = newcurr
  End If
  
  'loop song
  Dim Form,Btn
  Set Form = SDB.Objects("LyricTimer")
  Set Btn = Form.Common.ChildControl("Btn3")
  If Btn.Caption = "Loop: Yes" Then
    If SDB.Player.CurrentSongLength > 0 Then
      If SDB.Player.PlaybackTime > SDB.Player.CurrentSongLength-3500 Then
        SDB.Player.PlaybackTime = 0
      End If
    End If
  End If
  
  'stop when hidden
  If Not Form.Common.Visible Then Script.UnregisterEvents Timer
  Set Btn = Nothing
  Set Form = Nothing
End Sub

Function getcurr()
  Dim indx
  getcurr = 1
  Do While getcurr<100
    indx = Data.Item("time"&(getcurr+1))
    If indx <> "" Then
      If SDB.Player.PlaybackTime > CLng(indx) Then
        getcurr = getcurr + 1
      Else
        Exit Do
      End If
    Else
      Exit Do
    End If
  Loop
End Function

Function settime(lng)
  Dim min,sec,hun,tint
  tint = lng\60000
  If tint < 10 Then 
    min = "0"&tint
  Else
    min = ""&tint
  End If 
  lng = lng - (tint*60000)
  tint = lng\1000
  If tint < 10 Then
    sec = "0"&tint
  Else
    sec = ""&tint
  End If
  lng = lng - (tint*1000)  
  tint = lng\10
  If tint < 10 Then
    hun = "0"&tint
  Else
    hun = ""&tint
  End If
  lng = lng - (tint*10)
  settime = "["&min&":"&sec&"."&hun&"]"
End Function

Function gettime(txt)
  Dim min,sec,hun,temp
  If Len(txt) = 8 Then
    temp = Mid(txt,1,2)
    If isNumeric(temp) Then min = Clng(temp)
    temp = Mid(txt,4,2)
    If isNumeric(temp) Then sec = Clng(temp)
    temp = Mid(txt,7,2)
    If isNumeric(temp) Then hun = Clng(temp)  
  End If
  gettime = min*60000 + sec*1000 + hun*10
End Function

Function simplify(txt)
  Dim a,b,c,d,l
  a = InStr(txt,"<")
  If a = 0 Then
    simplify = txt
    Exit Function
  End If
  b = InStr(txt,">")
  l = Len(txt)
  c = Mid(txt,1,a-1)
  If b = 0 Then b = a
  d = Mid(txt,b+1,l-b)
  txt = c&d
  a = InStr(txt,"<")
  If a > 0 Then txt = simplify(txt)
  simplify = txt
End Function

Function MapXML(original) 
   Dim hold 
   hold = Replace(original, "&", "&") 
   hold = Replace(hold, "  ", "&nbsp; ") 
   hold = Replace(hold, "<", "<") 
   hold = Replace(hold, ">", ">") 
   Dim i 
   i=1 
   While i<=Len(hold) 
      If (AscW(Mid(hold, i, 1))>127) Then 
         hold = Mid(hold, 1, i-1)+"&#"+CStr(AscW(Mid(hold, i, 1)))+";"+Mid(hold, i+1) 
      End If 
      i=i+1 
   WEnd 
   MapXML = hold 
End Function 

Function Style() 
  styleOn = Not styleOn 
  If styleOn Then 
    Style = "" 
  Else 
    Style = " class='dark'" 
  End If 
End Function 

Function extractlyrics()
  Dim song,lrc,ina,inp,str,pos,cur,txt

  Set Data = CreateObject("Scripting.Dictionary")
  Set song = SDB.Player.CurrentSong
  lrc = song.Lyrics
  trax = 0
  
  If lrc <> "" Then 
    ina = split(lrc,VBCrLf)
    inp = 0
  
    If Left(ina(inp),4) = "[ti:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.Title
    End If
    Data.Add "title", str
  
    If Left(ina(inp),4) = "[ar:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.ArtistName
    End If
    Data.Add "artist", str
  
    If Left(ina(inp),4) = "[au:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.Author
    End If
    Data.Add "author", str
  
    If Left(ina(inp),4) = "[al:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.AlbumName
    End If
    Data.Add "album", str

    If Left(ina(inp),4) = "[ve:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = "1.0"
    End If
    Data.Add "version", str
  
    For pos = inp to UBound(ina)
      trax = pos-inp+1
      If ina(pos) = "" Then
        Data.Add "time"&trax, "0"
        Data.Add "line"&trax, ""
      Else
        If Left(ina(pos),1) = "[" Then
          str = gettime(Mid(ina(pos),2,8))
          Data.Add "time"&trax, str
          str = Mid(ina(pos),11,Len(ina(pos))-10)
          Data.Add "line"&trax, str
        Else
          Data.Add "time"&trax, "0"
          Data.Add "line"&trax, ina(pos)
        End If
      End If
    Next
  End If
  extractlyrics = trax
End Function

Function writedocument()
  Dim doc
  Set doc = SDB.Objects("LyricDoc")
        
  doc.write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & vbcrlf 
  doc.write "<html>" & vbcrlf 
  doc.write "  <head>" & vbcrlf  
  doc.write "    <title>" & SDB.Localize("Lyric Timer") & "</title>" & vbcrlf 
  doc.write "  </head>" & vbcrlf 

  doc.write "  <STYLE TYPE=text/css>" & vbcrlf 
  doc.write "    body{font-family:'Verdana',sans-serif; background-color:"&OddColour&"; font-size:9pt; color:"&TextColour&";}" & vbcrlf 
  doc.write "    P{font-family:'Verdana',sans-serif; font-size:8pt; color:"&TextColour&";}" & vbcrlf 
  doc.write "    TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:"&TextColour&"; border-color:"&TextColour&"; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}" & vbcrlf 
  doc.write "    TD{font-family:'Verdana',sans-serif; font-size:8pt; color:"&TextColour&"; border-color:"&TextColour&"; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf 
  doc.write "    TR.highlight{background-color:"&HighlightColour&"}" & vbcrlf 
  doc.write "    TR.dark{background-color:"&EvenColour&"}" & vbcrlf 
  doc.write "    TR.aleft TH{text-align:left}" & vbcrlf 
  doc.write "  </STYLE>" & vbcrlf 
        
  doc.write "  <SCRIPT Language='VBScript'>" & vbcrlf
  doc.write "    Dim SDB,Data" & vbcrlf
  doc.write "    Set SDB = CreateObject(""SongsDB.SDBApplication"")" & vbcrlf
  doc.write "    Function gotopos (i)" & vbcrlf
  doc.write "      Set Data = SDB.Objects(""LyricData"")" & vbcrlf
  doc.write "      Data.Item(""time""&i) = SDB.Player.PlaybackTime" & vbcrlf
  doc.write "      document.getElementById(""span""&i).innerHTML = settime(Data.Item(""time""&i))" & vbcrlf
  doc.write "      SDB.Objects(""LyricsData"") = Data" & vbcrlf
  doc.write "    End Function" & vbcrlf
  doc.write "    Function settime(lng)" & vbcrlf
  doc.write "      Dim min,sec,hun,tint" & vbcrlf
  doc.write "      tint = lng\60000" & vbcrlf
  doc.write "      If tint < 10 Then " & vbcrlf
  doc.write "        min = ""0""&tint" & vbcrlf
  doc.write "      Else" & vbcrlf
  doc.write "        min = """"&tint" & vbcrlf
  doc.write "      End If " & vbcrlf
  doc.write "      lng = lng - (tint*60000)" & vbcrlf
  doc.write "      tint = lng\1000" & vbcrlf
  doc.write "      If tint < 10 Then" & vbcrlf
  doc.write "        sec = ""0""&tint" & vbcrlf
  doc.write "      Else" & vbcrlf
  doc.write "        sec = """"&tint" & vbcrlf
  doc.write "      End If" & vbcrlf
  doc.write "      lng = lng - (tint*1000)" & vbcrlf
  doc.write "      tint = lng\10" & vbcrlf
  doc.write "      If tint < 10 Then" & vbcrlf
  doc.write "        hun = ""0""&tint" & vbcrlf
  doc.write "      Else" & vbcrlf
  doc.write "        hun = """"&tint" & vbcrlf
  doc.write "      End If" & vbcrlf
  doc.write "      lng = lng - (tint*10)" & vbcrlf
  doc.write "      settime = ""[""&min&"":""&sec&"".""&hun&""]""" & vbcrlf
  doc.write "    End Function" & vbcrlf
  doc.write "  </SCRIPT>" & vbcrlf

  doc.write "  <body>" & vbcrlf  
  doc.write "    <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">" & vbcrlf  
  
  If trax > 0 Then
    doc.write "      <tr class=""aleft"">" & vbcrlf 
    doc.write "        <th></th>" & vbcrlf 
    doc.write "        <th>" & SDB.Localize("Timestamp") & "</th>" & vbcrlf 
    doc.write "        <th>" & SDB.Localize("Line") & "</th>" & vbcrlf  
    doc.write "      </tr>" & vbcrlf 
    Dim i
    For i = 1 To trax 
      doc.write "      <tr id='row"&i&"'" & Style() & ">" & vbcrlf
      doc.write "        <td><a href=""vbscript:gotopos("&i&")"">Line "&i&"</a></td>" & vbcrlf
      doc.write "        <td><span id='span"&i&"'>" & MapXML(settime(data.Item("time"&i))) & "</span></td>" & vbcrlf
      doc.write "        <td>" & MapXML(simplify(data.Item("line"&i))) & "</td>" & vbcrlf            
      doc.write "      </tr>" & vbcrlf 
    Next  
  Else
    doc.write "      <tr id='row1'" & Style() & ">" & vbcrlf
    doc.write "        <th colspan=3>There are no lyrics available for this song.</th>" & vbcrlf  
    doc.write "      </tr>" & vbcrlf
  End If
  
  doc.write "    </table>" & vbcrlf
  doc.write "  </body>" & vbcrlf 
  doc.write "</html>" & vbcrlf 
  doc.close
  writedocument = True
End Function

Sub BackClick (ClickedBtn)
  Dim res,str,WShell
  res = SDB.MessageBox("Are you sure you wish to undo your changes?",mtConfirmation,Array(mbOk,MbCancel))
  If res = 1 Then
    isong = -1
  End If
End Sub

Sub SaveClick (ClickedBtn)
  Dim res,str,pos,lng,song
  res = SDB.MessageBox("Are you sure you wish to save your changes?",mtConfirmation,Array(mbOk,mbCancel))
  If res = 1 Then
    str = ""
    pos = 1
  
    If Data.Item("title") <> "" Then 
      str = str&"[ti:"&Data.Item("title")&"]"&vbcrlf
    End If    
    If Data.Item("artist") <> "" Then 
      str = str&"[ar:"&Data.Item("artist")&"]"&vbcrlf
    End If    
    If Data.Item("author") <> "" Then 
      str = str&"[au:"&Data.Item("author")&"]"&vbcrlf
    End If    
    If Data.Item("album") <> "" Then 
      str = str&"[al:"&Data.Item("album")&"]"&vbcrlf
    End If
    If Data.Item("version") <> "" Then 
      str = str&"[ve:"&Data.Item("version")&"]"&vbcrlf
    End If
    
    Do While Data.Item("time"&pos) <> "" 
      lng = Clng(Data.Item("time"&pos))
      If Right(str,2) <> vbcrlf Then str=str&vbcrlf
      str = str&settime(lng)
      str = str&Data.Item("line"&pos)
      pos = pos + 1
    Loop
    
    Set song = SDB.Player.CurrentSong
    song.Lyrics = str
    song.UpdateDB
  End If
End Sub

Sub LoopClick (ClickedBtn)
  If ClickedBtn.Caption = "Loop: Yes" Then
    ClickedBtn.Caption = "Loop: No"
  Else
    ClickedBtn.Caption = "Loop: Yes"
  End If
End Sub

Guest · Post by **Guest** » Mon Mar 20, 2006 12:50 pm

Trixmoto,

LyricTimer 2.1 is throwing up loads of errors and won't run at all. I can't tell you what the errors are because a general error box is covering them up. This error dialogue is blinking and locking everything up, so I have to close MM from Task Manager.

Also - In the Add/Remove properties, MediaMonkey has been replaced by:

MediaMonkey Script - LyricTimer 2.1

...but it's MediaMonkey's uninstall string, not LyricTimer's!

trixmoto · Post by **trixmoto** » Mon Mar 20, 2006 2:24 pm

Well I don't get the errors so unless you can give me a hint, I've nothing to fix.

The Inno Setup Installer program I use to create the installers for my scripts does change the name of the MediaMonkey uninstall, but that's all. You'll find this will all the installers.

Guest · Post by **Guest** » Mon Mar 20, 2006 2:30 pm

OK. No offence intended.

I'll have another go with it, and see what I can find. I'll get back to you. Thanks.

Guest · Post by **Guest** » Mon Mar 20, 2006 3:26 pm

Update.

I've tried manually adding the script as well as re-running the installer, but I'm still getting the following:

1. A dialogue box which says "Error executing script event"

2. This is covering up a dialogue which is displaying the runtime error. If I ok or attempt to move 1. - it copies itself.

I can make out this much of the runtime error:

Error #424.......................................................Line 131 Column 4

(which I think is an object required problem). The line is:

Code: Select all

    classname = doc.getElementById("row"&newcurr).className

NB The player continues to play, but because the errors are stealing focus, I have to ctrl-alt-del the app.

trixmoto · Post by **trixmoto** » Mon Mar 20, 2006 3:48 pm

Yes, unfortunately because the timer is set to run every 100ms so you get a good update speed, once an error occurs you get too many message to deal with (10 a second!) - can't find a way to catch these properly.

I will look at this line and see if I can work out the problem.

Cheers for your help

Orthimnas · Post by **Orthimnas** » Thu Apr 27, 2006 12:39 pm

I was having the same problem, where I would get an error dialog with general errors over it.

I got it to work flawlessly by making the following adjustments:
1) In internet explorer, changing my "Internet" security settings to enable "Initialize and script ActiveX controls not marked as safe"
2) Added in a reference to Data in Sub SaveClick - updated code:

Code: Select all

Sub SaveClick (ClickedBtn)
  Dim res,str,pos,lng,song,Data
  res = SDB.MessageBox("Are you sure you wish to save your changes?",mtConfirmation,Array(mbOk,mbCancel))
  Set Data = SDB.Objects("LyricData")
  If res = 1 Then
    str = ""
    pos = 1
  
    If Data.Item("title") <> "" Then 
      str = str&"[ti:"&Data.Item("title")&"]"&vbcrlf
    End If    
    If Data.Item("artist") <> "" Then 
      str = str&"[ar:"&Data.Item("artist")&"]"&vbcrlf
    End If    
    If Data.Item("author") <> "" Then 
      str = str&"[au:"&Data.Item("author")&"]"&vbcrlf
    End If    
    If Data.Item("album") <> "" Then 
      str = str&"[al:"&Data.Item("album")&"]"&vbcrlf
    End If
    If Data.Item("version") <> "" Then 
      str = str&"[ve:"&Data.Item("version")&"]"&vbcrlf
    End If
    
    Do While Data.Item("time"&pos) <> "" 
      lng = Clng(Data.Item("time"&pos))
      If Right(str,2) <> vbcrlf Then str=str&vbcrlf
      str = str&settime(lng)
      str = str&Data.Item("line"&pos)
      pos = pos + 1
    Loop
    
    Set song = SDB.Player.CurrentSong
    song.Lyrics = str
    song.UpdateDB
  End If
  Set Data = Nothing
End Sub

Now it works perfectly - except that little COM error. It doesn't freeze my system, but it does make me click "Yes" to allow closing. It seems to be hinged on the use of Internet Explorer. Even if I close it before I close MM, it gives me the error.

Thanks for a great product!
~ Orthimnas ~

Lyric Timer 4.0 - Updated 03/08/2014

My solution