• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Hiệu ứng Text

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
User avatar
truongphu
VIP
VIP
Posts: 4764
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Hiệu ứng Text

Postby truongphu » Mon 08/06/2009 8:59 pm

Thủ thuật: Hiệu ứng Text
Tác giả: Sưu tầm từ diễn đàn cũ, không rõ tác giả
Mô tả: Hiệu ứng text, rất cool


Bù cho bài nguyên tố, đã có

Module1:

Code: Select all

  1. Option Explicit
  2. Public Declare Function timeGetTime Lib "winmm.dll" () As Long
  3. Public Declare Function SetTextCharacterExtra Lib "gdi32" _
  4. (ByVal hdc As Long, ByVal nCharExtra As Long) As Long
  5.  
  6. Public Type RECT
  7. Left As Long
  8. Top As Long
  9. Right As Long
  10. Bottom As Long
  11. End Type
  12.  
  13. Public Declare Function OffsetRect Lib "user32" (lpRect _
  14. As RECT, ByVal x As Long, ByVal y As Long) As Long
  15.  
  16. Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc _
  17. As Long, ByVal crColor As Long) As Long
  18.  
  19. Public Declare Function FillRect Lib "user32" (ByVal hdc As _
  20. Long, lpRect As RECT, ByVal hBrush As Long) As Long
  21.  
  22. Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal _
  23. crColor As Long) As Long
  24.  
  25. Public Declare Function DeleteObject Lib "gdi32" (ByVal _
  26. hObject As Long) As Long
  27.  
  28. Public Declare Function GetSysColor Lib "user32" (ByVal _
  29. nIndex As Long) As Long
  30.  
  31. Public Const COLOR_BTNFACE = 15
  32.  
  33. Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
  34. (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal _
  35. lpString As String, ByVal nCount As Long) As Long
  36.  
  37. Public Declare Function DrawText Lib "user32" Alias "DrawTextA" _
  38. (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
  39. lpRect As RECT, ByVal wFormat As Long) As Long
  40.  
  41. Public Const DT_BOTTOM = &H8
  42. Public Const DT_CALCRECT = &H400
  43. Public Const DT_CENTER = &H1
  44. Public Const DT_CHARSTREAM = 4
  45. Public Const DT_DISPFILE = 6
  46. Public Const DT_EXPANDTABS = &H40
  47. Public Const DT_EXTERNALLEADING = &H200
  48. Public Const DT_INTERNAL = &H1000
  49. Public Const DT_LEFT = &H0
  50. Public Const DT_METAFILE = 5
  51. Public Const DT_NOCLIP = &H100
  52. Public Const DT_NOPREFIX = &H800
  53. Public Const DT_PLOTTER = 0
  54. Public Const DT_RASCAMERA = 3
  55. Public Const DT_RASDISPLAY = 1
  56. Public Const DT_RASPRINTER = 2
  57. Public Const DT_RIGHT = &H2
  58. Public Const DT_SINGLELINE = &H20
  59. Public Const DT_TABSTOP = &H80
  60. Public Const DT_TOP = &H0
  61. Public Const DT_VCENTER = &H4
  62. Public Const DT_WORDBREAK = &H10
  63.  
  64. Public Declare Function OleTranslateColor Lib "olepro32.dll" _
  65. (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
  66. Public Const CLR_INVALID = -1
  67.  
  68. Public Sub TextEffect(obj As Object, ByVal sText As String, _
  69. ByVal lX As Long, ByVal lY As Long, Optional ByVal bLoop _
  70. As Boolean = False, Optional ByVal lStartSpacing As Long = 128, _
  71. Optional ByVal lEndSpacing As Long = 0, Optional ByVal oColor _
  72. As OLE_COLOR = vbWindowText)
  73.  
  74. Dim lhDC As Long
  75. Dim i As Long
  76. Dim x As Long
  77. Dim lLen As Long
  78. Dim hBrush As Long
  79. Static tR As RECT
  80. Dim iDir As Long
  81. Dim bNotFirstTime As Boolean
  82. Dim lTime As Long
  83. Dim lIter As Long
  84. Dim bSlowDown As Boolean
  85. Dim lCOlor As Long
  86. Dim bDoIt As Boolean
  87.  
  88. lhDC = obj.hdc
  89. iDir = -1
  90. i = lStartSpacing
  91. tR.Left = lX: tR.Top = lY: tR.Right = lX: tR.Bottom = lY
  92. OleTranslateColor oColor, 0, lCOlor
  93.  
  94. hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
  95. lLen = Len(sText)
  96.  
  97. SetTextColor lhDC, lCOlor
  98. bDoIt = True
  99.  
  100. Do While bDoIt
  101. lTime = timeGetTime
  102. If (i < -3) And Not (bLoop) And Not (bSlowDown) Then
  103. bSlowDown = True
  104. iDir = 1
  105. lIter = (i + 4)
  106. End If
  107. If (i > 128) Then iDir = -1
  108. If Not (bLoop) And iDir = 1 Then
  109. If (i = lEndSpacing) Then
  110. ' Stop
  111. bDoIt = False
  112. Else
  113. lIter = lIter - 1
  114. If (lIter <= 0) Then
  115. i = i + iDir
  116. lIter = (i + 4)
  117. End If
  118. End If
  119. Else
  120. i = i + iDir
  121. End If
  122.  
  123. FillRect lhDC, tR, hBrush
  124. x = 32 - (i * lLen)
  125. SetTextCharacterExtra lhDC, i
  126. DrawText lhDC, sText, lLen, tR, DT_CALCRECT
  127. tR.Right = tR.Right + 4
  128. If (tR.Right > obj.ScaleWidth \ Screen.TwipsPerPixelX) Then _
  129. tR.Right = obj.ScaleWidth \ Screen.TwipsPerPixelX
  130. DrawText lhDC, sText, lLen, tR, DT_LEFT
  131. obj.Refresh
  132.  
  133. Do
  134. DoEvents
  135. If obj.Visible = False Then Exit Sub
  136. Loop While (timeGetTime - lTime) < 20
  137.  
  138. Loop
  139. DeleteObject hBrush
  140.  
  141. End Sub


Form1:

Code: Select all

  1. Private Sub Command1_Click()
  2. Call TextEffect(Me, "Hieu ung Text ne, Cool hong!", 15, 15, False, 128)
  3. End Sub
Attachments
Hieu Ung Text.rar
(6.23 KiB) Downloaded 1262 times


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Return to “[VB] Chuỗi và Thời gian”

Who is online

Users browsing this forum: No registered users and 0 guests