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

[zhwj_lawyer]

这是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

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

[patrick_kong]

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

[东方之珠]

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

[baiyiqny]

自己也写过,我的可以按时间自己播放,也可以处理:
[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

[gukuang78]

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

[asong14437546]

学习中

[Gujianda]

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

[东方之珠]

据可靠消息,楼主已跑！

[IamDeane]

结帖率：0.00% 很经典

[烟熏牛肉干]

学习一下~~~