Originally written and tested on Windows XP Pro using jaPBe v3.12 and PureBasic v4.60
[EDIT] 02/25/26 -- No longer 5.4x compatible but works great again in v6.30 after a few bug fixes.
[EDIT] 11/09/34 -- 2 modifications as noted in comments below:
[EDIT] 11/11/34 -- added patch to force listing to bottom when event count exceeds display area
[Updated] 11/27/24 -- Details inside code.
[EDIT] 11/30/24 -- added code at top of file to prevent more than one instance <<VERY CRITICAL
[EDIT] 10/4/25 -- Revised below to fix bug -- Calendar was not showing and double-click on calendar date not working.
BIG THANKS to Michael Vogel for that calendar fix!!!!!
[EDIT] 02/16/26 -- Fixed line number alignment for tool tips showing wrong descriptions after scrolling down list of events.
Code: Select all
; Snippet from 'Fluid byte' over there in the German forum
; used here as base starting point for 'Event Countdown Reminder':
; http://www.purebasic.fr/german/viewtopic.php?t=17692&start=4
; With special thanks to members of this thread:
; http://www.purebasic.fr/english/viewtopic.php?f=13&t=38387
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
CompilerWarning "This code only supported in Windows, Sorry."
CompilerEndIf
Global hWin.i, AppName.s
AppName.s = "EventReminder"
#LVNI_VISIBLE = $0010
Procedure.l EnumWindows(WindowHandle.l, Parameter.l)
Title$ = Space(200)
GetWindowText_(WindowHandle, @Title$, 200)
If FindString(Title$, AppName, 1, #PB_String_NoCase ) <> 0
HwndDebug = WindowHandle
hWin.i = WindowHandle
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
If GetCurrentDirectory() <> "D:\PureBasic\PB_prjct-630\"
EnumWindows_(@EnumWindows(), 0)
If hWin.i
Debug "HERE IS YOUR Window Handle: "+Str(hwin.i)
SetForegroundWindow_(hWin.i) ; and bring current instance into foreground.
ShowWindow_(hWin.i, #SW_RESTORE)
Delay(250)
End ; Quit from this duplicate instance.
EndIf
EndIf
Debug "NO, there is NO "+AppName
Enumeration 420
; Event Reminder
#RemindCalendar
#RemindEdit
#RemindList
#RemindAdd
#RemindDiscard
#RemindTrashAll
EndEnumeration
Debug "#RemindCalendar"+Str(#RemindCalendar)
Debug "#RemindEdit"+Str(#RemindEdit)
Debug "#RemindList"+Str(#RemindList)
Debug "#RemindAdd"+Str(#RemindAdd)
Debug "#RemindDiscard"+Str(#RemindDiscard)
Debug "#RemindTrashAll"+Str(#RemindTrashAll)
Global timenow.i, AnimateReminder.l, _x, _y
_x = GetSystemMetrics_(#SM_CXSCREEN)
_y = GetSystemMetrics_(#SM_CYSCREEN)
Debug Str(_x) +" "+Str(_y)
Global DoMinimizedcSave
Global lippi.LASTINPUTINFO ; Wow! Who understands this stuff??!
lippi\cbSize = SizeOf(LASTINPUTINFO) ; Compensating for "dumb" API I guess??
#MCM_HITTEST = #MCM_FIRST + 14
#MCHT_CALENDAR = $20000
#MCHT_CALENDARDATE = #MCHT_CALENDAR | $0001
lvc.LV_COLUMN ; set up structure for global use to format ListIconGadget columns
lvc\mask = #LVCF_FMT
lvc\fmt = #LVCFMT_RIGHT
Global lpPrevFunc, WnHdl.i, now.i, selected.i, eventFile$, eventbackup$
TAG_CR$ = Chr(13)+Chr(10)
eventFile$=GetEnvironmentVariable("USERPROFILE") + "\MyEvents.txt"
eventbackup$=GetEnvironmentVariable("USERPROFILE") + "\MyEvents.bak"
#MainWindow = 1
#DateWindow = 0
If FileSize(eventFile$)= -1
CreateFile(0,eventFile$)
CloseFile(0)
EndIf
Procedure ReallySetForegroundWindow(m_hWnd.l)
; http://www.drdobbs.com/184405755
hOtherWnd.l = GetForegroundWindow_()
;
; get thread handles on our window and foreground window
hMyThread.l = GetWindowThreadProcessId_(m_hWnd, 0)
hOtherThread.l = GetWindowThreadProcessId_(hOtherWnd,0)
;
; attach our thread to foreground thread, take foreground, and detach threads
AttachThreadInput_(hMyThread,hOtherThread, #True)
SetForegroundWindow_(m_hWnd)
AttachThreadInput_(hMyThread,hOtherThread, #False)
;
; Now that our window "thread" has fisrt place in the queue...
; make sure our "window" is visible
If IsIconic_(m_hWnd)
ShowWindow_(m_hWnd,#SW_RESTORE)
Else
ShowWindow_(m_hWnd,#SW_SHOW)
EndIf
SetActiveWindow(GetDlgCtrlID_(m_hWnd))
WaitWindowEvent()
SetForegroundWindow_(m_hWnd)
EndProcedure
Structure Cells
chronos.l
Descript$
EndStructure
Global NewList Ocassion.Cells()
Procedure FixTitle()
s$ = " Reminder" + FormatDate("%mm/%dd/%yyyy",Date())
SetWindowTitle(1,s$)
EndProcedure
Procedure TopOfToday()
Protected TODAY$
TODAY$ = Str(Month(Date()))
TODAY$ + "/" + Str(Day(Date()))
TODAY$ + "/" + Str(Year(Date()))
Debug TODAY$
now=ParseDate("%mm/%dd/%yyyy", TODAY$)
ProcedureReturn now
EndProcedure
Procedure reList()
Protected place
;FixTitle()
TopOfToday()
SortStructuredList(Ocassion(), 0, OffsetOf(Cells\chronos), #PB_Long)
place = 0
ForEach Ocassion()
date1 = Ocassion()\chronos
days = (date1 - now) /86400
If days = 0
dayZero.l = #True
GetLastInputInfo_(@lippi) ; no recent user activity so let show and animate 'reminder'
timenow.i = ElapsedMilliseconds() ; get current timestamp value for comparison calculations
If timenow.i - lippi\dwTime > 100
AnimateReminder.l = #True
EndIf
event$ = "TODAY is"
If IsWindowVisible_(WindowID(0))
ResizeWindow(#DateWindow, WindowX(1)+112, WindowY(1), #PB_Ignore, #PB_Ignore)
HideWindow(1,0)
ShowWindow_(WindowID(1),#SW_RESTORE)
HideWindow(#DateWindow,0)
Else
HideWindow(1,0)
ShowWindow_(WindowID(1),#SW_RESTORE)
EndIf ; BBGGRR
SetGadgetItemColor(2, place, #PB_Gadget_BackColor, $10F8F8, -1)
ElseIf days < 2
event$ = Str(days) + " day until"
SetGadgetItemColor(2, place, #PB_Gadget_BackColor, $0E0F0, -1)
ElseIf days < 35
event$ = Str(days) + " days until"
SetGadgetItemColor(2, place, #PB_Gadget_BackColor, -1, -1)
Else
event$ = Str(days/7) + " weeks until"
SetGadgetItemColor(2, place, #PB_Gadget_BackColor, -1, -1)
EndIf
SetGadgetItemText(2,place,event$,0)
SetGadgetItemText(2,place,Ocassion()\Descript$,1)
place + 1
Next
SendMessage_(GadgetID(2), #LVM_ENSUREVISIBLE, place-1, #False)
EndProcedure
Procedure ModEntry()
date1 = ParseDate("%mm/%dd/%yyyy",FormatDate("%mm/%dd/%yyyy",GetGadgetState(0)))
SelectElement(Ocassion(), selected)
Ocassion()\chronos = date1
s$ = GetGadgetText(1)
If s$ = ""
s$ = "undefined event"
EndIf
Ocassion()\Descript$ = s$
reList()
DisableGadget(3,0)
SetGadgetState(2,-1) ; deselect all items
EndProcedure
Procedure LoadEvents()
Protected F1.l, F2$
If ReadFile(0,eventFile$)
If Lof(0) > 10
Repeat
F2$ = ReadString(0,#PB_Ascii)
F1.l = Val(F2$)
F2$ = ReadString(0,#PB_Ascii)
AddElement(Ocassion())
Ocassion()\chronos = F1
Ocassion()\Descript$ = F2$
AddGadgetItem(2,-1,"Loading...")
Until Eof(0)
reList()
EndIf
success = #True
CloseFile(0)
Else
Select MessageRequester("Read Failure!", "Unabblle to load events file." + Chr(10) + "Do you want to load events from backup?", #MB_YESNOCANCEL|#MB_ICONWARNING|#MB_TASKMODAL)
Case #IDYES
If ReadFile(0,eventbackup$)
If Lof(0) > 10
Repeat
F2$ = ReadString(0,#PB_Ascii)
F1.l = Val(F2$)
F2$ = ReadString(0,#PB_Ascii)
AddElement(Ocassion())
Ocassion()\chronos = F1
Ocassion()\Descript$ = F2$
AddGadgetItem(2,-1,"Loading...")
Until Eof(0)
reList()
EndIf
CloseFile(0)
success = #True
EndIf
Case #IDNO
Select MessageRequester("WARNING!!!!", "Starting from scratch because Read Events Failed." + Chr(10) + "Do you want to continue from scratch?", #MB_OKCANCEL|#MB_ICONWARNING|#MB_TASKMODAL|#MB_DEFBUTTON2)
Case #IDOK
success = #True
Case #IDCANCEL
success = #False
EndSelect
Case #IDCANCEL
success = #False
EndSelect
EndIf
ProcedureReturn success
EndProcedure
Procedure SaveEvents()
DeleteFile(eventbackup$,#PB_FileSystem_Force)
If RenameFile(eventFile$, eventbackup$)
If CreateFile(0,eventFile$)
ForEach Ocassion()
F1 = Ocassion()\chronos
F2$ = Str(F1)
WriteStringN(0,F2$,#PB_Ascii)
F2$ = Ocassion()\Descript$
WriteStringN(0,F2$,#PB_Ascii)
Next
CloseFile(0)
EndIf
success = #True
Else
MessageRequester("READ ERROR!", "Unable to Create backup!", #MB_OK|#MB_ICONWARNING|#MB_TASKMODAL)
EndIf
ProcedureReturn success
EndProcedure
Procedure JogReminder()
Protected x, y
Repeat
x = Random(_x - 317,200)
Until Abs(WindowX(1) - Abs(x)) > 100
Repeat
y = Random(_y - 199,200)
Until Abs(WindowY(1) - Abs(y)) > 100
Debug Str(x) +" "+Str(y)
ResizeWindow(1, Abs(x),Abs(y), #PB_Ignore,#PB_Ignore)
EndProcedure
Procedure TripTimer() ;system regulated - failproof interval trigger
; Goofy internal Timer_() callback workaround
tripTimer1 = #True ; allows timer event to occur ONLY once on queue.
SECOND.w = Second(Date())
; Required to prevent sluggish system after oneLook terminaltes.
EndProcedure
; &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Structure MCHITTESTINFO
cbSize.l
pt.POINT
uHIt.l
st.SYSTEMTIME
EndStructure
Procedure WinCallback(WindowID1,message,wParam,lParam)
Result = #PB_ProcessPureBasicEvents
If WindowID1 = WnHdl
Select message
Case #WM_LBUTTONDBLCLK
mcht.MCHITTESTINFO\cbSize = SizeOf(MCHITTESTINFO)
mcht\pt\x = DesktopMouseX()
mcht\pt\y = DesktopMouseY()
ScreenToClient_(GadgetID(0), @mcht\pt)
SendMessage_(GadgetID(0),#MCM_HITTEST,0,mcht)
If mcht\uHIt = #MCHT_CALENDARDATE
Debug "Date selected through double-click : " + FormatDate("%mm/%dd/%yyyy",GetGadgetState(0))
ModEntry()
HideWindow(0,1)
SetActiveGadget(2)
SaveEvents()
EndIf
EndSelect
Debug "."+lpPrevFunc
ProcedureReturn CallWindowProc_(lpPrevFunc,WindowID1,message,wParam,lParam)
EndIf
Debug "0"
ProcedureReturn Result
EndProcedure
; &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
; Locate 24hr crossover in milliseconds for title change and list update
crossover.l = TopOfToday() + 86400 ; one full day into the future
;- CREATE WINDOWS CREATE WINDOWS CREATE WINDOWS CREATE WINDOWS CREATE WINDOWS
LoadFont(1, "Segoe UI", 13)
If OpenWindow(#DateWindow,440,113,315,300,"Edit event & DblClick Date",#PB_Window_SystemMenu | #PB_Window_Invisible)
WnHdl.i = CalendarGadget(0,0,35,305,250,Date())
SetWindowTheme_(GadgetID(0), @"", @"")
SetGadgetFont(0, FontID(1))
lpPrevFunc = SetWindowLong_(GadgetID(0),#GWL_WNDPROC,@WinCallback())
SetClassLong_(GadgetID(0),#GCL_STYLE,GetClassLong_(GadgetID(0),#GCL_STYLE) | #CS_DBLCLKS)
StringGadget(1, 5, 10, 160, 20, "")
SetGadgetAttribute(1,#PB_String_MaximumLength,29)
fontVerd9B.i = LoadFont(#PB_Default,"Verdana",34,#PB_Font_Bold)
HWND1 = OpenWindow(#MainWindow, 312, 113, 570, 356, "EventReminder", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar)
If HWND1
LIG_Yval = 5
If LoadFont(1, "Arial", 16)
SetGadgetFont(#PB_Default, FontID(1))
EndIf
hLIG = ListIconGadget(2, 10, LIG_Yval, 553, 310, "", 170, #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect | #LVS_NOCOLUMNHEADER)
AddGadgetColumn ( 2 ,1 , "" ,377 )
GadgetToolTip(2, "This is my tip.")
SendMessage_(GadgetID(2), #LVM_SETCOLUMN, 0, @lvc)
If LoadFont(2, "Arial", 12)
SetGadgetFont(#PB_Default, FontID(2))
EndIf
ButtonGadget(3,10,320,155,25,"Add New Event")
ButtonGadget(4,185,320,150,25,"Discard Event")
ButtonGadget(5,350,320,195,25,"Discard All Changes")
SetForegroundWindow_(WindowID(1))
SetActiveWindow(1)
If LoadEvents()
check.l = 10000
SetWindowCallback(@WinCallback())
Repeat
s.w = (Second(Date()) % 2)
Until (s % 2) = 0
trip.l = SetTimer_(WindowID(#MainWindow),0,2000,@TripTimer())
;-TOP OF LOOP
Repeat
Repeat
EventID.l=WaitWindowEvent(check.l)
If GetForegroundWindow_() <> WindowID(0)
If IsWindowVisible_(WindowID(0))
HideWindow(#DateWindow,1)
DisableGadget(3,0)
SetGadgetState(2,-1)
EndIf
ElseIf EventID = #PB_Event_CloseWindow
EventID = 0
HideWindow(#DateWindow,1)
reList()
DisableGadget(3,0)
SetGadgetState(2,-1)
EndIf
Select EventID
Case #WM_KEYDOWN
Select EventwParam()
Case #VK_RETURN
If GetActiveGadget() = 1 ; Enter on StringGadget - save the event
ModEntry()
HideWindow(#DateWindow, 1)
SaveEvents()
EndIf
h.l = GetGadgetState(2)
If h.l > -1
If GetActiveWindow() = 1
ResizeWindow(#DateWindow, WindowX(1)+112, WindowY(1), #PB_Ignore, #PB_Ignore)
HideWindow(#DateWindow,0)
DisableGadget(3,1)
selected.i = GetGadgetState(2)
SelectElement(Ocassion(), selected)
date1 = Ocassion()\chronos
s$ = Ocassion()\Descript$
SetGadgetState(0, date1)
SetGadgetText(1,s$)
SetActiveGadget(1)
h.l = Len(GetGadgetText(1))
SendMessage_(GadgetID(1), #EM_SETSEL, h, h)
Repeat
WaitWindowEvent()
Until IsWindow(#DateWindow)
Repeat
WaitWindowEvent()
Until IsGadget(0)
While WindowEvent(): Wend
EndIf
EndIf
EndSelect
Case #PB_EventType_LostFocus
Case #PB_Event_Gadget
If GetActiveGadget() = 1
; StringGadget Enter key is caught via #WM_KEYDOWN / #VK_RETURN below
EndIf
Select EventGadget()
Case 1
While WindowEvent(): Wend
Case 2
If EventType() = #PB_EventType_LeftDoubleClick
If GetGadgetState(2) <> -1
Debug "Ok"
ResizeWindow(#DateWindow, WindowX(1)+112, WindowY(1), #PB_Ignore, #PB_Ignore)
HideWindow(#DateWindow,0)
DisableGadget(3,1)
selected.i = GetGadgetState(2)
SelectElement(Ocassion(), selected)
date1 = Ocassion()\chronos
s$ = Ocassion()\Descript$
SetGadgetState(0, date1)
SetGadgetText(1,s$)
SetActiveGadget(1)
h.l = Len(GetGadgetText(1))
SendMessage_(GadgetID(1), #EM_SETSEL, h, h)
Repeat
WaitWindowEvent()
Until IsWindow(#DateWindow)
Repeat
WaitWindowEvent()
Until IsGadget(0)
While WindowEvent(): Wend
EndIf
EndIf
Case 3 ; ADD NEW EVENT
If GetForegroundWindow_() = WindowID(1)
Debug "add event"
DisableGadget(3,1)
AddGadgetItem(2,0,"1 day until")
SetGadgetItemText(2,0,"undefined event",1)
selected.i = 0
SelectElement(Ocassion(), selected)
InsertElement(Ocassion())
TopOfToday()
date1 = ParseDate("%mm/%dd/%yyyy",FormatDate("%mm/%dd/%yyyy",now + 86400))
SetGadgetState(0, date1)
Debug now
Debug date1
Debug date1 - now
SelectElement(Ocassion(), selected)
Ocassion()\chronos = date1
Ocassion()\Descript$ = "undefined event"
date1 = Ocassion()\chronos
days = (date1 - now) /86400
event$ = Str(days) + " days until"
SetGadgetItemText(2,0,event$,0)
SetGadgetItemText(2,0,Ocassion()\Descript$,1)
ResizeWindow(#DateWindow, WindowX(1)+112, WindowY(1), #PB_Ignore, #PB_Ignore)
HideWindow(#DateWindow,0)
SetGadgetText(1,"undefined event")
SetActiveGadget(2)
SetActiveGadget(1)
h.l = Len(GetGadgetText(1))
SendMessage_(GadgetID(1), #EM_SETSEL, 0, h.l)
Repeat
WaitWindowEvent()
Until IsWindow(#DateWindow)
Repeat
WaitWindowEvent()
Until IsGadget(0)
While WindowEvent(): Wend
EndIf
Case 4 ; DISCARD SELECTED EVENT
Debug "discard event"
If GetGadgetState(2) = -1
MessageRequester(" Nothing To Do", "Please highlight an item in the list and try again. ", #MB_OK)
Else
Select MessageRequester(" Delete Event From The List", "Are you sure you want to delete the selected event? ", #MB_YESNO)
Case #IDYES
selected.i = GetGadgetState(2)
SelectElement(Ocassion(), selected)
DeleteElement(Ocassion())
RemoveGadgetItem(2, selected)
SaveEvents()
EndSelect
SetGadgetState(2,-1)
EndIf
SetActiveGadget(2)
Case 5 ; FULL REVERT
Debug "discard all changes"
Select MessageRequester(" Discard All Changes", " Discard all changes" + Chr(10) + " and revert to original list? ", #MB_YESNO)
Case #IDYES
ClearList(Ocassion())
ClearGadgetItems(2)
LoadEvents()
EndSelect
SetActiveGadget(2)
EndSelect
Default
If AnimateReminder = #True
Debug "should be Jogging"
GetLastInputInfo_(@lippi)
timenow.i = ElapsedMilliseconds()
If timenow.i - lippi\dwTime > 1500
If tripTimer1
jog + 1
tripTimer1 = #False
EndIf
If jog > 1
JogReminder()
jog = 0
EndIf
Else
HideWindow(1,0)
SetForegroundWindow_(HWND20)
SetActiveWindow(1)
ResizeWindow(1, _x/2-160, _y/2-100, #PB_Ignore,#PB_Ignore)
AnimateReminder.l = #False
check.l = 1000
EndIf
Else
Debug "Not Jogging"
If dayZero.l = #True
If GetForegroundWindow_() <> HWND20
GetLastInputInfo_(@lippi)
timenow.i = ElapsedMilliseconds()
If timenow.i - lippi\dwTime > 300000
HideWindow(1,0)
ReallySetForegroundWindow(WindowID(1))
SetActiveWindow(1)
AnimateReminder.l = #True
check.l = 50
EndIf
EndIf
EndIf
GetCursorPos_(@CursorPosition.POINT)
a1.l = WindowFromPoint_(CursorPosition\y << 32 + CursorPosition\x)
If a1 = hLIG
TopIndex = SendMessage_(GadgetID(2), #LVM_GETTOPINDEX, 0, 0)
insideY = (WindowMouseY(#MainWindow) -7)/36
hotline = TopIndex + insideY
; FIX: guard hotline against out-of-bounds before SelectElement
; catches the empty gap at the bottom of the list
If hotline < 0 Or hotline >= ListSize(Ocassion())
GadgetToolTip(2, " DoubleClick item to edit an event ")
Else
Debug "TopIndex = " + Str(TopIndex)
Debug "insideY = " + Str(insideY)
Debug "hotline = " + Str(hotline)
Debug " _ _ _ _ INSIDE THE LIST _ _ _ _"
y = ((WindowMouseY(1)) - LIG_Yval)
Debug "y = " + Str(y)
If y > 2
y - 3
itemLine = y / 14
Debug "itemLine = " + Str(itemLine)
If lastLine <> itemLine
If itemLine < CountGadgetItems(2)
SelectElement(Ocassion(), hotline)
date1 = Ocassion()\chronos
s$ = "` " + FormatDate("%mm/%dd/%yyyy",date1) + " is " + Ocassion()\Descript$ + " "
Else
s$ = " DoubleClick item to edit an event "
EndIf
Debug itemLine
GadgetToolTip(2, s$)
EndIf
lastLine = itemLine
EndIf
EndIf
EndIf
EndIf
Debug "check"
If crossover.l - Date() < check.l
check.l = 500
EndIf
If Date() >= crossover.l
Debug "Crossover to next day"
reList()
crossover.l + 86400
check.l = 10000
EndIf
EndSelect
If EventID=#PB_Event_CloseWindow
Select MessageRequester(" Event Reminder", "Reminder will Minimize or Quit." + Chr(10) + "Do you really want to Quit?", #MB_YESNOCANCEL|#MB_ICONQUESTION)
Case #IDYES
Case #IDNO
SetWindowState(1,#PB_Window_Minimize)
EventID.l=WaitWindowEvent(check.l)
Case #IDCANCEL
EventID=0
EndSelect
EndIf
Until EventID=#PB_Event_CloseWindow
;- BOTTOM OF LOOP
Until SaveEvents() = #True
EndIf
CloseWindow(1)
CloseWindow(#DateWindow)
EndIf
KillTimer_(trip,1)
EndIf
