在下VB新人,请问如何在窗体中做出滚动字幕?

william_wyat 2005-02-07 11:30:57
就象电视剧结束时,产生演员表滚动字幕的效果。怎么样可以做到呢?新手,提的问题可能很没水平,不过希望好心人能说的尽量详细一点,谢谢大家!
...全文
569 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
  • 打赏
  • 举报
回复
呵呵!~好像确实是跑题了!~:)
关注ing!~
kmzs 2005-02-11
  • 打赏
  • 举报
回复
timer用用就够了,print一下
blueswind8306 2005-02-11
  • 打赏
  • 举报
回复
呵呵,楼上的兄弟,大家好象在讨论怎么解决闪烁的问题吧:)
  • 打赏
  • 举报
回复
要闪烁的话可以加入用时间控件控制字的色彩的变化就可以了。

通过对字的颜色的控制,来实现闪烁喽!~

sub changcolor(LCnt as Control,color1 As Integer,_
color2 As Integer,color3 As Integer,color4 As Integer,color5 As Integer,color6 As Integer,_color7 as integer,color8 as integer)

Dim tmep as integer

tmep=val(LCnt.tag)

select case tmep

case color1
Lcnt.tag=color2
case color2
lcnt.tag=color3
case color3
lcnt.tag=color4
case color4
lcnt.tag=color5
case color5
lcnt.tag=color6
case color6
lcnt.tag=color7
case color7
lcnt.tag=color8
case color8
lcnt.tag=color1
end select
lcnt.forcolor=QBcolor(lcnt.tag)

private sub timer1_timer()

chagecolor label1,2,3,4,5,6,7,8

因为是自己用手打上来了,如果有差错,请见谅:)

这个运行的时候字就像闪烁的一样!~

放一个timer控件和一个laber控件就可以了。

timer控件设为100或50随自己喽:)

libralibra 2005-02-08
  • 打赏
  • 举报
回复
API让滚动平滑


函数说明


  该函数的用法如下:

  Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

  其作用是将文本描绘到指定的矩形中返回值Long:描绘文字的高度

  参数类型及说明

  hdc:欲在其中显示文字的一个设备场景的句柄;

  lpStr:欲描绘的文本字串;

  nCount:欲描绘的字符数量。如果要描绘整个字串(直到空终止符),则可将这个参数设为-1;

  lpRect:指定用于绘图的一个格式化矩形(采用逻辑坐标);

  wFormat:一个标志位数组,决定了以何种形式执行绘图。

  程序实现

  进入VB,在默认窗体FORM1上放一个Picture控件“Picmain”,一个命令按钮“Command1”,然后输入如下代码:

  Option Explicit

  Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

  Private Declare Function GetTickCount Lib "kernel32" () As Long

  Const DT_BOTTOM As Long = &&H8

  Const DT_CALCRECT As Long = &&H400

  Const DT_CENTER As Long = &&H1

  Const DT_WORDBREAK As Long = &&H10

  Private Type RECT

  Left As Long

  Top As Long

  Right As Long

  Bottom As Long

  End Type

  Const ScrollText As String = "滚动字幕示例" && vbCrLf && vbCrLf && vbCrLf && "作者:姜卫东" && vbCrLf && _ vbCrLf && "地址:黑龙江省农业经济学校" && vbCrLf && vbCrLf && "有问题请给我来信!!!" && vbCrLf && "E-MAIL:hyjs@yeah.net" && vbCrLf && vbCrLf && vbCrLf && "谢谢使用"

  Dim isend As Boolean

  Private Sub Command1_Click()

  If isend = False Then

  isend = True

  Else

  isend = False

  frmAbout.Refresh

  scrollme

  End If

  End Sub

  Private Sub Form_Activate()

  scrollme

  End Sub

  Private Sub Form_Load()

  picmain.ForeColor = vbGreen

  picmain.FontSize = 14

  End Sub

  Private Sub scrollme()

  Dim LastFrameTime As Long

  '设置时间间隔,即滚动速度

  Const IntervalTime As Long = 10

  Dim rt As Long

  Dim DrawingRect As RECT

  '设置所画矩形的左边位置。

  Dim tmpX As Long, tmpY As Long

  Dim RectHeight As Long

  '显示窗体

  frmAbout.Refresh

  '获得所画矩形的尺寸

  rt = DrawText(picmain.hdc, ScrollText, -1, DrawingRect, DT_CALCRECT)

  If rt = 0 Then

  MsgBox "出错", vbExclamation

  isend = True

  Else

  '设置矩形的位置

  DrawingRect.Top = picmain.ScaleHeight

  DrawingRect.Left = 0

  DrawingRect.Right = picmain.ScaleWidth

  '设置矩形的高度

  RectHeight = DrawingRect.Bottom

  DrawingRect.Bottom = DrawingRect.Bottom + picmain.ScaleHeight

  End If

  Do While Not isend

  If GetTickCount() - LastFrameTime > IntervalTime Then

  picmain.Cls

  DrawText picmain.hdc, ScrollText, -1, DrawingRect, DT_CENTER Or DT_WORDBREAK

  DrawingRect.Top = DrawingRect.Top - 1

  DrawingRect.Bottom = DrawingRect.Bottom - 1

  '控制文本的循环滚动

  If DrawingRect.Top < -(RectHeight) Then

  DrawingRect.Top = picmain.ScaleHeight

  DrawingRect.Bottom = RectHeight + picmain.ScaleHeight

  End If

  picmain.Refresh

  LastFrameTime = GetTickCount()

  End If

  DoEvents

  Loop

  Set frmAbout = Nothing

  End Sub

  Private Sub Form_Unload(Cancel As Integer)

  isend = True

  End Sub Sub
libralibra 2005-02-08
  • 打赏
  • 举报
回复
添加一个label标签作为滚动字幕,将它放置在窗体的下面,然后添加一个Timer控件,设置Timer1.Interval=100,在代码窗口输入如下内容:

Private Sub Timer1_Timer()
Label1.Top = Label1.Top - 100
'通过改变Label1的Top属性实现滚动效果
If Label1.Top <0 Then Label1.Top= screen.height
'当Label1移出窗口后使它的height属性变为0,实现循环!
End Sub
jadeluo 2005-02-08
  • 打赏
  • 举报
回复
一个例子:

Option Explicit

'Powered by Jadeluo, 2005/02/08

'窗体中需要放置两个PictureBox控件, 名为picSource和picShow
'还需要一个Timer控件, 名为Timer1

Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Const MoveStep = 2
Const MoveDelay = 50
Dim intPos As Long

Private Sub Command1_Click()
Dim i As Integer
picSource.Picture = LoadPicture("c:\winnt\Soap Bubbles.bmp")
picSource.Width = picShow.Width
picSource.Height = picShow.Height * 2 '这个值应该大到足够容纳下所有行的内容
picSource.ScaleMode = vbPixels
picSource.AutoRedraw = True
picSource.Visible = False
For i = 1 To 100
picSource.Print "Line" & i
Next i
intPos = 0
picShow.ScaleMode = vbPixels
picShow.AutoRedraw = True
Timer1.Interval = MoveDelay
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
BitBlt picShow.hDC, 0, 0, picShow.ScaleWidth, picShow.ScaleHeight, picSource.hDC, 0, intPos, vbSrcCopy
intPos = intPos + MoveStep
If intPos > picSource.ScaleHeight Then
Timer1.Enabled = False
End If
picShow.Refresh
End Sub
libralibra 2005-02-08
  • 打赏
  • 举报
回复
回复人: xiaoyuepk(魔囝の悦) ( ) 信誉:100 2005-02-08 01:40:00 得分: 0


简单的东西干嘛要写那么复杂
做个时间控件让字幕移动就可以了


000000000000000000000000000000
有1楼兄弟说的问题啊,会闪烁的
aloka 2005-02-08
  • 打赏
  • 举报
回复
gz
xiaoyuepk 2005-02-08
  • 打赏
  • 举报
回复
简单的东西干嘛要写那么复杂
做个时间控件让字幕移动就可以了
dyshadow 2005-02-07
  • 打赏
  • 举报
回复
先用一个容器,比如PICTURE BOX,然后,用一个LABEL,其CAPTION属性为你要滚动显示的文本。用一个TIMER来控制其TOP属性,也就是在一定的时间内减去某个值,使其向上移动。

不过有个问题,会发生闪烁。

是因为重画速度不够快的缘故。

如果要解决这个问题,就需要用API创建设备场景等问题。(比较烦了)

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧