Declare Function SetTextCharacterExtra Lib "gdi32" Alias
"SetTextCharacterExtraA" (ByVal hdc As Long, ByVal nCharExtra As Long) As
Long
说明:该函数用于在描绘文本时,指定字符串内各字符间插入的额外间距。参数hdc代表设备场景的句柄,nCharExtra指的是要在字符间插入的额外空间(采用设备场景的逻辑坐标系统)。该函数调用成功后,返回一个Long类型的值,它指的是这个设备场景的前一个额外间距设置。
2、DrawTextEx
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
参数hDC是要在其中绘图的一个设备场景的句柄,lpsz
是欲描绘输出的文本字串,n为欲描绘的字符数量,如果要描绘整个字串(直到中止符),则可将这个参数设为-1。lpRect
RECT,指定用于绘图的一个格式化矩形(采用逻辑坐标),un是一个标志位。决定了以何种形式执行绘图,例如:DT_EDITCONTROL
对一个多行编辑控件进行模拟;DT_ENDELLIPSES
将在字串不能在矩形里全部容下的情况下就在末尾显示省略号等等。lpDrawTextParams是一个指向DRAWTEXTPARAMS结构的指针,它包含了额外的格式信息。
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 三、小结