Does someone know how to put a clock in the SysTray? Yes, I know it´s already a clock there but i want to do one on my own. I mean a clock that update NOT an icon of a clock. So can someone solve this little problem for me?¿
Printable View
Does someone know how to put a clock in the SysTray? Yes, I know it´s already a clock there but i want to do one on my own. I mean a clock that update NOT an icon of a clock. So can someone solve this little problem for me?¿
Here's an example I put together which add a Flashing Colon to the Time to indicate the Seconds ticking by..
------------------Code:'In a Form with a Timer Control..
'
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type Size
cx As Long
cy As Long
End Type
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Const COLOR_BTNFACE = 15
Private Sub Form_Load()
Timer1.Interval = 990
End Sub
Private Sub Timer1_Timer()
Static sLastTime As String
Static bFlash As Boolean
Dim tSIZE As Size
Dim tRECT As RECT
Dim lFont As Long
Dim lDC As Long
Dim lHwnd As Long
Dim lOld As Long
Dim sTime As String
bFlash = Not bFlash
sTime = Format(Time, "HH" & IIf(bFlash, " ", ":") & "MM AM/PM")
If sTime = sLastTime Then Exit Sub
sLastTime = sTime
lHwnd = FindWindowEx(0, 0, "Shell_TrayWnd", vbNullString)
lHwnd = FindWindowEx(lHwnd, 0, "TrayNotifyWnd", vbNullString)
lHwnd = FindWindowEx(lHwnd, 0, "TrayClockWClass", vbNullString)
lDC = GetWindowDC(lHwnd)
Call GetWindowRect(lHwnd, tRECT)
lFont = CreateFont(-(9 / 72) * 96, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Arial")
lOld = SelectObject(lDC, lFont)
Call GetTextExtentPoint32(lDC, sTime, Len(sTime), tSIZE)
Call SetBkColor(lDC, GetSysColor(COLOR_BTNFACE))
Call TextOut(lDC, ((tRECT.Right - tRECT.Left) - tSIZE.cx) / 2, ((tRECT.Bottom - tRECT.Top) - tSIZE.cy) / 2, sTime, Len(sTime))
Call SelectObject(lDC, lOld)
Call DeleteObject(lFont)
Call ReleaseDC(lHwnd, lDC)
End Sub
Aaron Young
Analyst Programmer
[email protected]
[email protected]
Certified AllExperts Expert