成全高清视频免费观看动漫版-成全视频动漫免费高清-午夜不卡久久精品无码免费

你好，欢迎来到电脑编程技巧与维护杂志社！

杂志社简介│广告服务│读者反馈│编程社区

您的位置：技术专栏 / Web开发

用VB编程让文本滚动更平滑

目前有许多软件都采用了类似于“电视字幕”的滚动字幕的形式(如电子小说阅读器以及诸如Winamp的“关于”界面等)。在VB中通常用一个Timer控件来控制文本的滚动速度，但是它的缺点就是跳跃感太强，效果不好。本文将介绍在VB中通过API函数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：一个标志位数组，决定了以何种形式执行绘图。

　　程序实现

　　进入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

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

推荐精品文章


·2024年9月目录 ·2024年8月目录 ·2024年7月目录 ·2024年6月目录 ·2024年5月目录 ·2024年4月目录 ·2024年3月目录 ·2024年2月目录 ·2024年1月目录 ·2023年12月目录 ·2023年11月目录 ·2023年10月目录 ·2023年9月目录 ·2023年8月目录

联系方式

TEL：010-82561037
Fax: 010-82561614
QQ: 100164630
Mail：gaojian@comprg.com.cn

友情链接

中国软件网│软件开发网│