扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
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 |
濠碘€冲€归悘澶愬箖閵娾晜濮滈悽顖涚摃閹烩晠宕氶崶鈺傜暠闁诡垰鍘栫花锛勬喆椤ゅ弧濡澘妫楅悡娆撳嫉閳ь剟寮0渚€鐛撻柛婵呮缁楀矂骞庨埀顒勫嫉椤栨瑤绻嗛柟顓у灲缁辨繈鏌囬敐鍕杽閻犱降鍨藉Σ鍕嚊閹跺鈧﹦绱旈幋鐐参楅柡鍫灦閸嬫牗绂掔捄铏规闁哄嫷鍨遍崑宥夋儍閸曨剚浠樺ù锝嗗▕閳ь剚鏌ㄧ欢鐐寸▕鐎b晝顏遍柕鍡嫹
现场直击|2021世界人工智能大会
直击5G创新地带,就在2021MWC上海
5G已至 转型当时——服务提供商如何把握转型的绝佳时机
寻找自己的Flag
华为开发者大会2020(Cloud)- 科技行者