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

东方之珠 2010-02-11 11:31:22

本人花了很长时间研究外挂字幕SRT、ASS、SSA格式的文件，其编码之复杂，基本上能够用VB解析这些编码了。其目的，是想用VB编写的播放器直接支持SRT、ASS、SSA外挂字幕的自动和手工加载。虽然第三方外挂字幕插件VSFilter和AviSynth不错，但经常会遇到加载不上的问题，决定放弃，转而自己弄。Sub、IDX字幕我弄不来，但搞这些字幕还是可以的。现在有一个问题就是做的字幕太单调，没有立体感，就问一下大家像下面这个图显示的字体每个笔划的周围的黑色笔划是如何绘制出来的（注意不是字体阴影，是每个笔划周围的黑色），这种字体很漂亮，想摸仿：

...全文

792 12 打赏收藏转发到动态举报

写回复

用AI写文章

12 条回复

切换为时间正序

请发表友善的回复…

发表回复

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