使VB编写的播放器支持外挂字幕SRT、ASS格式的文件

东方之珠 2010-02-11 11:31:22
本人花了很长时间研究外挂字幕SRT、ASS、SSA格式的文件,其编码之复杂,基本上能够用VB解析这些编码了。其目的,是想用VB编写的播放器直接支持SRT、ASS、SSA外挂字幕的自动和手工加载。虽然第三方外挂字幕插件VSFilter和AviSynth不错,但经常会遇到加载不上的问题,决定放弃,转而自己弄。Sub、IDX字幕我弄不来,但搞这些字幕还是可以的。现在有一个问题就是做的字幕太单调,没有立体感,就问一下大家像下面这个图显示的字体每个笔划的周围的黑色笔划是如何绘制出来的(注意不是字体阴影,是每个笔划周围的黑色),这种字体很漂亮,想摸仿:
...全文
728 12 打赏 收藏 举报
写回复
12 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
gukuang78 2010-02-27
  • 打赏
  • 举报
回复
学习中~~~~~~~~~
东方之珠 2010-02-12
  • 打赏
  • 举报
回复
引用 10 楼 wallescai 的回复:
引用楼主 chenjl1031 的回复:本人花了很长时间研究外挂字幕SRT、ASS、SSA格式的文件,其编码之复杂,基本上能够用VB解析这些编码了。其目的,是想用VB编写的播放器直接支持SRT、ASS、SSA外挂字幕的自动和手工加载。虽然第三方外挂字幕插件VSFilter和AviSynth不错,但经常会遇到加载不上的问题,决定放弃,转而自己弄。Sub、IDX字幕我弄不来,但搞这些字幕还是可以的。现在有一个问题就是做的字幕太单调,没有立体感,就问一下大家像下面这个图显示的字体每个笔划的周围的黑色笔划是如何绘制出来的(注意不是字体阴影,是每个笔划周围的黑色),这种字体很漂亮,想摸仿:
简单点的做法就是先用大一点的黑字写一遍,上面再用小一点的字写一遍


老蔡也来了,新春快乐!
你说的这个方法不行,会错位!所以必须采取填充的办法!
熊孩子开学喽 2010-02-11
  • 打赏
  • 举报
回复
引用楼主 chenjl1031 的回复:
本人花了很长时间研究外挂字幕SRT、ASS、SSA格式的文件,其编码之复杂,基本上能够用VB解析这些编码了。其目的,是想用VB编写的播放器直接支持SRT、ASS、SSA外挂字幕的自动和手工加载。虽然第三方外挂字幕插件VSFilter和AviSynth不错,但经常会遇到加载不上的问题,决定放弃,转而自己弄。Sub、IDX字幕我弄不来,但搞这些字幕还是可以的。现在有一个问题就是做的字幕太单调,没有立体感,就问一下大家像下面这个图显示的字体每个笔划的周围的黑色笔划是如何绘制出来的(注意不是字体阴影,是每个笔划周围的黑色),这种字体很漂亮,想摸仿:

简单点的做法就是先用大一点的黑字写一遍,上面再用小一点的字写一遍
东方之珠 2010-02-11
  • 打赏
  • 举报
回复
占沙发............
嗷嗷叫的老马 2010-02-11
  • 打赏
  • 举报
回复
收下了,嘿嘿.

在论坛晃就是能不断得到收获,哈哈.
东方之珠 2010-02-11
  • 打赏
  • 举报
回复
引用 6 楼 tiger_zhao 的回复:
简单就是美!


谢谢老鸟!不过有一个突出的问题:用像素座标的话,当字体较小时,填充的字体就会变成点阵状,这是不希望的结果,应该还是连续的。因为叠加在视频上的字幕是要随视频窗口的缩放而缩放的。所以我改成了缇座标,并且作了改进,这样就对了:
Option Explicit

Private Sub PrintText(ByVal x As Long, ByVal y As Long, ByVal Text As String)
Dim i As Long
Dim j As Long

Me.ForeColor = vbBlack

For i = -1 * Screen.TwipsPerPixelX To Screen.TwipsPerPixelX
For j = -1 * Screen.TwipsPerPixelY To Screen.TwipsPerPixelY
If (i > (-1 * Screen.TwipsPerPixelX / 3) And i < Screen.TwipsPerPixelX / 3) Or (j > (-1 * Screen.TwipsPerPixelY / 3) And j < Screen.TwipsPerPixelY / 3) Then
Me.ForeColor = vbWhite
Else
Me.ForeColor = vbBlack
End If
If i <> 0 Or j <> 0 Then Me.CurrentX = x + i: Me.CurrentY = y + j: Me.Print Text
Next
Next

Me.ForeColor = vbWhite
Me.CurrentX = x
Me.CurrentY = y
Me.Print Text

End Sub

Private Sub Form_Load()
Me.ScaleMode = 1 ' vbPixels
Me.AutoRedraw = True
Me.BackColor = &H40C0

Me.Font.Name = "黑体"
Me.Font.Size = 36

Me.Cls
PrintText 20 * Screen.TwipsPerPixelX, 20 * Screen.TwipsPerPixelY, "VB制作视频叠加字幕"
End Sub
kingsang 2010-02-11
  • 打赏
  • 举报
回复
顶一个顶一个顶一个顶一个
Tiger_Zhao 2010-02-11
  • 打赏
  • 举报
回复
简单就是美!
东方之珠 2010-02-11
  • 打赏
  • 举报
回复
引用 3 楼 tiger_zhao 的回复:
VB codeOptionExplicitPrivateSub PrintText(ByVal xAsLong, ByVal yAsLong, ByVal TextAsString)Dim iAsLongDim jAsLong

Me.ForeColor= vbBlackFor i=-1To1For j=-1To1If (i<>0)Or (j<>0)Then
?-


老鸟的不错,太好了!我记得,几年前蒋老大蒋晟(jiangsheng)给了一个网友办法,因为当时没有收藏,就是找不到!自己又不好意思向他提问!你的方法,没想到不用API,这么简单!过了春节后就结帐!
东方之珠 2010-02-11
  • 打赏
  • 举报
回复
引用 2 楼 myjian 的回复:
板凳........支持!!

新年好!!


嘿嘿,老马第一个来,提前祝大家春节快乐!
Tiger_Zhao 2010-02-11
  • 打赏
  • 举报
回复
Option Explicit

Private Sub PrintText(ByVal x As Long, ByVal y As Long, ByVal Text As String)
Dim i As Long
Dim j As Long

Me.ForeColor = vbBlack
For i = -1 To 1
For j = -1 To 1
If (i <> 0) Or (j <> 0) Then
Me.CurrentX = x + (i * 2)
Me.CurrentY = y + (j * 2)
Me.Print Text
End If
Next
Next

Me.ForeColor = vbWhite
Me.CurrentX = x
Me.CurrentY = y
Me.Print Text
End Sub

Private Sub Form_Load()
Me.ScaleMode = vbPixels
Me.AutoRedraw = True
Me.BackColor = &H40C0

Me.Font.Name = "黑体"
Me.Font.Size = 36

Me.Cls
PrintText 20, 20, "本字幕"
End Sub
嗷嗷叫的老马 2010-02-11
  • 打赏
  • 举报
回复
板凳........支持!!

新年好!!
相关推荐
发帖
多媒体

808

社区成员

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