DesktopCalendar

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
FihmpenRouk
User
User
Posts: 27
Joined: Mon May 08, 2006 2:27 pm

DesktopCalendar

Post by FihmpenRouk »

Hi PureBasic friends.

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. :wink: )

Have fun keeping track of every years week! 8)

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
PureBasic occasionally since 2000 - when hacks are to be done. :smile: