文章作者 100test 发表时间 2007:09:15 13:01:10
来源 100Test.Com百考试题网
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 |
相关文章
要想成为编程高手就应该具备的八个条件
怎样可以从ACCE 中打印一个WORD文档
在Acce 中实现密码管理的另一种方式
VB中利用API函数实现屏幕颜色数设定
VB实现文字“闪入”显示的特殊效果
C 程序设计从零开始之何谓
计算机等级:7道经典C语言上机试题解析
使用Office2007前需要做的准备工作
天津:2007年下半年全国计算机等级考试开始报名
澳大利亚华人论坛
考好网
日本华人论坛
华人移民留学论坛
英国华人论坛