Warsztat 2: Własny wygaszacz ekranu.

Wygaszacz.zip
Autor: Mirek
Baza w formacie MsAccess 97 
13kB, 17-01-2002

Opis problemu:

Wygaszacz ekranu może uatrakcyjnić nasz program (bo chyba jego pierwotna funkcja ochrony monitora przed zbędnym wypalaniem luminoforu już raczej nie gra istotnej roli przy współczesnych monitorach).

Rozwiązanie:

Wygaszacz ekranu... to określenie może trochę na wyrost w stosunku do prezentowanego przykładu, ponieważ brakuje w nim wykrywania braku aktywności programu. Rozwiązanie, które przysłał Mirek wyświetla na cały ekran modalny formularz, który spełnia funkcję wygaszacza.

Dla tych, którzy chcieliby wykorzystać wygaszacz Mirka, ale brakuje im mechanizmu wykrywania braku aktywności użytkownika w celu automatycznego wywołania wygaszacza po upływie określonego czasu - proponuje poniższy kod. Bez istotnych przeróbek skopiowałem go z MSDN Library - Microsoft.
Formularz, w którym zdefiniowano procedurę zdarzenia Form_Timer() może być ukryty lub może być to ten sam formularz, który pełni rolę wygaszacza. Jednak wtedy jego wizualizacja w procedurze IdleTimeDetected nie powinna się odbywać za pomocą DoCmd.OpenForm, ale Me.Visible=True.

'Procedura wywoływana w przypadku braku aktywności użytkownika
Sub IdleTimeDetected(ExpiredMinutes)
    'MsgBox "Brak aktywności użytkownika od co najmniej " _
    & ExpiredMinutes & " minut!"
    DoCmd.OpenForm "WygaszaczEkranu"
End Sub

'Procedura zdarzenia na formularzu.
'TimerInterval należy ustawić na 1000 (milisekund)
Private Sub Form_Timer()
Const IDLEMINUTES = 5 'IDLEMINUTES określa po ilu minutach
'nastąpi wywołanie procedury IdleTimeDetected
Static PrevControlName As String
Static PrevFormName As String
Static ExpiredTime
Dim ActiveFormName As String
Dim ActiveControlName As String
Dim ExpiredMinutes

On Error Resume Next
    'Pobranie nazwy aktywnego formularza i formantu.
    ActiveFormName = Screen.ActiveForm.Name
    If Err Then
       ActiveFormName = "No Active Form"
       Err = 0
    End If
    
    ActiveControlName = Screen.ActiveControl.Name
       If Err Then
       ActiveControlName = "No Active Control"
       Err = 0
    End If
    
    'Zapamiętanie aktywnych nazw i wyzerowanie ExpiredTime
    'w przypadku, gdy:
    '1. Procedura wykonywana jest po raz pierwszy
    '2. Poprzednie nazwy są różne od bieżących.
    If (PrevControlName = "") Or (PrevFormName = "") _
      Or (ActiveFormName <> PrevFormName) _
      Or (ActiveControlName <> PrevControlName) Then
       PrevControlName = ActiveControlName
       PrevFormName = ActiveFormName
       ExpiredTime = 0
    Else
        '...znaczy, że użytkownik chyba odpoczywa
        ExpiredTime = ExpiredTime + Me.TimerInterval
    End If
    
    'Sprawdzenie, czy całkowity czas przerwy
    'przekroczył IDLEMINUTES?
    ExpiredMinutes = (ExpiredTime / 1000) / 60
    If ExpiredMinutes >= IDLEMINUTES Then
        '... jeśli tak, zerujemy ExpiredTime
        ExpiredTime = 0
        '... i wywołujemy IdleTimeDetected
        IdleTimeDetected ExpiredMinutes
    End If
    
End Sub