- •Лекция 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()
Private maicnClients() As iCoffeeNotify
Private mlngMaxClients As Long
' mXTimer holds a reference to a code-only timer that tells CoffeeMonitor2 when to check the pot. Because the variable is declared WithEvents, the CoffeeMonitor2 object receives the XTimer object's Tick events (see Sub mwXTimer_Tick, below). Code for the XTimer object can be found in XTimers.vbp.
Private WithEvents mwXTimer As XTimer
Private Sub Class_Initialize()
' Allocate some space in the array of client objects.
mlngMaxClients = ICN_ARRAYINCREMENT
ReDim maicnClients(1 To mlngMaxClients)
'
' Create the XTimer object. When this assignment is made, Visual Basic connects the XTimer's Tick event to the mwXTimer_Tick event procedure (see below).
Set mwXTimer = New XTimer
'
' The timer is set to tick every ten seconds (10,000 milliseconds).
mwXTimer.Interval = 10000
mwXTimer.Enabled = True
End Sub
Private Sub Class_Terminate()
Dim intCt As Integer
' It's important to disable the XTimer before releasing it. As described in XTimers.vbp, abandoning a running XTimer essentially leaks a system timer until XTimers.DLL finally shuts down.
mwXTimer.Enabled = False
Set mwXTimer = Nothing
' Release all remaining call-back clients, in case they released CoffeeMonitor2 without first requesting an end to notifications.
For intCt = 1 To mlngMaxClients
Set maicnClients(intCt) = Nothing
Next
'
Debug.Print "CoffeeMonitor2 (call-backs) terminated at " & Now
End Sub
' TellMeReady is called by a client who wants to receive a call-back when the coffee is ready. The client must implement the ICoffeeNotify interface, defined in the ICoffeeNotify class.
'
Public Sub TellMeReady(ByVal icn As iCoffeeNotify)
Dim lngCt As Long
' Find an opening in the array of interfaces.
For lngCt = 1 To mlngMaxClients
If maicnClients(lngCt) Is Nothing Then Exit For
Next
'
' If there were no openings, grow the array.
If lngCt > mlngMaxClients Then
mlngMaxClients = mlngMaxClients + ICN_ARRAYINCREMENT
ReDim Preserve maicnClients(1 To mlngMaxClients)
End If
'
Set maicnClients(lngCt) = icn
'
' Give the object the index of its entry, as a key for quick lookup when disconnection is requested.
icn.NotifyID = lngCt
End Sub
' CeaseCallBacks removes the client from the list of objects
' -------------- receiving call-back notifications, using
' the key the object was assigned when it requested
' notifications.
'
Public Sub CeaseCallBacks(ByVal icn As iCoffeeNotify)
Set maicnClients(icn.NotifyID) = Nothing
End Sub
' mwXTimer_Tick is the event procedure CoffeeMonitor2 uses to receive the XTimer object's Tick events. The name of an event procedure that's
' associated with a WithEvents variable always has the variable name as a prefix.
Private Sub mwXTimer_Tick()
Dim lngCt As Long
' (Code to test serial port omitted.)
'
On Error Resume Next
'
' The call-back method must be called for each object
' that has requested a notification.
For lngCt = 1 To mlngMaxClients
If Not maicnClients(lngCt) Is Nothing Then
maicnClients(lngCt).CoffeeReady
If Err.Number <> 0 Then
' Error &H80010005 is ignored, because it
' can be caused by the client object being
' temporarily unresponsive.
If Err.Number <> &H80010005 Then
' If a client application has closed without
' ending the notifications, remove it from
' the list.
Set maicnClients(lngCt) = Nothing
End If
'
' When On Error Resume Next is used, the
' error number must be cleared after each
' error.
Err.Number = 0
End If
End If
Next
End Sub