华云

    进入VB，在默认窗体FORM1上放一个Picture控件“Picmain”，一个命令按钮“Command1”，注意要将picture控件的ScaleMode设置为“3-Pixel”，将AutoRedraw属性设置为“true”，设计完成后运行的界面如下图所示：
 

    这里主要通过API函数DrawText来实现字幕的平滑滚动，DrawText函数的用法如下：
　　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：一个标志位数组，决定了以何种形式执行绘图。
    具体实现的核心代码如下：
　　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:xxgcxhy@163.com" & vbCrLf & vbCrLf & vbCrLf & "谢谢使用"
    '若显示文本框中的文字，可按如下定义
    'Dim ScrollText As String
    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()
    '显示文本框中的文字时可用下一行代码
    'ScrollText = Text1.Text
    scrollme
    End Sub
    Private Sub Form_Load()
    '显示文本框中的文字时可用下一行代码
    'ScrollText = Text1.Text
    picmain.ForeColor = vbGreen
    picmain.FontSize = 14
    End Sub
    Private Sub scrollme()
    Dim LastFrameTime As Long
    '设置时间间隔,即滚动速度，
    Const IntervalTime As Long = 24
    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

    以上程序在Windows　XP+VB6.0中文企业版中运行通过。