- •Лекция 13
- •XTimers.Vbp 5
- •Обзор задачи Coffee Sample Application
- •XTimers.Vbp
- •XTimerSupport.Bas
- •Private Type xtimerinfo ' Hungarian xti
- •Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal lngSysTime As Long)
- •If maxti(intCt).BlnReentered Then Exit Sub
- •Public Sub EndTimer(ByVal xt As xTimer)
- •Public Sub Scrub()
- •Public Property Get Interval() As Long
- •Public Property Let Interval(ByVal NewInterval As Long)
- •Public Sub RaiseTick()
- •Private Sub Class_Terminate()
- •MtCoffee.Vbp modMt.Bas Option Explicit
- •Public glngGlobalData As Long
- •Coffee.Bas
- •Option Explicit
- •Private Declare Function timeGetTime Lib "winmm.Dll" () As Long
- •Private mlngIterations As Long
- •Public Property Get NumberOnThread() As Long
- •Public Sub StartLongTask(ByVal Iterations As Long)
- •Public Function GetCoffeeOnSameThread() As Coffee
- •Public Function GetCoffeeOnNewThread() As Coffee
- •If blnCancel Then
- •Coffee.Cls Option Explicit Private Declare Function timeGetTime Lib "winmm.Dll" () As Long
- •Private mlngIterations As Long
- •Public Property Get NumberOnThread() As Long
- •Public Sub StartLongTask(ByVal Iterations As Long)
- •Public Function GetCoffeeOnSameThread() As Coffee
- •Public Function GetCoffeeOnNewThread() As Coffee
- •If blnCancel Then
- •Public Property Get CoffeeMonitor() As CoffeeMonitor
- •If gCoffeeMonitor Is Nothing Then
- •CoffeeMonitor.Cls Option Explicit
- •Private WithEvents mwXTimer As xTimer
- •Event CoffeeReady() Private Sub Class_Initialize()
- •Private Sub Class_Terminate()
- •Private Sub mwXTimer_Tick()
- •Connector2.Cls Option Explicit
- •Public Property Get CoffeeMonitor2() As CoffeeMonitor2
- •CoffeeMonitor2 Option Explicit
- •Private maicnClients() As iCoffeeNotify
- •Public Sub TellMeReady(ByVal icn As iCoffeeNotify)
- •Public Sub CeaseCallBacks(ByVal icn As iCoffeeNotify)
- •Private Sub mwXTimer_Tick()
- •ICoffeeNotify.Cls
- •Public ThreadId As Long
- •Private Sub mwCoffee_Progress(ByVal PercentDone As Single, Cancel As Boolean)
- •Private Sub cmdCallBacks_Click()
- •Private Sub cmdMt_Click()
- •Private Sub Form_Unload(Cancel As Integer)
- •Private Sub mwcmnEvents_CoffeeReady()
- •FrmThread.Frm
- •Private Sub cmdCancel_Click()
- •Private Sub cmdShortOnly_Click()
- •Private Sub cmdShortLong_Click()
- •Private Sub cmdNLong_Click()
- •Private Sub cmdXThread_Click()
- •Private Sub cmdIDs_Click()
- •Private Sub tmrShort_Timer()
Public Property Get Interval() As Long
Interval = mlngInterval
End Property
'
Public Property Let Interval(ByVal NewInterval As Long)
' If the new value for Interval is the same as the old, there's no reason to do anything.
If NewInterval = mlngInterval Then Exit Property
' Save the new value.
mlngInterval = NewInterval
'
' If the XTimer is active, mlngTimerID is non-zero. in this case, the old system timer must be ended before a new one is started.
If mlngTimerID <> 0 Then
Call EndTimer(Me)
mlngTimerID = 0
End If
'
' If the new interval is zero, then the XTimer becomes inactive, regardless of the current value of Enabled. If the new interval is not zero, AND the Enabled property is True, then a new system timer is started, and its ID is stored in mlngTimerID.
If (NewInterval <> 0) And mblnEnabled Then
mlngTimerID = BeginTimer(Me, NewInterval)
End If
End Property
' RaiseTick method is called by the support module when the system timer event occurs for this XTimer object's system timer.
' Implementation detail: You might expect to declare this method Friend instead of Public, as there's no need for the client to call RaiseTick. However, it's critical that RaiseTick be declared Public, because the XTimer might be released while the Tick event is still being handled. An object will not terminate while one of its Public methods is on the stack, but it CAN terminate while one of its Friend methods is on the stack. If the object terminates before the Friend method returns (which could happen if the client executes a lot of code in the XTimer's Tick event), a GPF will result. (Note that this is a highly unusual scenario that depends on an external event; it does not occur in ordinary use of Friend functions.)
'
Public Sub RaiseTick()
RaiseEvent Tick
End Sub
Private Sub Class_Terminate()
' When the client releases its last reference to an XTimer object, it goes away -- but only if the XTimer's Enabled property is False, or its Interval property is True!
' This is because while the XTimer's system timer is running, the XTimerSupport module has to have a reference to the XTimer in order to raise its Tick event. Thus, failure of the client to disable XTimer objects before releasing them will LEAK system timers!
' These leaked system timers will not be recovered until the XTimers component shuts down -- that is, when the client using the DLL shuts down. The DLL will NOT unload when all XTimer objects are released, because references to public objects (in this case, those held by XTimerSupport) will prevent a DLL from unloading.
'So why bother to clean up the system timer in the Terminate event? Because when the DLL is getting shut down, all references to the XTimer object will be cleaned up and the XTimer will get its Terminate event. The system timer should be destroyed at this point.
On Error Resume Next
If mlngTimerID <> 0 Then KillTimer 0, mlngTimerID
' The following is what XTimer should do if it could somehow be released prior to DLL shutdown.
'If mlngTimerID <> 0 Then Call EndTimer(Me)
End Sub