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

VisualBasic编程源码 专栏收录该内容
66 篇文章 2 订阅

在这里插入图片描述
'添加一个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向右边滚动。

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 打赏
    打赏
  • 扫一扫,分享海报

©️2022 CSDN 皮肤主题:1024 设计师:我叫白小胖 返回首页

打赏作者

键盘上的舞指

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值