Timer gibt Uhrzeit in StatBar aus.

 Das sieht dann so aus(die Form aus dem Beitrag hier wurde um 3 Command Buttons erweitert):

 Zunächst die Version ohne Handle.

Nachfolgenden Code in eine Userform 'frmSB_Demo':


 Option Explicit

Private Sub btnExit_Click()
   modTimer.StopTimer
   Me.Hide
   Unload Me
End Sub

Private Sub btnStart_Click()
   modTimer.StartTimer
End Sub

Private Sub btnStop_Click()
   modTimer.StopTimer
End Sub

Private Sub UserForm_Initialize()
   
   SetControlPos

End Sub

Sub SetControlPos()
   Dim L As Single
   Dim T As Single
   Dim W As Single
   Dim Wi As Single
   Dim Hi As Single
   Dim SBHeight As Single
   
   Wi = Me.InsideWidth
   Hi = Me.InsideHeight
   SBHeight = lblSB1.Height
   
   L = 0
   T = Hi - SBHeight
   W = 160
   lblSB1.Move L, T, W
   
   L = W
   W = 32
   lblSB2.Move L, T, W
   
   L = lblSB1.Width + W
   W = Wi - lblSB1.Width - W
   lblSB3.Move L, T, W
   
   L = 3
   T = Hi - btnStart.Height - lblSB1.Height - 3
   btnStart.Move L, T
   
   L = btnStart.Left + btnStart.Width + 3
   btnStop.Move L, T
   
   L = Wi - btnExit.Width - 3
   btnExit.Move L, T
   
End Sub
Sub SetSBText(strText As String, i As Integer)
   Select Case i
      Case 0
         lblSB1.Caption = strText
      Case 1
         lblSB2.Caption = strText
      Case 2
         lblSB3.Caption = strText
      Case Else
         MsgBox "Can't write text!", vbOKOnly, "SetSBText"
   End Select
End Sub


 Nachfolgenden Code in ein Modul 'modTimer':


 Option Explicit

Private Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

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 Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

Public iTimer As Integer                              'the timer identifier

Private Const lDelay As Long = 1000                    'the time in ms between WM_TIMER events

 

Public Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal iTimerID As Long, ByVal dwTime As Long) As Long
   Dim st As SYSTEMTIME

   GetLocalTime st
   frmSB_Demo.SetSBText Format$(st.wHour, "00") & ":" & Format$(st.wMinute, "00") & ":" & Format$(st.wSecond, "00"), 2
   
End Function

 

Sub CATMain()
   
   Load frmSB_Demo
   frmSB_Demo.Show

End Sub

 

Public Sub StartTimer()
   
   iTimer = SetTimer(0&, 0&, lDelay, AddressOf TimerProc)            'start timer
   
   If iTimer <> 0 Then                                               'is there a timer
      frmSB_Demo.SetSBText "Timer started", 0
   Else                                                              'if no timer exists
      MsgBox "Couldn't create timer. Exiting...", _
         vbOKOnly Or vbCritical, "StartTimer"                        'send message
      End                                                            'exit macro
   End If
End Sub


Public Sub StopTimer()
   KillTimer 0&, iTimer
   frmSB_Demo.SetSBText "Timer stopped", 0
End Sub


Nun die Version mit Handle.

Der Code der Form bleibt gleich. 

Der Code des Modules sieht nun so aus:


 Option Explicit

Private Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

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 Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const ID_TIMER1 = 1                             'the timer identifier

Private UF_hWnd As Long

Private Const lDelay As Long = 1000                    'the time in ms between WM_TIMER events

 

Public Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal iTimerID As Long, ByVal dwTime As Long) As Long
   Dim st As SYSTEMTIME

   GetLocalTime st
   frmSB_Demo.SetSBText Format$(st.wHour, "00") & ":" & Format$(st.wMinute, "00") & ":" & Format$(st.wSecond, "00"), 2
   
End Function

 

Sub CATMain()
   
   Load frmSB_Demo
   frmSB_Demo.Show

End Sub

 

Public Sub StartTimer()
   Dim iTimer As Integer
   
   UF_hWnd = FindWindow("ThunderDFrame", frmSB_Demo.Caption)
   iTimer = SetTimer(UF_hWnd, ID_TIMER1, lDelay, AddressOf TimerProc)             'start timer
   
   If iTimer <> 0 Then                                               'is there a timer
      frmSB_Demo.SetSBText "Timer started", 0
   Else                                                              'if no timer exists
      MsgBox "Couldn't create timer. Exiting...", _
         vbOKOnly Or vbCritical, "StartTimer"                        'send message
      End                                                            'exit macro
   End If
   
End Sub
Public Sub StopTimer()
   KillTimer UF_hWnd, ID_TIMER1
   frmSB_Demo.SetSBText "Timer stopped", 0
End Sub


Nach Drücken des Start-Buttons läuft der Timer; die Uhrzeit erscheint im rechten Panel der StatBar.

Die Stop-Taste hält den Timer an; die Uhr bleibt stehen.

Mit Exit wird das Makro beendet. Hierbei wird vorsorglich ein eventuell existierender Timer beendet.

Ein Manko weist das Programm noch auf:

Das Makro kann durch Drücken des Exit-Kreuzes oben rechts unkontrolliert beendet werden.

Um das zu unterbinden gibt's zwei Möglichkeiten:

  • das System-Menü ändern, wie hier
  • den QueryClose oder Terminate-Event bearbeiten. Etwa so:

Private Sub UserForm_Terminate()
   btnExit_Click
End Sub


Damit wird verhindert, dass ein Timer unbemerkt weiterläuft.

Die Version ohne Handle müsste auch entsprechend abgeändert werden.

Zum Seitenanfang