I have written a small program that shows a little calendar to the right of the rightmost screen. At work I need to convert dates to week numbers and reverse, so I made a very simple version of this calendar. This weekend I decided to develop it a bit further and added a systray icon with a small menu, plus hided it from the task bar.
Since some code snippets was borrowed from this eminent forum, I thought, why not share my little program with You guys.
Short instruction:
You have to make a .ico file (or use some that you already have. It's included in the data section in the beginning.
Starting the program a small calendar appears to the right. Click elsewhere on the screen and there will be a delay of 10 seconds until it hides itself on the edge. Click on that edge to make the window slide forth again.
In the sys tray, You can tell it show itself, quit or toggle autostart with windows. (not sure the autostart will work with other than win10, but please try. )
Have fun keeping track of every years week!
Code: Select all
; History:
; 2022-05-08 V2
; * Last touches after making a sys tray icon With a menu.
; * Making the window disappear on the task bar.
; * Removed frame from the window.
; * Desktop Calendar will appear on the rightmost side of the rightmost screen - no matter placement of the screens (as long as they are configured in Windows as placed physically).
; * Autostart function to have Desktop Calendar started when your computer is started.
EnableExplicit
Define EventID
Define rightX, topY, nDesktops, i
Structure Measure
desktop.l
size.l
EndStructure
Declare.s ReadAutoStartString()
Declare WriteAutoStartString(appName$)
Declare EmptyAutoStartString()
Declare HideFromTaskBar(iWin.i)
DataSection
Icon:
IncludeBinary "DesktopCalendar.ico"
EndDataSection
; primär skärm är första index (0).
nDesktops = ExamineDesktops()
If nDesktops = 1
rightX = DesktopX(0) + DesktopWidth(0)
topY = DesktopY(0)
Debug "x = " + Str(rightX)
Debug "y = " + Str(topY)
Else
; it's a bit more complex if there are more than one screen:
Dim x.Measure(nDesktops)
Dim y.Measure(nDesktops)
For i = 1 To nDesktops - 1
x(i)\desktop = i
x(i)\size = DesktopX(i) + DesktopWidth(i)
y(i)\desktop = i
y(i)\size = DesktopY(i)
Next
; by sorting the arrays, the best choice will be the first one in each array
SortStructuredArray(x(), #PB_Sort_Descending, OffsetOf(Measure\size), TypeOf(Measure\size))
SortStructuredArray(y(), #PB_Sort_Ascending, OffsetOf(Measure\size), TypeOf(Measure\size))
; find out if the difference between the two best choosen screen is greater in y than x (placed on top of another)
If Abs(y(0)\size - y(1)\size) > Abs(x(0)\size - x(1)\size)
; choose y-direction as primary (decides to put window on the topmost screen)
rightX = DesktopX(y(0)\desktop) + DesktopWidth(y(0)\desktop)
topY = y(0)\size
Else
; choose x-direction as primary (put window on the rightmost screen)
rightX = x(0)\size
topY = DesktopY(x(0)\desktop)
EndIf
EndIf
If OpenWindow(0, rightX - 245, topY, 240, 130, "")
HideFromTaskBar(0)
SetWindowColor(0, 0)
StickyWindow(0, #True)
SetWindowLongPtr_(WindowID(0), #GWL_STYLE, GetWindowLongPtr_(WindowID(0), #GWL_STYLE) ! (#WS_DLGFRAME | #WS_BORDER)) ; Remove window frames
CalendarGadget(1, 1, 0, 240, 160)
SetWindowLongPtr_(GadgetID(1),#GWL_STYLE,GetWindowLongPtr_(GadgetID(1),#GWL_STYLE)|#MCS_WEEKNUMBERS|#MCS_NOTODAYCIRCLE)
CatchImage(0, ?Icon)
AddSysTrayIcon(100, WindowID(0),ImageID(0))
SysTrayIconToolTip(100, "Desktop Calendar")
If CreatePopupMenu(0) ; creation of the pop-up menu begins...
MenuItem(1, "Show Calendar") ; You can use all commands for creating a menu
MenuItem(2, "Autostart with Windows")
MenuItem(4, "Quit")
If ReplaceString(ReadAutoStartString(), " ", "") = "" ; just a bunch of spaces indicates that no key exist in the registry yet.
SetMenuItemState(0, 2, #False)
Else
SetMenuItemState(0, 2, #True)
EndIf
EndIf
Define slideWindow, elapsedTime
Repeat
Repeat
EventID = WaitWindowEvent(10)
Until EventID <> #PB_Event_MoveWindow And EventID <> #PB_Event_Repaint
Select EventID
Case #PB_Event_Menu
; check out the popup menu
Select EventMenu()
Case 1
; slide window in
slideWindow = #False
While WindowX(0) > rightX - 244
ResizeWindow(0, WindowX(0) - 1, WindowY(0), 240, 160)
Wend
Case 2
If GetMenuItemState(0, 2) = #False
WriteAutoStartString(Chr(34) + ProgramFilename() + Chr(34))
SetMenuItemState(0, 2, #True) ; checkmark autostart
Else
EmptyAutoStartString()
SetMenuItemState(0, 2, #False)
EndIf
Case 4
End
EndSelect
Case #PB_Event_SysTray
DisplayPopupMenu(0, WindowID(0))
Case #PB_Event_DeactivateWindow
slideWindow = #True
elapsedTime = ElapsedMilliseconds()
Case #PB_Event_ActivateWindow
; slide window in
slideWindow = #False
While WindowX(0) > rightX - 244
ResizeWindow(0, WindowX(0) - 1, WindowY(0), 240, 160)
Wend
Case #PB_Event_CloseWindow
End
EndSelect
If slideWindow = #True And ElapsedMilliseconds() - elapsedTime > 10000 And WindowX(0) < rightX - 1
ResizeWindow(0, WindowX(0) + 1, WindowY(0), 240, 160)
If WindowY(0) > topY + 1
ResizeWindow(0, WindowX(0), WindowY(0) - 1, 240, 160)
EndIf
Delay(10)
EndIf
ForEver
Else
MessageRequester("DesktopCalendar", "System error? Couldn't open main window - exiting... (try a reboot, perhaps?)")
EndIf
Procedure.s ReadAutoStartString()
Protected size, name$, result, key
size = #MAX_PATH
name$ = Space(size)
result = RegOpenKeyEx_(#HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", 0, #KEY_ALL_ACCESS, @key)
If result = 0
RegQueryValueEx_(key, "DesktopCalendar", 0, 0, @name$,@size)
RegCloseKey_(key)
EndIf
ProcedureReturn name$
EndProcedure
Procedure WriteAutoStartString(appName$)
Protected newKey, keyInfo
RegCreateKeyEx_(#HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @newKey, @keyInfo)
RegSetValueEx_(newKey, "DesktopCalendar", 0, #REG_SZ, appName$, 2*Len(appName$) + 1)
RegCloseKey_(newKey)
EndProcedure
Procedure EmptyAutoStartString()
Protected newKey, keyInfo
RegCreateKeyEx_(#HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @newKey, @keyInfo)
RegSetValueEx_(newKey, "DesktopCalendar", 0, #REG_SZ, "", 1)
RegCloseKey_(newKey)
EndProcedure
Procedure HideFromTaskBar(iWin.i)
;#------------------------------
;Use to prevent upteen icons appearing on the task bar when child windows are displayed
DataSection
CLSID_TaskBarList:
Data.l $56FDF344
Data.w $FD6D, $11D0
Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
IID_ITaskBarList:
Data.l $56FDF342
Data.w $FD6D, $11D0
Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
EndDataSection
Protected hWnd.i = WindowID(iWin)
Protected TBL.ITaskbarList
CoInitialize_(0)
If CoCreateInstance_(?CLSID_TaskBarList, 0, 1, ?IID_ITaskBarList, @TBL) = #S_OK
TBL\HrInit()
TBL\DeleteTab(hWnd)
TBL\Release()
EndIf
CoUninitialize_()
EndProcedure