In this ex you'll have the time in ms Windows is conected so you can rest this from the Now() to have the time when started.
'This example requires one command button (Command1)
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetTextCharacterExtra Lib "gdi32" _
(ByVal hdc As Long, ByVal nCharExtra As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function OffsetRect Lib "user32" (lpRect _
As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc _
As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As _
Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal _
crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal _
hObject As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal _
nIndex As Long) As Long
Private Const COLOR_BTNFACE = 15
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal _
lpString As String, ByVal nCount As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" _
(ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1
Public Sub TextEffect(obj As Object, ByVal sText As String, _
ByVal lX As Long, ByVal lY As Long, Optional ByVal bLoop _
As Boolean = False, Optional ByVal lStartSpacing As Long = 128, _
Optional ByVal lEndSpacing As Long = -1, Optional ByVal oColor _
As OLE_COLOR = vbWindowText)
Dim lhDC As Long
Dim i As Long
Dim x As Long
Dim lLen As Long
Dim hBrush As Long
Static tR As RECT
Dim iDir As Long
Dim bNotFirstTime As Boolean
Dim lTime As Long
Dim lIter As Long
Dim bSlowDown As Boolean
Dim lCOlor As Long
Dim bDoIt As Boolean
Do While bDoIt
lTime = timeGetTime
If (i < -3) And Not (bLoop) And Not (bSlowDown) Then
bSlowDown = True
iDir = 1
lIter = (i + 4)
End If
If (i > 128) Then iDir = -1
If Not (bLoop) And iDir = 1 Then
If (i = lEndSpacing) Then
' Stop
bDoIt = False
Else
lIter = lIter - 1
If (lIter <= 0) Then
i = i + iDir
lIter = (i + 4)
End If
End If
Else
i = i + iDir
End If
FillRect lhDC, tR, hBrush
x = 32 - (i * lLen)
SetTextCharacterExtra lhDC, i
DrawText lhDC, sText, lLen, tR, DT_CALCRECT
tR.Right = tR.Right + 4
If (tR.Right > obj.ScaleWidth \ Screen.TwipsPerPixelX) Then _
tR.Right = obj.ScaleWidth \ Screen.TwipsPerPixelX
DrawText lhDC, sText, lLen, tR, DT_LEFT
obj.Refresh
Do
DoEvents
If obj.Visible = False Then Exit Sub
Loop While (timeGetTime - lTime) < 20
Loop
DeleteObject hBrush
End Sub
Private Sub Command1_Click()
Me.ScaleMode = vbTwips
Me.AutoRedraw = True
Call TextEffect(Me, "Hello World!", 12, 12, False, 128)
End Sub
Thanks for your help! I ran the program on my machine, both GetTickCount and timeGetTime return the same uptime. And I copied the program to the server and ran it from my machine, both GetTickCount and timeGetTime return my machine's uptime.
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.