示例:
PrivateSubForm_Load()
'//预先设定要显示的内容
content="滚动字幕示例控制文本的循环滚动"
'//获取内容长度
length=Len(content)
'//label1控件,手动调整
'//接着需要选择字体大小
SetMe.Font=Label1.Font'//方便借用Form.TextHeight方法
Dimfont_heightAsLong,font_widthAsLong,sizeAsLong
size=Label1.Font.size
font_height=Me.TextHeight("循环滚动")
font_width=Me.TextWidth("循环滚动")
Whilefont_height<=Label1.HeightAndfont_width<=Label1.Width
size=size+1
Label1.Font.size=size
font_height=Me.TextHeight("循环滚动")
font_width=Me.TextWidth("循环滚动")
Wend
Label1.Font.size=size-1'//选择最合适的字体大小
pos=1'//从第一个字符开始读取
EndSub
PrivateSubCommand1_Click()
Timer1.Interval=1000'1000毫秒执行一次
EndSub
PrivateSubTimer1_Timer()
DimsizeAsLong,tempAsString
'//每次显示5个长度单位的内容
size=length-pos'//得到截取的长度大小
Ifsize<4Then'//当不足5个长度单位时
temp=Mid(content,pos,size+1)
temp=temp&Mid(content,1,4-size)
pos=5-size
Else
temp=Mid(content,pos,5)
pos=pos+5
EndIf
Label1.Caption=temp'//把截取的文本内容显示出来
EndSub
扩展资料
VB设计自动滚动字幕窗体
DimDireAsString
'窗体Load事件
PrivateSubForm_Load()
Dire="向左"
EndSub
'定时器事件
PrivateSubTimer1_Timer()
DimNewColorAsLong
Randomize
NewColor=RGB(Rnd()*256,Rnd()*256,Rnd()*256)
Label1.ForeColor=NewColor
IfDire="向左"Then
Label1.Left=Label1.Left-10
IfLabel1.Left<0ThenDire="向右"
ElseIfDire="向右"Then
Label1.Left=Label1.Left+10
IfLabel1.Left+Label1.Width>Me.ScaleWidthThenDire="向左"
EndIf
EndSub
推荐于2017-09-22
Vb实现屏幕上的字幕滚动效果,运行以下后可看到屏幕底部有一行字从屏幕右侧边缘滚动出现,向右滚动,然后会从屏幕上部向右滚动。
文字的定义是在INI文件中,程序先读取INI文件中的文字内容,然后定义具体的文字滚动方法;
参考代码如下:
VERSION 5.00
002 Begin VB.Form Form1
003 BorderStyle = 0 'None
004 Caption = "屏幕滚动字幕"
005 ClientHeight = 495
006 ClientLeft = 0
007 ClientTop = 0
008 ClientWidth = 7935
009 LinkTopic = "Form1"
010 ScaleHeight = 495
011 ScaleWidth = 7935
012 StartUpPosition = 3 '窗口缺省
013 Begin VB.Timer Timer3
014 Interval = 500
015 Left = 5010
016 Top = 150
017 End
018 Begin VB.Timer Timer2
019 Enabled = 0 'False
020 Left = 1620
021 Top = 1635
022 End
023 Begin VB.Timer Timer1
024 Enabled = 0 'False
025 Interval = 200
026 Left = 645
027 Top = 1575
028 End
029 Begin VB.Label Label1
030 AutoSize = -1 'True
031 BackStyle = 0 'Transparent
032 Caption = "Label1"
033 BeginProperty Font
034 Name = "华文行楷"
035 Size = 18
036 Charset = 134
037 Weight = 700
038 Underline = 0 'False
039 Italic = 0 'False
040 Strikethrough = 0 'False
041 EndProperty
042 Height = 375
043 Left = 45
044 TabIndex = 0
045 Top = 75
046 Width = 855
047 End
048 End
049 Attribute VB_Name = "Form1"
050 Attribute VB_GlobalNameSpace = False
051 Attribute VB_Creatable = False
052 Attribute VB_PredeclaredId = True
053 Attribute VB_Exposed = False
054 Option Explicit
055 Private Sub Form_Load()
056 Label1.Caption = ReadText
057 Me.BackColor = RGB(128, 64, 64)
058 transparence Me
059 Me.Width = Label1.Width
060 Me.Left = Screen.Width
061 Me.Top = Screen.Height - Me.Height - 500
062 Timer1.Interval = 100
063 Timer1.Enabled = True
064 End Sub
065 Private Sub Label1_Click()
066 Unload Me
067 End Sub
068 Private Sub Timer1_Timer()
069 Me.Left = Me.Left - 100
070 If Me.Left < Label1.Width * (-1) Then
071 Timer1.Enabled = False
072 Me.Left = -Me.Width
073 Me.Top = 0
074 Timer2.Enabled = True
075 Timer2.Interval = 100
076 End If
077 End Sub
078 Private Sub Timer2_Timer()
079 Me.Left = Me.Left + 100
080 If Me.Left > Screen.Width Then
081 Timer2.Enabled = False
082 Me.Top = Screen.Height - Me.Height - 500
083 Me.Left = Screen.Width
084 Timer1.Enabled = True
085 Timer1.Interval = 100
086 End If
087 End Sub
088 Private Function ReadText() As String
089 Dim MyLine
090 Open App.Path & "\text.ini" For Input As #1 ' 打开文件
091 Do While Not EOF(1) ' 循环至文件尾
092 Line Input #1, MyLine ' 读入一行数据并将其赋予某变量
093 ReadText = MyLine
094 Loop
095 Close #1
096 End Function
097 Sub ChangeColor(Ctl As Control, Color1 As Integer, Color2 As Integer, Color3 As Integer, Color4 As Integer)
098 ' 改变字体颜色
099 If Val(Ctl.Tag) = Color1 Then
100 Ctl.Tag = Color2
101 ElseIf Val(Ctl.Tag) = Color2 Then
102 Ctl.Tag = Color3
103 ElseIf Val(Ctl.Tag) = Color3 Then
104 Ctl.Tag = Color4
105 ElseIf Val(Ctl.Tag) = Color4 Then
106 Ctl.Tag = Color1
107 Else
108 Ctl.Tag = Color1
109 End If
110 Ctl.ForeColor = QBColor(Ctl.Tag)
111 End Sub
112 Private Sub Timer3_Timer()
113 Call ChangeColor(Label1, 1, 3, 5, 9)
114 End Sub
在窗体里放入一个LABEL和一个TIMER控件,字体修改LABEL的字体就可以了.
Private Sub Form_Load()
Label1.Caption = "最好字体可以改变!!麻烦给出窗体和代码!!"
Timer1.Interval = 300
End Sub
Private Sub Timer1_Timer()
Label1.Caption = Mid(Label1.Caption, 2, Len(Label1.Caption) - 1) + Left(Label1.Caption, 1)
End Sub
具体思路就是这样了,我想程序你应该可以自己写出来吧。
建一个timer1,interval=50
Public a
Private Sub Form_Load()
a = Label1.Left
End Sub
Private Sub Timer1_Timer()
If Label1.Left < Label1.Width Then
Label1.Left = Label1.Left + 20
Else
Label1.Left = a
End If
End Sub