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

zhwj_lawyer 2010-02-09 05:55:07
这是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

上面时间标签后面的歌词在另一文本框中对应显示(每一句歌词都加有""并用逗号隔开),如:"我爱我的家","当爱情走了我又说什么",
"留下我一人撕守着","我在这里静静地等着" 
...全文
219 9 打赏 收藏 举报
写回复
9 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
烟熏牛肉干 2010-08-25
  • 打赏
  • 举报
回复
学习一下~~~
IamDeane 2010-03-16
  • 打赏
  • 举报
回复
结帖率:0.00% 很经典
东方之珠 2010-03-15
  • 打赏
  • 举报
回复
据可靠消息,楼主已跑!
Gujianda 2010-03-15
  • 打赏
  • 举报
回复
你的任务描述非常清楚到位,其实你已经完成了一半工作,除非你的VB基础很差。
asong14437546 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
  • 打赏
  • 举报
回复
:"我爱我的家","当爱情走了我又说什么", "留下我一人撕守着","我在这里静静地等着" 
相关推荐
发帖
多媒体

808

社区成员

VB 多媒体
社区管理员
  • 多媒体
加入社区
帖子事件
创建了帖子
2010-02-09 05:55
社区公告
暂无公告