'为PR生成歌词或提示字幕SRT
'line1 1 序号
'line2 00:00:00,000 --> 00:00:02,000 时长
'line3 文本
'line4 空行
Const myFPS = 25 '视频每秒帧数
Const filename = "F:\延时\荇菜\关雎0.SRT" 'SRT字幕文件名
Dim myTextList
'myTextList 为歌词，用半角逗号分隔,支持HTML
myTextList="诗经·国风·周南〔先秦〕@0,关关雎鸠，在河之洲。@5:16,窈窕淑女，君子好逑。@9:16,参差荇菜，左右流之。@24:16-28:16"
'@后 为每句字幕开始的时间，格式为时:分:秒:帧，前置时、分为0时可不写
'默认结束时间为下一句开始时间，如果不是，用-分隔加结束时间。最后一句必须有-
 
'运行前，请先配置上面的参数
'在PR中导入时，请先在字幕导入设置中预先设定好样式
myTextList=Split(myTextList,",")
 
Dim line,curText,curTime,SRTText
 
For line=0 To ubound(myTextList)
 curText=split(myTextList(line),"@")
 curTime=split(curText(1),"-")
 If ubound(curTime)=1 Then
 SRTText=SRTText & formatText(line+1,curTime(0),curTime(1),curText(0))
 Else
 SRTText=SRTText & formatText(line+1,curTime(0),split(split(myTextList(line+1),"@")(1),"-")(0),curText(0))
 End if
Next
Call saveToFile(filename,SRTText,"UTF-8BOM")
 
MsgBox line & " SRT ok"
Function formatText(line,startTime,endTime,strText)
 formatText = line & Chr(13)&Chr(10) & formatTimeStr(startTime) & " --> " &  formatTimeStr(endTime) & Chr(13)&Chr(10) & strText & Chr(13)&Chr(10) & Chr(13)&Chr(10)
End Function
 
Function byte2(n)
 byte2 = Right("0" & CInt(n),2)
End Function
 
Function formatTimeStr(TimeStr)
 Dim i
 TimeStr=Split("0:0:0:" & TimeStr,":")
 i=ubound(TimeStr)
 formatTimeStr = byte2(TimeStr(i-3)) & ":" & byte2(TimeStr(i-2)) & ":" & byte2(TimeStr(i-1)) & "," & Right("000" & int(1000*TimeStr(i)/myFPS),3)
End Function
 
Function saveToFile(fn,str,charset)
 
'可生成UTF-8格式的文件 charset=GB2312 、UTF-8、 UTF-8BOM
 Dim objStream,newStream
 Dim bom
 If UCase(charset)="UTF-8BOM" Then
 charset="UTF-8"
 bom=True
 Else
 bom=False
 End if
 Set objStream = CreateObject("ADODB.Stream")
 objStream.Type = 2 '文本 1 二进制
 objStream.Mode = 3 '读写
 objStream.charset=charset
 objStream.Open
 objStream.writetext Str
 If bom Then
 objStream.saveToFile fn,2
 Else
 objStream.Position = 3
 Set newStream = CreateObject("adodb.stream")
 With newStream
 .Mode = 3
 .Type = 1 '二进制
 .Open()
 End With
 objStream.CopyTo(newStream)
 newStream.SaveToFile fn,2
 newStream.close
 End If
 objStream.close
End Function