VB一个平滑的字幕滚动控件(开源)

'添加一个ActiveX控件工程，代码如下：
Option Explicit
'自定类
Public Enum TDO_Text '滚动方向
[Right to left] = 0 '由右向左滚动
[Left to right] = 1 '由左向右滚动
End Enum

Private Type Font
Zti As String '字体
Zxing As String '字形
Dxiao As Long '大小
End Type

Dim Rolling As Integer '滚动方向:[0]由右向左滚动 [1]由左向右滚动
Private WithEvents Timer As Timer
Dim Buj As Double '记次
Dim Wordlen As Long '文本长度
Dim Wordhigh As Long '文本高度
Dim Txt As String '文本
Dim Zti As String '字体
Dim Speed As Long '速度

Dim Mf As Form, Lx As Long, Tt As Long ’
Dim L As Long, T As Long, W As Long, H As Long

Private Sub Timer_Timer()
Dim Ctxt As String
If Rolling = 0 Then
If (Buj + Wordlen) <= 0 Then
Buj = UserControl.ScaleWidth - 23
Else
Buj = Buj - Speed
End If
Ctxt = Txt
ElseIf Rolling = 1 Then
If Buj >= UserControl.ScaleWidth - 23 Then
Buj = -Wordlen
Else
Buj = Buj + Speed
End If
Ctxt = StrReverse(Txt)
End If
UserControl.Cls
Call Lucency(Mf)
UserControl.CurrentX = Buj: UserControl.CurrentY = 30
UserControl.Print Ctxt
End Sub

Private Sub UserControl_Initialize()
Set Timer = UserControl.Controls.Add(“VB.Timer”, “Timer”)
UserControl.AutoRedraw = True
UserControl.FontSize = 9
Speed = 0
Rolling = 0
End Sub

Public Property Get Content() As String
Content = Txt
End Property

Public Property Let Content(ByVal vNewValue As String)
Txt = Replace(vNewValue, vbCrLf, “”)
If Speed > 0 Then Timer.Interval = 1 Else Timer.Interval = 0
Wordlen = UserControl.TextWidth(Txt)
End Property

Public Sub Lucency(F As Form) ’
Set Mf = F
On Error Resume Next
L = UserControl.Extender.Left
T = UserControl.Extender.Top
W = UserControl.Extender.Width
H = UserControl.Extender.Height
UserControl.AutoRedraw = True
UserControl.PaintPicture F.Image, 0, 0, W, H, L, T, W, H
UserControl.Line (0, 0)-(UserControl.ScaleWidth - 8, UserControl.ScaleHeight - 8), 255, B
End Sub

Private Sub UserControl_Resize()
UserControl.Cls
UserControl.Line (0, 0)-(UserControl.ScaleWidth - 8, UserControl.ScaleHeight - 8), 255, B
UserControl.Height = UserControl.TextHeight(Txt) + 80
End Sub

Public Property Get Direction() As TDO_Text
Direction = Rolling
End Property

Public Property Let Direction(ByVal vNewValue As TDO_Text)
Rolling = vNewValue
If vNewValue = 0 Then
Buj = UserControl.ScaleWidth - 23
ElseIf vNewValue = 1 Then
Buj = -Wordlen
End If
PropertyChanged “Direction”
End Property

'加载和存储属性值-------------------------------------------------------------------
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) '从存储器中加载属性值
Speed = PropBag.ReadProperty(“Interval”, Speed)
Rolling = PropBag.ReadProperty(“Direction”, Rolling)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag) '将属性值写到存储器
Call PropBag.WriteProperty(“Interval”, Speed, 0)
Call PropBag.WriteProperty(“Direction”, Rolling, 0)

End Sub
'------------------------------------------------------------------------------------

Public Property Get Interval() As Long
Interval = Speed
End Property

Public Property Let Interval(ByVal vNewValue As Long)
Speed = vNewValue
PropertyChanged “Interval”
End Property

'Form==============================================================
'将控件添加到窗体,再添加一个Combo1下拉框控件，代码如下：
Private Sub Combo1_Click()
Dynamic1.Direction = Combo1.Text
End Sub

Private Sub Form_Load()
Dynamic1.Lucency Me
Dynamic1.Content = “国庆黄金周，很多人都在旅途中。这几年，自由行也渐渐成了主流出行方式。随着导游自由执业逐渐放开，网约导游也开始进入大家的视线中。”
End Sub

'按F5运行，Combo1的数值：0向左边滚动，1向右边滚动。