Option ExplicitPrivate Type TextAndTimeText As String '输出的数据(无标签)Time As Single '分+秒=秒(一秒为单位)End TypePublic LrcType() As TextAndTime '歌词数据管理Public LrcTypeNum As Long 'Lrc数据数量Private Offset As Long '延迟多少毫秒'Lrc歌词文件解析Public Sub MainFun(ByVal LrcText As String,ByVal TimeSecond As Single,OutText() As String,NextSong As Boolean) '主调解析(直接调用)'LrcText=Lrc文本的全部数据 -> TimeSecond=现在已经播放到多少秒了 -> OutText=要输出的文本(上一句+现在) -> 是否是下一首歌了Dim i As Long '循环(现在要显示的)Dim MaxTime As Long '遍历的最大的时间(不超过正在播放的时间秒数)Dim OutMaxTime As Long '输出的数组索引Dim ii As Long '下一句要显示的Dim MixTime As Long '记录最小的时间(超过正在播放的时间秒数)Dim OutNextTime As Long '下一句要显示的Dim OutMinTime As Long '输出的数组索引If LrcText = "" Then 'Lrc为空 Exit Sub '退出不显示End IfIf NextSong = False Then '还是这一首song MaxTime = -1 For i = 0 To UBound(LrcType) '循环遍历数组(找出小于等于当前播放时间) 上一句 If (LrcType(i).Time < TimeSecond) And (LrcType(i).Time > MaxTime) Then MaxTime = LrcType(i).Time '记录这个最合适的 OutMinTime = i End If Next i '此时i为当前显示最合适的 MixTime = 9999999 For ii = 0 To UBound(LrcType) '循环遍历数组(当前时间秒数最大的与第二大的) 现在 If (LrcType(ii).Time >= TimeSecond) And (LrcType(ii).Time < MixTime) Then MixTime = LrcType(ii).Time '记录这个最合适的 OutMaxTime = ii End If Next ii MaxTime = 9999999 For i = 0 To UBound(LrcType) '循环遍历数组(找出小于等于当前播放时间) 下一句 If (LrcType(i).Time > TimeSecond) And (LrcType(i).Time < MaxTime) And (LrcType(i).Time > LrcType(OutMaxTime).Time) Then MaxTime = LrcType(i).Time '记录这个最合适的 OutNextTime = i End If Next i '此时ii为下一句显示最合适的 OutText(0) = LrcType(OutMinTime).Text '输出 OutText(1) = LrcType(OutMaxTime).Text OutText(2) = LrcType(OutNextTime).Text Exit SubEnd If'不是这一首了LrcTypeNum = 0Offset = 0 '延迟为0 Ms'ReDim OutText(1) '重定义以免空间不足或者其他错误Erase LrcType()ReDim LrcType(0) '没有数据OutText(0) = ""OutText(1) = ""OutText(2) = ""'正式开始解析LrcText = Replace(LrcText,".",":") '因为疏忽以为时间标签里面.为: 特在此替换全部Call ManyLabelsCon(LrcText) '转换多标签为单标签Do '循环处理 Call FindAndConLabel(LrcText) '找出要处理的标签Loop While (LrcText <> "") 'LrcText不为空就继续处理'处理完毕MaxTime = -1For i = 0 To UBound(LrcType) '循环遍历数组(找出小于等于当前播放时间) If (LrcType(i).Time < TimeSecond) And (LrcType(i).Time > MaxTime) Then MaxTime = LrcType(i).Time '记录这个最合适的 OutMaxTime = i End IfNext i'此时i为当前显示最合适的MixTime = 9999999For ii = 0 To UBound(LrcType) '循环遍历数组(当前时间秒数最大的与第二大的) If (LrcType(ii).Time > TimeSecond) And (LrcType(ii).Time < MixTime) Then MixTime = LrcType(ii).Time '记录这个最合适的 OutMinTime = ii End IfNext ii'nexttime=For i = 0 To UBound(LrcType) '循环遍历数组(找出小于等于当前播放时间) 现在 If (LrcType(i).Time > TimeSecond) And (LrcType(i).Time < MaxTime) Then MaxTime = LrcType(i).Time '记录这个最合适的 OutNextTime = i End IfNext i'此时ii为下一句显示最合适的OutText(0) = LrcType(OutMaxTime).Text '输出(上 中 下)OutText(1) = LrcType(OutMinTime).TextOutText(2) = LrcType(OutNextTime).TextNextSong = False '现在是这一首了End SubPrivate Sub FindAndConLabel(LrcText As String) '寻找和处理标签(包括多标签)On Error Resume Next'LrcText=Lrc文本的全部数据Dim ConLabel As String '要处理的标签String([*.*]XXX)Dim ConText As String '要处理的标签后面的Text(歌词)'Call ManyLabelsCon(LrcText) '处理多标签ConLabel = "[" & MIDEx(LrcText,"[","]") & "]" '取出标签If InStr(InStr(1,LrcText,vbTextCompare) + 1,vbTextCompare) = 0 Then '已经是最后一个标签了 ConText = Right(LrcText,Len(LrcText) - InStr(1,"]",vbTextCompare)) LrcText = ""Else '还有标签 ConText = MIDEx(LrcText,"[") '取出歌词End IfCall LabelCon(ConLabel & ConText) '解析标签LrcText = Right(LrcText,Len(LrcText) - Len("[" & MIDEx(LrcText,"["))) '将处理掉的歌词从处理列队中删除End SubPrivate Sub LabelCon(ByVal LabelAndText As String) '解析标签On Error Resume Next'LabelAndText=标签与标签后的文本LrcTypeNum = LrcTypeNum + 1 '处理的标签数量+1ReDim Preserve LrcType(LrcTypeNum) '加宽数据数组'解析[]Dim MIDLabel As String '[]里面的(不含[])MIDLabel = MIDEx(LabelAndText,"]") '取出Label里面的If LabelAndText = "" Then '错误的标签 Exit SubEnd If'注释标签If MIDLabel = ":" Then '注释标签 Exit Sub '退出过程End If'其他标签If LCase(left(MIDLabel,6)) = "offset" Then '如果是延迟 '取出并且设置延迟 Offset = Val(Right(MIDLabel,Len(MIDLabel) - InStr(1,MIDLabel,":",vbTextCompare)))End IfIf LCase(left(MIDLabel,2)) = "ti" Then '歌词标题 Exit SubEnd IfIf LCase(left(MIDLabel,2)) = "ar" Then '艺术家 Exit SubEnd IfIf LCase(left(MIDLabel,2)) = "al" Then '歌曲类型 Exit SubEnd IfIf LCase(left(MIDLabel,2)) = "by" Then '歌曲类型 Exit SubEnd If'时间标签=[mm:ss]/[mm:ss:ms]'判断是哪一种Dim TimeType() As StringTimeType = Split(MIDLabel,vbTextCompare)If UBound(TimeType) = 1 Then '第一种[mm:ss] LrcType(LrcTypeNum).Time = (Val(TimeType(0)) * 60) + (Val(TimeType(1))) + Val(Offset / 1000) 'mm*60+ss(+offset/1000)=ssElse '第二种[mm:ss:ms] LrcType(LrcTypeNum).Time = Val((Val(TimeType(0)) * 60) + (Val(TimeType(1))) + (Val(TimeType(2)) / 1000) + Val(Offset / 1000)) 'mm*60+ss+ms/1000(+offset/1000)=ssEnd IfLrcType(LrcTypeNum).Time = Format(LrcType(LrcTypeNum).Time,"0.000")LrcType(LrcTypeNum).Text = Right(LabelAndText,Len(LabelAndText) - InStr(1,LabelAndText,vbTextCompare)) '获取歌词End SubPrivate Sub ManyLabelsCon(LrcText As String) '将所有多标签替换为单标签On Error Resume Next'判断是否为多标签:判断]后面跟的是不是[就能判断是否为多标签Dim LabelAndTextArg() As String '多标签+文本分割Dim LabelCount As Long '标签数量Dim LabelAndText As String '多标签+文本Dim StartPlace,Endplace,IfStartPlace As Long '多标签+文本开始位置([的位置) 结束位置(文本最后一个字符) 走到哪里Dim i As LongStartPlace = 1 '变量初始化LabelCount = 1 '重置标签总数(设想下一个为单标签)IfStartPlace = 1Endplace = 0'LabelCount = 1 '至少有一个标签'判断是否为多标签StartPlace = InStr(StartPlace,vbTextCompare) '找到第一个[IfStartPlace = StartPlaceDo If InStr(InStr(IfStartPlace,vbTextCompare) - IfStartPlace - (InStr(IfStartPlace,vbTextCompare) - IfStartPlace) = 1 Then ']后面为[则为多标签 LabelCount = LabelCount + 1 '标签总数+1 If InStr(IfStartPlace + 1,vbTextCompare) <> 0 Then '再往后能找到] IfStartPlace = InStr(IfStartPlace + 1,vbTextCompare) '赋值 Else '找不到] Exit Do '不find了 End If Else ']后面不是[说明不是单标签或多标签结束 If LabelCount <= 1 Then '单标签 LabelCount = 1 '重置标签总数(设想下一个为单标签) StartPlace = InStr(StartPlace + 1,vbTextCompare) '跳过这个单标签 找到下一个[标签 If StartPlace = 0 Then '没有标签了 Exit Sub End If IfStartPlace = StartPlace Else '多标签(添加到数据管理里面并从LrcText中删除) Endplace = InStr(IfStartPlace + 1,vbTextCompare) - 1 '最后一个字符为下一个标签的前一个字符 If Endplace = -1 - StartPlace Then '没有找到下面的标签(没有标签了) Endplace = Len(LrcText) End If If Endplace = -1 Then '没有找到下面的标签(没有标签了) Endplace = Len(LrcText) End If '截取[XXX][XXX]...Text并储存 LabelAndText = MID(LrcText,StartPlace,Endplace + 1 - StartPlace) '取出标签 '分解 LabelAndTextArg() = Split(LabelAndText,vbTextCompare) For i = 0 To UBound(LabelAndTextArg) - 1 '遍历所有标签(此处-1表示不包括Text) LabelAndTextArg(i) = LabelAndTextArg(i) & "]" '补上丢失的] LabelAndTextArg(i) = MIDEx(LabelAndTextArg(i),"]") '取出[]里面的 If left(LCase(LabelAndTextArg(i)),6) = "offset" Then '偏移 Offset = Val(Right(LabelAndTextArg(i),Len(LabelAndTextArg(i)) - InStr(1,LabelAndTextArg(i),vbTextCompare))) End If LrcTypeNum = LrcTypeNum + 1 '处理的标签数量+1 ReDim Preserve LrcType(LrcTypeNum) '加宽数据数组 Dim TimeType() As String TimeType = Split(LabelAndTextArg(i),vbTextCompare) '类型 If UBound(TimeType) = 1 Then '第一种[mm:ss] LrcType(LrcTypeNum).Time = (Val(TimeType(0)) * 60) + (Val(TimeType(1))) + Val(Offset / 1000) 'mm*60+ss(+offset/1000)=ss Else '第二种[mm:ss:ms] LrcType(LrcTypeNum).Time = (Val(TimeType(0)) * 60) + (Val(TimeType(1))) + (Val(TimeType(2)) / 1000) + Val(Offset / 1000) 'mm*60+ss+ms/1000(+offset/1000)=ss End If LrcType(LrcTypeNum).Text = LabelAndTextArg(UBound(LabelAndTextArg)) '取出文本 Next i '删除这个多标签 LrcText = left(LrcText,StartPlace - 1) & Right(LrcText,Len(LrcText) - Endplace) '重置 向下查找其他多标签 StartPlace = InStr(StartPlace,vbTextCompare) '重新找到第一个[ IfStartPlace = StartPlace LabelCount = 1 '至少有一个标签 End If End IfLoop While Not (InStr(IfStartPlace,vbTextCompare) = 0) '找不到最后的]就退出循环End SubPrivate Function MIDEx(ByVal LabelAndText As String,ByVal Firstring As String,ByVal SecString As String) As String '取出指定文本On Error Resume NextDim a As Longa = InStr(1,Firstring,vbTextCompare) + 1MIDEx = MID(LabelAndText,a,InStr(a,SecString,vbTextCompare) - a)End Function 总结 以上是内存溢出为你收集整理的VB Lrc歌词解析源码全部内容，希望文章能够帮你解决VB Lrc歌词解析源码所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）