It can replace the Timer class of the timer control that comes with VB.

Source: Internet
Author: User
This class can be used to replace the timer control that comes with VB, so that you do not need to add a form to use timer only in a project without a form. I usually use ActiveX EXE to separate control of the system. The advantage of using timer is to avoid deadlock of control, so as to simulate multithreading (actually multi-process) and give users a better experience. The Code is as follows:

Standard module (mtimer ):
Option   Explicit
Private Declare Sub Copymemory lib " Kernel32.dll " Alias " Rtlmovememory " (Byref destination As Any, byref Source As Any, byval Length As   Long )
Public Timercoll As   New VBA. Collection

Public   Sub Timeproc (byval hwnd As   Long , Byval umsg As   Long , Byval idevent As   Long , Byval dwtime As   Long )
Dim   Timer   As   Timer , Lptimer As   Long
Lptimer = Timercoll ( " ID: "   & Idevent)
Copymemory Timer , Lptimer, 4 &
Timer . Pulsetimer
Copymemory Timer , 0 & , 4 &
End sub

Class module ( Timer ):
Option   Explicit

Private Declare Function Settimer lib " USER32 " (Byval hwnd As   Long , Byval nidevent As   Long , Byval uelapse As   Long , Byval lptimerfunc As   Long ) As   Long
Private Declare Function Killtimer lib " USER32 " (Byval hwnd As   Long , Byval nidevent As   Long ) As   Long

Private M_timerid As   Long
Private M_interval As   Long
Private M_enabled As   Boolean

Public Tag As Variant
Public Event Timer ()

Public   Property   Get Interval () As   Long
Interval = M_interval
End Property

Public   Property   Let Interval (byval Value As   Long )
M_interval = Value
Enabled = M_enabled
End Property

Public   Property   Get Enabled () As   Boolean
Interval = M_enabled
End Property

Public   Property   Let Enabled (byval Value As   Boolean )
If Value Then
M_enabled = Starttimer
Else
Call Stoptimer
End   If
End Property

Private   Function Starttimer () As   Boolean
If M_timerid =   0   Then
If M_interval >   0   Then
M_timerid = Settimer ( 0 , 0 , M_interval, addressof timeproc)
If M_timerid <>   0   Then
Timercoll. Add objptr (me ), " ID: "   & M_timerid
Starttimer =   True
End   If
Else
M_enabled =   True
End   If
End   If
End Function

Friend Sub Pulsetimer ()
Raiseevent Timer
End sub

Private   Sub Stoptimer ()
If M_timerid <>   0   Then
Killtimer 0 , M_timerid
Timercoll. Remove " ID: "   & M_timerid
M_timerid =   0
M_enabled =   False
End   If
End sub

Private   Sub Class_terminate ()
Call Stoptimer
End sub

Usage:
Private Withevents timer1 As   Timer
Private   Sub Form_load ()
Set Timer1 =   New Timerlib. Timer
Timer1.interval =   1000
Timer1.enabled =   True
End sub
Private   Sub Timer1_timer ()
Debug. Print Now
End sub  

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.