VB实现文字“闪入”显示的特殊效果

Declare Function SetTextCharacterExtra Lib "gdi32" Alias "SetTextCharacterExtraA" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long

Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long

Option Explicit
’ TYPE STRUCTURES
Private Type tpeTextProperties
　cbSize As Long
　iTabLength As Long
　iLeftMargin As Long
　iRightMargin As Long
　uiLengthDrawn As Long
End Type
Private Type tpeRectangle
　Left As Long
　Top As Long
　Right As Long
　Bottom As Long
End Type
’ CONSTANTS
Private Const DT_CENTER = &H1
Private Const DT_VCENTER = &H4
’ API DECLARATIONS
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As tpeRectangle, ByVal un As Long, lpDrawTextParams As tpeTextProperties) As Long
Private Declare Function SetTextCharacterExtra Lib "gdi32" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As tpeRectangle) As Long
Public strCharSpace As Integer
Private Sub Form_Load()
　’ Call the button code which performs the function which
　’ we want to do here.
　Call cmdStart_Click
End Sub
Private Sub cmdClose_Click()
　Unload frmMain ’ Unload this form from memory
　End ’ End the program
End Sub
Private Sub cmdStart_Click()
　’ Draw the text with a large space between the characters
　strCharSpace = 240
　Call doAnimationFX
　’ Start the timer
　tmrProgTimer.Enabled = True
End Sub
Private Sub tmrProgTimer_Timer()
　’ Take away one of the present value of the spacing
　strCharSpace = strCharSpace - 1
　Call doAnimationFX ’ Draw the new string
　’ Check the value of ’strCharSpace’
　If strCharSpace = 0 Then tmrProgTimer.Enabled = False
End Sub
Private Sub doAnimationFX()
　’ Procedure Scope Declarations
　Dim typeDrawRect As tpeRectangle
　Dim typeDrawParams As tpeTextProperties
　Dim strCaption As String
　’ Set the string which will be animated
　strCaption = "Visual Basic Code"
　’ Set the area in which the animation will take place.
　’ Needs to be a control which has the ’.hwnd’ property
　’ and can be refreshed and cleared easily. So a picture
　’ box is the best candidate
　GetClientRect picAniRect.hwnd, typeDrawRect
　’ Now set the properties which will be used in the animation
　With typeDrawParams
　　’ The size of the animation
　　.cbSize = Len(typeDrawParams)
　　’ The left and right margins
　　.iLeftMargin = 0
　　.iRightMargin = 0
　End With
　’ Clear the picture box
　picAniRect.Cls
　’ Set the character spacing which will be used
　SetTextCharacterExtra picAniRect.hdc, Val(strCharSpace)
　’ Draw the string of text, in the set area with the
　’ specified options
　DrawTextEx picAniRect.hdc, strCaption, Len(strCaption), _
typeDrawRect, SaveOptions, typeDrawParams
　’ Refresh the picture box which contains the animation
　picAniRect.Refresh
End Sub
Private Function SaveOptions() As Long
　’ Procedure Scope Declaration
　Dim MyFlags As Long
　’ Set the options which will be used in the FX
　MyFlags = MyFlags Or DT_CENTER
　MyFlags = MyFlags Or DT_VCENTER
　’ Store the flags which we have set above
　SaveOptions = MyFlags
End Function