dtcms插件 百度搜索优化 idea unity webview nosql NEC 网校直播系统 map删除指定元素 字符串中包含某个字符串 matlab网页版 爬虫数据清洗 java 注解 python新手教程 python链接mysql数据库 python自学入门 java使用 java重写和重载的区别 java当前时间 java时间戳转换 php整站源码 abaqus最新版本 迷你版kms 微信客户管理系统 vbs编程教学 js延迟加载 win10wifi ipad怎么清理内存垃圾 微信昵称特殊字符保存 冰冠堡垒单刷路线 sai怎么导入图片 jsps2寸照片制作 id页码怎么设置 php队列 一创智富通 手机记账 送货单软件 雷电手机模拟器 电商源码 兔子修改器
当前位置: 首页 > 学习教程  > 编程语言

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

2021/1/28 23:51:47 文章标签:

添加一个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 大…

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


本文链接: http://www.dtmao.cc/news_show_650317.shtml

附件下载

相关教程

    暂无相关的数据...

共有条评论 网友评论

验证码: 看不清楚?