VB写的文字动画特效,但是运行结果不对,希望哪位解答一下,谢谢!

[莫克168]

Option Explicit

Private m_bDoEffect As Boolean
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetTextCharacterExtra Lib "gdi32" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
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 OleTranslateColor Lib "OLEPRO32.dll" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long

Private Const COLOR_BTNFACE = 15
Private Const DT_BOTTOM = &H8
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_CHARSTREAM = 4
Private Const DT_DISPFILE = 6
Private Const DT_EXPANDTABS = &H40
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_INTERNAL = &H1000
Private Const DT_LEFT = &H0
Private Const DT_METAFILE = 5
Private Const DT_NOCLIP = &H100
Private Const DT_NOPREFIX = &H800
Private Const DT_PLOTTER = 0
Private Const DT_RASCAMERA = 3
Private Const DT_RASDISPLAY = 1
Private Const DT_RASPRINTER = 2
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_TABSTOP = &H80
Private Const DT_TOP = &H0
Private Const DT_VCENTER = &H4
Private Const DT_WORDBREAK = &H10
Private Const CLR_INVALID = -1

'自定义TextEffect过程，实现文字动画特效

Private Sub TextEffect(ByVal sText As String, ByVal lX As Long, ByVal lY As Long, Optional ByVal bLoop As Boolean = False, Optional ByVal lStartSpacing As Long = 128, Optional ByVal lEndSpacing As Long = -1, Optional ByVal oColor As OLE_COLOR = vbWindowText)

    '定义各种变量
    
    Dim i As Long
    Dim x As Long
    Dim lLen As Long
    Dim lHDC As Long
    Dim hBrush As Long
    Static tR As RECT
    Dim iDir As Long
    Dim bNotFirstTime As Boolean
    Dim lTime As Long
    Dim lIter As Long
    Dim bSlowDown As Boolean
    Dim lColor As Long
    Dim bDoIt As Boolean
    
    iDir = -1
    
    '为变量赋值
    
    i = lStartSpacing
    tR.left = lX: tR.top = lY: tR.right = lX: tR.bottom = lY
    OleTranslateColor oColor, 0, lColor
    hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
    lLen = Len(sText)
    lHDC = Me.hdc
    SetTextColor lHDC, lColor
    bDoIt = True
    Do While m_bDoEffect And bDoIt
        lTime = timeGetTime
        If (i < -3) And Not (bLoop) And Not (bSlowDown) Then
            bSlowDown = True
            iDir = 1
            lIter = i + 4
        End If
        
        If (i > 128) Then
            iDir = -1
        End If
        
        If Not (bLoop) And iDir = 1 Then
            If (i = lEndSpacing) Then
                bDoIt = False
            Else
                lIter = lIter + 1
                If (lIter <= 0) Then
                    i = i + iDir
                    lIter = i + 4
                End If
            End If
        Else
            i = i + iDir
        End If
        
        FillRect lHDC, tR, hBrush       '调用FillRect函数
        x = 32 - (i * lLen)
        SetTextCharacterExtra lHDC, i
        DrawText lHDC, sText, lLen, tR, DT_CALCRECT
        tR.right = tR.right + 4
            If (tR.right > Me.ScaleWidth \ Screen.TwipsPerPixelX) Then
                tR.right = Me.ScaleWidth \ Screen.TwipsPerPixelX
            End If
        DrawText lHDC, sText, lLen, tR, DT_LEFT
        
        Me.Refresh
        
        Do                           '后台运行
            DoEvents
        Loop While (timeGetTime - lTime) < 20
    Loop
    DeleteObject hBrush
    
End Sub

'窗体加载事件

Private Sub Form_Load()

    Me.Show
    Me.Refresh
    If Not (m_bDoEffect) Then
        Me.Cls
        Me.Font.Size = 32
        m_bDoEffect = True
        TextEffect "Look at the first effect", 12, 12, , 128, -2, RGB(0, 0, 0)
        
        If m_bDoEffect Then
            Me.Font.Size = 14
            TextEffect "Look at the second effect", 36, 80, , 128, , vb3DShadow
        End If
        
        If m_bDoEffect Then
            Me.Font.Name = "Tahoma"
            Me.Font.Size = 8
            Me.Font.Bold = False
            TextEffect "Look at the third effect", 49, 120, , 128, 0
        End If
        
        If m_bDoEffect Then
            TextEffect "Look at the fourth effect", 49, 150, , 128, 0
        End If
        m_bDoEffect = False
    Else
        m_bDoEffect = False
    End If
            
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    m_bDoEffect = False
    
End Sub

这个参照写的文字动画特效的程序,但是运行后只有第一个文字特效的结果,后面的三个文字特效都出现,希望哪位大大能够帮忙解答一下,谢谢!

[莫克168]

写错了,是运行后只有第一个文字特效的结果,后面的三个文字特效都没有出现,希望哪位大大能够帮忙解答一下,谢谢!