2003-07-11 20:21

'
' Scheduler
' (C) 2003-07-11 MaWeSo
'
' Contact:  mailto:martin.wehner@firemail.de
' Homepage: http://mitglied.lycos.de/maweso/
'
' Compile the following source with the RapidQ Compiler
' (available at http://www.basicguru.com/rapidq).
' For better runtime stability it is highly recommended
' to use the patched Rapid-Q Library Files available
' at http://www.angelfire.com/space/netcensus/ when
' compiling this source.
'
' The program runs as tray icon. Every full hour between
' 9:00 and 18:00 a message window with a time stamp pops
' up. If you replace ShowMessage(TIME$) by RUN [command]
' you can execute an external command instead.
' Right click on the tray icon to open a popup menu. The
' menu item "Exit" terminates the tray application.
'
' This source code is distributed under GNU General
' Public License. The executable based on this unmodified
' source code is FREEWARE. Use it on your own risk.
'

     CONST WM_LBUTTONUP = &H202
     CONST WM_RBUTTONUP = &H205
     CONST NIM_ADD = &H0
     CONST NIM_MESSAGE = &H1
     CONST NIM_DELETE = &H2
     CONST NIM_ICON = &H2
     CONST NIM_TIP = &H4
     CONST GWL_HWNDPARENT = (-8)

     TYPE POINTAPI
      x AS LONG
      y AS LONG
     END TYPE

     TYPE MSG
      hWnd AS LONG
      message AS LONG
      wParam AS LONG
      lParam AS LONG
      time AS LONG
      pt AS POINTAPI
     END TYPE

     DECLARE FUNCTION Shell_NotifyIconAPI LIB "shell32" ALIAS "Shell_NotifyIconA" _
      (BYVAL dwMessage AS LONG, BYVAL lpData AS QNOTIFYICONDATA) AS LONG
     DECLARE FUNCTION DispatchMessageAPI LIB "user32" ALIAS "DispatchMessageA" _
      (lpMsg AS MSG) AS LONG
     DECLARE FUNCTION GetCursorPosAPI LIB "user32" ALIAS "GetCursorPos" _
      (BYVAL lpPoint AS LONG) AS LONG
     DECLARE FUNCTION GetMessageAPI LIB "user32" ALIAS "GetMessageA" _
      (lpMsg AS MSG, BYVAL hWnd AS LONG, BYVAL wMsgFilterMin AS LONG, _
      wMsgFilterMax AS LONG) AS LONG
     DECLARE FUNCTION SetForegroundWindowAPI LIB "user32" ALIAS "SetForegroundWindow" _
      (hWnd AS LONG) AS LONG
     DECLARE FUNCTION SetWindowLongAPI LIB "user32" ALIAS "SetWindowLongA" _
      (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG) AS LONG
     DECLARE FUNCTION TranslateMessageAPI LIB "user32" ALIAS "TranslateMessage" _
      (lpMsg AS MSG) AS LONG
     DECLARE SUB PostQuitMessageAPI LIB "user32" ALIAS "PostQuitMessage" _
      (BYVAL nExitCode AS LONG)

     DIM TimerInterrupt AS QTIMER
     DIM TrayMenu AS QPOPUPMENU
     DIM TrayExitItem AS QMENUITEM
     DIM TrayForm AS QFORM
     DIM hour AS INTEGER
     hour = VAL(LEFT$(TIME$, 2))
     DIM nid AS QNOTIFYICONDATA
     nid.hWnd = TrayForm.Handle
     nid.uID = Application.hInstance
     nid.uFlags = NIM_ICON OR NIM_MESSAGE OR NIM_TIP
     nid.hIcon = Application.Icon
     nid.uCallBackMessage = WM_LBUTTONUP
     nid.szTip = "Scheduler"

     Shell_NotifyIconAPI(NIM_ADD, nid)

     SUB TrayClose
      Shell_NotifyIconAPI(NIM_DELETE, nid)
      PostQuitMessageAPI(0)

      Application.Terminate ' Necessary to terminate the process when message windows are still open
     END SUB

     SUB TrayHandler (Button AS SHORT, X AS SHORT, Y AS SHORT, Shift AS SHORT)
      DIM p AS POINTAPI

      IF X = WM_RBUTTONUP THEN
       SetForegroundWindowAPI(TrayForm.Handle) ' Close popup menu when clicking somewhere else
       GetCursorPosAPI(p)
       TrayMenu.Popup(p.x, p.y)
      END IF
     END SUB

     SUB TrayInterrupt
      DIM h AS INTEGER

      h = VAL(LEFT$(TIME$, 2))
      IF NOT (hour = h) THEN
       hour = h
       SELECT CASE hour
       CASE 9 TO 18
        SetForegroundWindowAPI(TrayForm.Handle)
        SHOWMESSAGE(TIME$) ' Replace this by RUN [command]
       END SELECT
      END IF
     END SUB

     SUB WndProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG)
      IF uMsg = WM_QUERYENDSESSION THEN TrayClose ' Windows session is terminating
     END SUB

     SetWindowLongAPI(TrayForm.Handle, GWL_HWNDPARENT, 0)
     SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, TrayForm.Handle)

     TrayForm.Width = 0
     TrayForm.Height = 0
     TrayForm.WndProc = WndProc
     TrayForm.OnMouseUp = TrayHandler

     TimerInterrupt.Enabled = 1
     TimerInterrupt.Interval = 60000 ' Check every minute (60000 ms)
     TimerInterrupt.OnTimer = TrayInterrupt

     TrayExitItem.CAPTION = "E&xit"
     TrayExitItem.OnClick = TrayClose

     TrayMenu.AddItems TrayExitItem

     DIM m AS MSG
     WHILE GetMessageAPI(m, 0, 0, 0)
      TranslateMessageAPI(m)
      DispatchMessageAPI(m)
     WEND

2003-07-11 20:21