主题:[讨论]非常平滑的水平字幕滚动 不能滚动中文问题?
问题,只能滚动"VB";不能滚动"VB论坛";中文不行
问题好像在
Private Sub Scroll()
End Sub
中....
代码如下 :
Option Explicit
Private TextLine As String '文字信息
Private Index As Long '字符索引
Private Scrolling As Boolean '滚动标志
Private t As Long '帧延时
Private RText As RECT
Private RClip As RECT
Private RUpdate As RECT
Private Sub Form_Load()
TextLine = "VB论坛"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Scrolling = 0 '!
End Sub
Private Sub cmdScroll_Click()
'-- 开始滚动
Scrolling = -1
Index = 1
Scroll
End Sub
Private Sub Scroll()
Dim Char As String
With iScroll
SetRect RClip, 1, 2, .ScaleWidth, .ScaleHeight
SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Left$(TextLine, 1)), .ScaleHeight
End With
Char = Left$(TextLine, 1)
With iScroll
Do
If (timeGetTime - t >= 30) Then
t = timeGetTime
If (RText.Right <= .ScaleWidth) Then
Index = Index + 1
Char = Mid$(TextLine, Index, 1)
SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Mid$(TextLine, Index, 1)), .ScaleHeight
End If
DrawText .hdc, Char, 1, RText, &H0
OffsetRect RText, -1, 0
ScrollDC .hdc, -1, 0, RClip, RClip, 0, RUpdate
iScroll.Line (.ScaleWidth - 1, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), .BackColor
End If
If (Index > Len(TextLine)) Then Index = 0
DoEvents
Loop Until Scrolling = 0
End With
End Sub
问题好像在
Private Sub Scroll()
End Sub
中....
代码如下 :
Option Explicit
Private TextLine As String '文字信息
Private Index As Long '字符索引
Private Scrolling As Boolean '滚动标志
Private t As Long '帧延时
Private RText As RECT
Private RClip As RECT
Private RUpdate As RECT
Private Sub Form_Load()
TextLine = "VB论坛"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Scrolling = 0 '!
End Sub
Private Sub cmdScroll_Click()
'-- 开始滚动
Scrolling = -1
Index = 1
Scroll
End Sub
Private Sub Scroll()
Dim Char As String
With iScroll
SetRect RClip, 1, 2, .ScaleWidth, .ScaleHeight
SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Left$(TextLine, 1)), .ScaleHeight
End With
Char = Left$(TextLine, 1)
With iScroll
Do
If (timeGetTime - t >= 30) Then
t = timeGetTime
If (RText.Right <= .ScaleWidth) Then
Index = Index + 1
Char = Mid$(TextLine, Index, 1)
SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Mid$(TextLine, Index, 1)), .ScaleHeight
End If
DrawText .hdc, Char, 1, RText, &H0
OffsetRect RText, -1, 0
ScrollDC .hdc, -1, 0, RClip, RClip, 0, RUpdate
iScroll.Line (.ScaleWidth - 1, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), .BackColor
End If
If (Index > Len(TextLine)) Then Index = 0
DoEvents
Loop Until Scrolling = 0
End With
End Sub