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.