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
’ 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
Copyright 2001-2010, www.comprg.com.cn, All Rights Reserved 京ICP备14022230号-1,电话/传真：010-82561037 82561614 ,Mail:gaojian@comprg.com.cn
地址：北京市海淀区远大路20号宝蓝大厦E座704，邮编：100089
