用VB提取LRC歌词和时间标签

2010-02-09 05:55:07 353 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

VB实现的Lrc歌词编辑器全面解析 LRC是一种专门用于显示歌词的文本格式，它通过在文本的每行上标注时间戳，来控制歌词的同步显示。标准的LRC文件通常由时间标签和随后的歌词文本组成，每对标签和文本对在文件中占据一行。时间标签以方括号[]开始，后面紧跟着时间，格式通常为[mm:ss全场]，其中mm代表分钟，ss代表秒数，场代表毫秒。阅读详情

这是LRC歌词的一部分
在一个文本框中粘贴输入如下LRC歌词
：
[02:49.73]我爱我的家
[02:56.11]当爱情走了我又说什么
[03:03.59]留下我一人撕守着
[03:09.89]我在这里静静地等着

把中括号内的数字（例如02:49.73）提取并按如下公式计算：（02*60+49.73）*1000　所得的结果从小到大排列并每两个结果中间加上一个逗号，例如：（02*60+49.73）*1000＝169730　　（02*60+56.11）*1000＝176110　　　（03*60+03.59）*1000＝183590　　（03*60+09.89）*1000＝189890　

上面中括号内时间经过计算后，在一个文本框中显示这些计算结果并用逗号隔开，如：　169730,176110,183590,189890

上面时间标签后面的歌词在另一文本框中对应显示(每一句歌词都加有""并用逗号隔开)，如："我爱我的家","当爱情走了我又说什么",
"留下我一人撕守着","我在这里静静地等着"　

...全文

自己编的lrc歌词解析类【标签】：“lrc 歌词解析 wince”“lrc”标签明确了该解析类处理的是LRC歌词文件。“歌词解析”则意味着这个类的主要功能是对LRC文件进行解析，提取出歌词的时间戳和内容信息。立即下载

zhwj_lawyer

多媒体 807 成员 8,274 内容

+ 关注 + 加入社区

切换为时间正序

烟熏牛肉干 2010-08-25

打赏
举报

学习一下~~~

IamDeane 2010-03-16

打赏
举报

结帖率：0.00% 很经典

东方之珠 2010-03-15

打赏
举报

据可靠消息,楼主已跑！

Gujianda 2010-03-15

打赏
举报

你的任务描述非常清楚到位，其实你已经完成了一半工作，除非你的VB基础很差。

宝点梁山好汉 2010-03-15

打赏
举报

学习中

gukuang78 2010-02-27

打赏
举报

学习中~~~~~~~~~

baiyiqny 2010-02-21

打赏
举报

自己也写过,我的可以按时间自己播放,也可以处理:
[00:00.20][00:12.25]******
做的是一个控件,两个时间控件,一个图片框,试试,可以用,呵!



Private Type LRCContent

        Ctime As Long

        CContent As String

End Type

Private Type LrcHead

        MusicName As String

        MusicPeople As String

        MusicUrl As String

        MusicOff As Long

End Type

Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Event Click()

Public Event DblClick()

Private CFilePath As String, CFileContent As String

Private CLRCTimeList() As LRCContent

Private MusicContent As LrcHead

Private PlayOff As Long, LondOK As Boolean, tmptim As Long, timeroff As Long

Private oldFontSize As Long

Public Property Let LrcFilePath(tmp As String)

LondOK = False

If Dir(tmp) <> "" And tmp <> "" Then CFilePath = tmp Else If MsgBox("无法找到你指定的文件", vbOKCancel, "ERROR") = vbOK Then Exit Property Else Exit Property

Open CFilePath For Binary As #1

Dim c() As Byte, t As Long

t = FileLen(CFilePath)

ReDim c(t + 1)

Get #1, , c

Close #1

c(t) = CByte(Asc("["))

CFileContent = StrConv(c, vbUnicode)

ContentSelect CFileContent

Call LrcListXU

LondOK = True

End Property

Public Property Get LrcFilePath() As String

LrcFilePath = CFilePath

End Property

Public Property Get LrcMusicName() As String

LrcMusicName = MusicContent.MusicName

End Property

Public Property Get LrcMusicPeople() As String

LrcMusicPeople = MusicContent.MusicPeople

End Property



Private Sub Picture1_Click()

RaiseEvent Click

End Sub



Private Sub Picture1_DblClick()

RaiseEvent DblClick

End Sub



Private Sub Picture1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

If Dir(Data.Files.Item(1)) <> "" Then

  If Right(Dir(Data.Files.Item(1)), 4) = ".lrc" Then

   LrcFilePath = Data.Files.Item(1)

   Form1.Caption = MusicContent.MusicName

   BeginPlay

  End If

End If

End Sub



Private Sub Timer1_Timer(Index As Integer)

On Error GoTo E:

DrawPicture

Timer1(Index).Enabled = False

PlayOff = PlayOff + 1

tmptim = GetTickCount

If CLRCTimeList(PlayOff + 1).Ctime Then



   Timer1(Index).Interval = CLRCTimeList(PlayOff + 1).Ctime * 10 - (tmptim - timeroff)

Else

   Timer1(Index).Enabled = False

End If

If Timer1(Index).Interval > 0 Then

   Timer1(Index).Enabled = True

Else

   Timer1(Index).Enabled = False

End If

Exit Sub

E:

 Timer1(Index).Enabled = False

End Sub



Private Sub UserControl_Initialize()

oldFontSize = Picture1.FontSize

End Sub



Private Sub UserControl_Resize()



With Picture1

          .Height = UserControl.ScaleHeight

          .Top = 0

End With

DrawPicture

End Sub

Private Function ContentSelect(CContent As String) As Boolean

Dim i As Long, ContentSize As Long, tmp As String, MainBoolean As Boolean, j As Long

Dim Zin As String, Zon As String, LrcOff As Long

ContentSize = Len(CContent)

If ContentSize < 2 Then Exit Function

ReDim CLRCTimeList(1)

LrcOff = 0

For i = 1 To ContentSize

   tmp = Mid(CContent, i, 1)

   Select Case tmp

          Case "["

                 MainBoolean = True

                 If Zin <> "" Then

                    Select Case Left(Zin, 2)

                           Case "ti": MusicContent.MusicName = Right(Zin, Len(Zin) - 3)

                           Case "ar": MusicContent.MusicPeople = Right(Zin, Len(Zin) - 3)

                           Case "al" ': List1.AddItem "xxx：------" & Right(Zin, Len(Zin) - 3)

                           Case "by": MusicContent.MusicUrl = Right(Zin, Len(Zin) - 3)

                           Case "of": MusicContent.MusicOff = CLng(Right(Zin, Len(Zin) - 7))

                           Case "00" To "99"

                                    CLRCTimeList(UBound(CLRCTimeList) - 1).Ctime = Clong(Zin)

                                    ReDim Preserve CLRCTimeList(UBound(CLRCTimeList) + 1)

                                    If Zon <> "" Then

                                       For j = LrcOff To UBound(CLRCTimeList) - 2

                                           CLRCTimeList(j).CContent = Zon

                                       Next j

                                           LrcOff = UBound(CLRCTimeList) - 1

                                    End If

                    End Select

                 End If

                 Zin = ""

          Case "]"

                 MainBoolean = False

                 Zon = ""

          Case Else

               If MainBoolean Then

                  Zin = Zin & tmp

               Else

                  Zon = Zon & tmp

               End If

   End Select

Next i

ReDim Preserve CLRCTimeList(UBound(CLRCTimeList) - 1)

End Function

Private Function Clong(tmp) As Long

Dim j As Integer

  Select Case TypeName(tmp)

         Case "String"

               If Len(tmp) = 8 Then Clong = CLng(Right(tmp, 2)) + CLng(Mid(tmp, 4, 2)) * 100 + CLng(Left(tmp, 2)) * 60 * 100

         Case Else

              Picture1.Cls

              Picture1.CurrentX = 0

              Picture1.CurrentY = 0

              Picture1.FillColor = RGB(255, 0, 0)

              Picture1.Print TypeName(tmp)

              Picture1.Refresh

  End Select

End Function



Public Function LrcList() As ListBox

LrcList = List1

End Function

Public Function LrcRefresh() As Boolean

Dim i As Long

For i = 0 To UBound(CLRCTimeList) - 1

    List1.AddItem CDateString(CLRCTimeList(i).Ctime) & "  " & CLRCTimeList(i).CContent

Next i

End Function

Private Function CDateString(tmp As Long) As String '把长整型转换为时间格式的字符串

Dim s As String

s = CStr(tmp Mod 100)

If Len(s) = 1 Then s = "0" & s

s = CStr((tmp \ 100) Mod 60) & "." & s

If Len(s) = 4 Then s = "0" & s

s = CStr((tmp \ 100) \ 60) & ":" & s

If Len(s) = 7 Then s = "0" & s

CDateString = s

End Function

Private Function LrcListXU() As Boolean

On Error GoTo E

Dim tmp As LRCContent

Dim tmplong As Long

tmplong = UBound(CLRCTimeList) - 1

Do While tmplong

  For i = 0 To tmplong - 1

      If CLRCTimeList(i).Ctime > CLRCTimeList(i + 1).Ctime Then

         tmp = CLRCTimeList(i + 1)

         CLRCTimeList(i + 1) = CLRCTimeList(i)

         CLRCTimeList(i) = tmp

      End If

  Next i

  tmplong = tmplong - 1

Loop

LrcListXU = True

Exit Function

E:

 LrcListXU = False

End Function

Public Sub BeginPlay()

Dim tmp As Long, i As Long

'tmp = UBound(CLRCTimeList)

'If tmp > Timer1.Count Then

' For i = 0 To tmp - Timer1.Count

'    Load Timer1(Timer1.Count)

    'Timer1(Timer1.Count - 1).Enabled = True

' Next i

'End If

timeroff = GetTickCount

PlayOff = 0

For i = 0 To 1

   Timer1(i).Enabled = False

   Timer1(i).Interval = CLRCTimeList(i).Ctime * 10

   Timer1(i).Enabled = True

Next i

End Sub

Public Function StopPlay() As Boolean

Static bb As Boolean, kk As Long

If bb Then bb = False Else bb = True

If bb Then

   Timer1(0).Enabled = False

   Timer1(1).Enabled = False

   StopPlay = False

Else

   timeroff = timeroff + (GetTickCount - tmptim)

   Timer1(0).Enabled = True

   Timer1(1).Enabled = True



   StopPlay = True

End If

End Function

Private Sub DrawPicture()

If LondOK = False Then Exit Sub

Dim bh As Long, bw As Long, tmpfont As Long, sh As Long, sw As Long, t1 As Boolean, t2 As Boolean, d As Long

d = 0

t1 = True

t2 = True

Picture1.FontSize = oldFontSize / 2

bh = Picture1.TextHeight(CLRCTimeList(PlayOff).CContent)

bw = Picture1.TextWidth(CLRCTimeList(PlayOff).CContent)

Picture1.Cls

Picture1.CurrentX = (Picture1.ScaleWidth - bw) / 2

Picture1.CurrentY = (Picture1.ScaleHeight - bh) / 2

Picture1.ForeColor = RGB(255, 255, 0)

Picture1.Print CLRCTimeList(PlayOff).CContent

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Picture1.FontSize = oldFontSize / 2 - 3

Picture1.ForeColor = &H80000011

sh = Picture1.TextHeight("0") + 2

Do While (t1 Or t2)

    d = d + 1

    If PlayOff - d >= 0 And Picture1.CurrentY > 0 Then

       sw = Picture1.TextWidth(CLRCTimeList(PlayOff - d).CContent)

       Picture1.CurrentX = (Picture1.ScaleWidth - sw) / 2

       Picture1.CurrentY = (Picture1.ScaleHeight - bh) / 2 - d * sh

       Picture1.Print CLRCTimeList(PlayOff - d).CContent

       t1 = True

    Else

       t1 = False

    End If

    If PlayOff + d < UBound(CLRCTimeList) And Picture1.CurrentY < Picture1.ScaleHeight Then

       sw = Picture1.TextWidth(CLRCTimeList(PlayOff + d).CContent)

       Picture1.CurrentX = (Picture1.ScaleWidth - sw) / 2

       Picture1.CurrentY = (Picture1.ScaleHeight - bh) / 2 + d * sh + 5

       Picture1.Print CLRCTimeList(PlayOff + d).CContent

       t2 = True

    Else

       t2 = False

    End If

Loop

End Sub

东方之珠 2010-02-10

打赏
举报

LRC歌词分析:
http://blog.csdn.net/chenjl1031/archive/2007/12/20/1955447.aspx

patrick_kong 2010-02-10

打赏
举报

："我爱我的家","当爱情走了我又说什么", "留下我一人撕守着","我在这里静静地等着"　

用VB提取LRC歌词和时间标签

相关推荐