用VB編程讓文本滾動更平滑

發表于:2007-07-14來源:作者:點擊數: 標簽:
姜衛東、華云 目前有許多軟件都采用了類似于“電視字幕”的滾動字幕的形式(如電子小說閱讀器以及諸如Winamp的“關于”界面等)。在 VB 中通常用一個Timer控件來控制文本的滾動速度,但是它的缺點就是跳躍感太強,效果不好。本文將介紹在VB中通過API函數DrawTe
姜衛東、華云

  目前有許多軟件都采用了類似于“電視字幕”的滾動字幕的形式(如電子小說閱讀器以及諸如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中文企業版中運行通過。

原文轉自:http://www.anti-gravitydesign.com

国产97人人超碰caoprom_尤物国产在线一区手机播放_精品国产一区二区三_色天使久久综合给合久久97