File "WeekCal.bas"
Path: /WeekCal/WeekCal.bas
File size: 24 KB
MIME-type:
Charset: utf-8
#COMPILE EXE
#DIM ALL
$VER = "1.1"
'-------------------------------------------------------------------------------------------------
' V1.1
' [X] Highlight current week of current year
' [X] Draw horizontal lines to separate months
'
' V1.0
' [X] Position dialog at bottom right
' [X] Notify when minimized
' [X] Notify when closed
' [X] Run at startup by default
' [X] Save config in .ini:
' [X] month_alpha (0/1)
' [X] full_week (0/1)
' [X] theme (0-3)
' [X] Better input dialog to change year
' [X] Right-click menu:
' [X] Options > Start with Windows
' [X] Options > Themes > ...
' [X] About
' [X] Exit
' [X] Add a disabled title line "Week Calendar" + bar to the menu
' [X] Add a "Web" button in the About box
' [X] Add versioning
' [X] Add checkmark in front of applied theme
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
%WM_TRAYICON = %WM_USER + 501
%IDM_Theme1 = %WM_USER + 502
%IDM_Theme2 = %WM_USER + 503
%IDM_Theme3 = %WM_USER + 504
%IDM_Theme4 = %WM_USER + 505
%IDM_Startup = %WM_USER + 506
%IDM_About = %WM_USER + 507
%IDM_Exit = %WM_USER + 508
'-------------------------------------------------------------------------------------------------
GLOBAL W,H AS LONG ' Dialog width+height
GLOBAL wemo AS LONG ' Week Mode: 0=work week ; 1=full week
GLOBAL momo AS LONG ' Month Mode: 0=numeric ; 1=alphabetic
GLOBAL theme AS LONG ' Theme number (0-3)
GLOBAL dCol AS DWORD ' Default color
GLOBAL bCol AS DWORD ' Background color
GLOBAL fCol AS DWORD ' Week foreground color
GLOBAL wCol AS DWORD ' Week background color
GLOBAL lCol AS DWORD ' Line color
GLOBAL hFnt AS DWORD ' Font for calendar
GLOBAL hFntB AS DWORD ' Bigger font for year
GLOBAL cy AS LONG ' Current year
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
#INCLUDE ONCE "Win32api.inc"
#INCLUDE ONCE "ShellApi.inc"
#INCLUDE ONCE "Shortcut.inc"
#INCLUDE ONCE "Startup.inc"
#INCLUDE ONCE "Julian.inc"
'-------------------------------------------------------------------------------------------------
#RESOURCE "WeekCal.pbr"
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL hDlg AS DWORD
' Very first run: register to start with Windows
IF NOT EXIST(INIFILE) THEN MakeStartupShortcut
' Define dialog width + height
W = 354
H = 250
' Define fonts
FONT NEW "Consolas", 8, 0, 1, 0, 0 TO hFnt
FONT NEW "Consolas", 16, 1, 1, 0, 0 TO hFntB
' Create dialog
DIALOG NEW PIXELS, 0, "WeekCal", , , W, H, %WS_POPUP OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
%WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD GRAPHIC, hDlg, 100, "", 0, 0, W, H, %SS_NOTIFY
GRAPHIC ATTACH hDlg, 100, REDRAW
DIALOG SET ICON hDlg, "#5"
' Start at current year
cy = VAL(RIGHT$(DATE$,4))
DIALOG SHOW MODAL hDlg, CALL ProcDlg
FONT END hFntB
FONT END hFnt
END FUNCTION
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcDlg()
LOCAL p AS POINTAPI
LOCAL e AS STRING
STATIC ti AS NOTIFYICONDATAW
STATIC hIcon AS DWORD
STATIC hMnu1 AS DWORD
STATIC hMnu2 AS DWORD
STATIC hMnu3 AS DWORD
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
IF CB.MSG = %WM_INITDIALOG THEN
' Position dialog at bottom right corner and hide it
LOCAL x, y AS LONG
DESKTOP GET CLIENT TO x, y
DIALOG SET LOC CB.HNDL, x-W-20, y-H-30
DIALOG SHOW STATE CB.HNDL, %SW_HIDE
' Read preferences, set colors and draw calendar
ReadPrefs()
DefineColors()
FillCal cy
' Create tray icon
hIcon = LoadIcon(GetModuleHandle(BYVAL 0&), "#6")
ti.cbSize = SIZEOF(ti)
ti.hWnd = CB.HNDL
ti.uID = GetModuleHandle(BYVAL 0&)
ti.uFlags = %NIF_ICON OR %NIF_MESSAGE OR %NIF_TIP
ti.uCallbackMessage = %WM_TRAYICON
ti.hIcon = hIcon
ti.szTip = EXE.NAME$
Shell_NotifyIcon %NIM_ADD, BYVAL VARPTR(ti)
DestroyIcon ti.hIcon
' Create Popup Menus
' Options > Themes > ...
MENU NEW POPUP TO hMnu3
MENU ADD STRING, hMnu3, "Default", %IDM_Theme1, %MF_ENABLED
MENU ADD STRING, hMnu3, "Purple", %IDM_Theme2, %MF_ENABLED
MENU ADD STRING, hMnu3, "Desert", %IDM_Theme3, %MF_ENABLED
MENU ADD STRING, hMnu3, "Dark", %IDM_Theme4, %MF_ENABLED
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_CHECKED
' Options > ...
MENU NEW POPUP TO hMnu2
MENU ADD POPUP, hMnu2, "Theme", hMnu3, %MF_ENABLED
MENU ADD STRING, hMnu2, "Start with Windows", %IDM_Startup, %MF_ENABLED
MENU SET STATE hMnu2, BYCMD %IDM_Startup, ExistStartupShortcut()
' Root
MENU NEW POPUP TO hMnu1
MENU ADD STRING, hMnu1, "Week Calendar", 0, %MF_DISABLED
MENU ADD STRING, hMnu1, "-", 0, 0
MENU ADD POPUP, hMnu1, "Options", hMnu2, %MF_ENABLED
MENU ADD STRING, hMnu1, "About", %IDM_About, %MF_ENABLED
MENU ADD STRING, hMnu1, "-", 0, 0
MENU ADD STRING, hMnu1, "Exit", %IDM_Exit, %MF_ENABLED
' Very first run: show 'About' box
IF NOT EXIST(INIFILE) THEN
ShowAboutBox CB.HNDL
SetIni "Help", "author", "mougino@free.fr"
END IF
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_Theme1 THEN
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_UNCHECKED
theme = 0
DefineColors()
FillCal cy
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_CHECKED
SetIni "Config", "theme", FORMAT$(theme)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_Theme2 THEN
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_UNCHECKED
theme = 1
DefineColors()
FillCal cy
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_CHECKED
SetIni "Config", "theme", FORMAT$(theme)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_Theme3 THEN
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_UNCHECKED
theme = 2
DefineColors()
FillCal cy
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_CHECKED
SetIni "Config", "theme", FORMAT$(theme)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_Theme4 THEN
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_UNCHECKED
theme = 3
DefineColors()
FillCal cy
MENU SET STATE hMnu3, BYCMD %IDM_Theme1 + theme, %MF_CHECKED
SetIni "Config", "theme", FORMAT$(theme)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_Startup THEN
IF ISTRUE ExistStartupShortcut() THEN
DeleteStartupShortcut
ELSE
MakeStartupShortcut
END IF
MENU SET STATE hMnu2, BYCMD %IDM_Startup, ExistStartupShortcut()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_About THEN
ShowAboutBox CB.HNDL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = %IDM_Exit THEN
DIALOG END CB.HNDL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_TRAYICON THEN ' User clicked on the systray icon
LOCAL PA AS POINTAPI
LOCAL mX, mY AS LONG
mX = LOWRD(CB.LPARAM)
IF mX = %WM_LBUTTONDOWN THEN ' Left click: show week calendar
DIALOG SHOW STATE CB.HNDL, %SW_RESTORE
ELSEIF mX = %WM_RBUTTONDOWN THEN ' Right click: show option menu
GetCursorPos PA
mX = PA.X : mY = PA.Y
SetForegroundWindow CB.HNDL ' needed to close popup menu when clicking outside
TrackPopupMenu hMnu1, %TPM_BOTTOMALIGN OR %TPM_RIGHTALIGN OR _
%TPM_LEFTBUTTON, mX, mY, 0, CB.HNDL, BYVAL %NULL
PostMessage CB.HNDL, %WM_NULL, 0, 0
END IF
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_SIZE THEN ' Dialog was minimized by user
IF CBWPARAM = %SIZE_MINIMIZED THEN
DIALOG SHOW STATE CB.HNDL, %SW_HIDE ' Hide it
DIALOG SHOW STATE CB.HNDL, %SW_MINIMIZE ' Following is needed to fix a bug:
DIALOG SHOW STATE CB.HNDL, %SW_RESTORE ' if user does "About" while hidden and
DIALOG SHOW STATE CB.HNDL, %SW_HIDE ' minimized, About box will not show
END IF
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_SYSCOMMAND THEN ' User closed the dialog
IF (CBWPARAM AND &HFFF0) = %SC_CLOSE THEN
DIALOG SHOW STATE CB.HNDL, %SW_HIDE
FUNCTION = %TRUE ' Hide it and force exe NOT to terminate
END IF
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_DESTROY THEN ' Executable is closing: do some clean-up
Shell_NotifyIcon %NIM_DELETE, BYVAL VARPTR(ti)
DestroyIcon hIcon
DestroyMenu hMnu1
DestroyMenu hMnu2
DestroyMenu hMnu3
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = 100 _
AND CB.CTLMSG = %STN_CLICKED THEN ' Click on graphic
GetCursorPos(p)
ScreenToClient(GetDlgItem(CB.HNDL, 100), p)
IF p.x < 20 AND p.y < 24 THEN ' Click on "<" = prev. year
DECR cy
FillCal cy
ELSEIF p.x > 85 AND p.x < 110 _ ' Click on ">" = next year
AND p.y < 24 THEN
INCR cy
FillCal cy
ELSEIF p.x > 20 AND p.x < 85 _ ' Click on year = input dialog navigate to what year
AND p.y < 24 THEN
e = ShowInputBox(CB.HNDL, "Navigate to what year?", RIGHT$(DATE$,4))
IF VAL(e) > 999 AND VAL(e) <= 2999 THEN cy = VAL(e) : FillCal cy
ELSEIF p.x > W-50 AND p.x < W-30 _ ' Click on week mode
AND p.y > H-20 THEN
wemo = 1 - wemo
FillCal cy
SetIni "Config", "full_week", FORMAT$(wemo)
ELSEIF p.x > W-20 AND p.y > H-20 THEN ' Click on month mode
momo = 1 - momo
FillCal cy
SetIni "Config", "month_alpha", FORMAT$(momo)
END IF
END IF
END FUNCTION
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
SUB DefineColors()
IF theme = 1 THEN ' Purple theme
dCol = RGB(66,56,119)
bCol = %WHITE
fCol = RGB(87,78,145)
wCol = RGB(198,192,229)
lCol = RGB(218,218,218)
ELSEIF theme = 2 THEN ' Desert theme
dCol = %BLACK
bCol = RGB(255,255,204)
fCol = RGB(208,16,16)
wCol = RGB(255,204,153)
lCol = RGB(208,16,16)
ELSEIF theme = 3 THEN ' Dark theme
dCol = %WHITE
bCol = %BLACK
fCol = %WHITE - RGB(44,117,186)
wCol = %WHITE - RGB(229,236,244)
lCol = %WHITE - RGB(164,197,230)
ELSE ' Default (blue) theme
dCol = %BLACK
bCol = %WHITE
fCol = RGB(44,117,186)
wCol = RGB(229,236,244)
lCol = RGB(164,197,230)
END IF
END SUB
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
SUB IncrDate(BYREF y AS LONG, BYREF m AS LONG, BYREF d AS LONG, _
BYVAL i AS LONG)
LOCAL j AS LONG ' Convert to Julian date
LOCAL t AS STRING
j = Julian(y,m,d) + i ' Increment the Julian date
t = Julian2Date(j) ' Convert back to date: result is of the form "yyyymmdd" - split it:
y = VAL(LEFT$(t,4)) ' - get new year
m = VAL(MID$(t,5,2)) ' - new month
d = VAL(RIGHT$(t,2)) ' - and new day
END SUB
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
SUB FillCal(BYVAL yref AS LONG)
LOCAL y,m,d AS LONG
LOCAL a,b,c AS LONG
LOCAL dnm AS LONG
LOCAL e,cm AS STRING
' Find first day of W1 for the year
y = yref ' set current year
m = 1 : d = 1 ' start with January 1st
WHILE WeekNb(y,m,d) <> 1
INCR d
WEND
' Clear graphics + draw top horizontal line
GRAPHIC COLOR lCol, bCol
GRAPHIC CLEAR
GRAPHIC LINE (0,0) - (W,0)
' Print week mode & month mode
GRAPHIC COLOR bCol, fCol
GRAPHIC SET FONT hFntB
IF wemo = 0 THEN e = "w" ELSE e = "f"
GRAPHIC SET POS (W-46,H-22)
GRAPHIC PRINT e
IF momo = 0 THEN e = "1" ELSE e = "a"
GRAPHIC SET POS (W-16,H-22)
GRAPHIC PRINT e
' Print big year + arrows
GRAPHIC SET POS (7,1)
GRAPHIC PRINT "<";y;">"
GRAPHIC SET POS STEP (0,+2)
' Prepare table of weeks
GRAPHIC SET FONT hFnt
' Browse weeks for the whole year
c = 0 ' column
DO
' Position ourselves
GRAPHIC GET POS TO a,b
GRAPHIC SET POS (c,b)
' Print week number
e = DateStr(y,m,d, "Wwn:")
IF cy = VAL(RIGHT$(DATE$,4)) AND WToday() = VAL(MID$(e,2)) THEN
GRAPHIC COLOR bCol, fCol ' highlight current week of current year
ELSE
GRAPHIC COLOR fCol, wCol
END IF
IF LEN(e) < 4 THEN e = "W0" + MID$(e,2)
GRAPHIC PRINT e;
' Print start and end dates
GRAPHIC COLOR dCol, bCol
e = DateStr(y,m,d, " dd" + IIF$(momo=0,"/mm","M"))
REPLACE "/0" WITH "/ " IN e
IF LEFT$(e,2) = " 0" THEN e = " " + MID$(e,3,1) + " " + MID$(e,4)
GRAPHIC PRINT e;
IF cm = "" THEN cm = RIGHT$(e,3)
IF RIGHT$(e,3) <> cm THEN
cm = RIGHT$(e,3)
dnm = %TRUE ' draw line for new month
END IF
GRAPHIC COLOR fCol, bCol
GRAPHIC PRINT " >";
GRAPHIC COLOR dCol, bCol
IncrDate(y,m,d, +4+2*wemo) ' Mon>Fri /or/ Mon>Sun
e = DateStr(y,m,d, " dd" + IIF$(momo=0,"/mm","M"))
REPLACE "/0" WITH "/ " IN e
IF LEFT$(e,2) = " 0" THEN e = " " + MID$(e,3,1) + " " + MID$(e,4)
GRAPHIC PRINT e;
IF RIGHT$(e,3) <> cm THEN
cm = RIGHT$(e,3)
dnm = %TRUE ' draw line for new month
END IF
' Draw horizontal line for new month
IF dnm THEN
dnm = %FALSE
GRAPHIC GET POS TO a,b
GRAPHIC COLOR lCol, bCol
GRAPHIC LINE (c-1,b) - (c+114,b)
GRAPHIC SET POS (a,b)
END IF
' Jump to next week
GRAPHIC PRINT ""
IncrDate(y,m,d, +1+2*(1-wemo))
' Draw vertical lines
GRAPHIC GET POS TO a,b
IF b > H-10 AND WeekNb(y,m,d) <> 1 THEN
c += 120 ' column width
GRAPHIC COLOR lCol, bCol
GRAPHIC LINE (c-7,0) - (c-7,H)
GRAPHIC SET POS (c,1)
END IF
LOOP UNTIL WeekNb(y,m,d) = 1
GRAPHIC REDRAW
END SUB
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
' Tool functions for custom dialogs
'-------------------------------------------------------------------------------------------------
FUNCTION CenterWindow(BYVAL hWnd AS DWORD, OPTIONAL BYVAL hParent AS DWORD) AS LONG
LOCAL rc1, rc2 AS RECT
LOCAL x, y AS LONG
IF hParent = 0 THEN hParent = GetParent(hWnd)
GetWindowRect hParent, rc1 : GetWindowRect hWnd, rc2
x = (rc1.nLeft + rc1.nRight -rc2.nRight + rc2.nLeft) / 2
y = (rc1.nTop + rc1.nBottom - rc2.nBottom + rc2.nTop) / 2
SetWindowPos hWnd, %NULL, x, y, 0, 0, %SWP_NOSIZE
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd AS _
WORD, BYVAL byFVirt AS BYTE) AS LONG
tAccel.fVirt = byFVirt
tAccel.key = wKey
tAccel.cmd = wCmd
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION AccelOkCancel(BYVAL hDlg AS DWORD) AS DWORD
LOCAL hAccel AS DWORD
LOCAL tAccel() AS ACCELAPI
DIM tAccel(1 TO 2)
ASSIGNACCEL tAccel(1), 13, %IDOK, %FVIRTKEY OR %FNOINVERT ' Return
ASSIGNACCEL tAccel(2), 27, %IDCANCEL, %FVIRTKEY OR %FNOINVERT ' Escape
ACCEL ATTACH hDlg, tAccel() TO hAccel
FUNCTION = hAccel
END FUNCTION
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
' custom input box
'-------------------------------------------------------------------------------------------------
GLOBAL inputBoxStr AS STRING
'-------------------------------------------------------------------------------------------------
FUNCTION ShowInputBox(BYVAL hParent AS DWORD, str AS STRING, dflt AS STRING) AS STRING
LOCAL hDlg, lRslt AS DWORD
DIALOG NEW PIXELS, hParent, str, , , 280, 80, %WS_POPUP OR %WS_BORDER _
OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %WS_CAPTION, %WS_EX_WINDOWEDGE _
OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, _
TO hDlg
AccelOkCancel hDlg
CONTROL ADD TEXTBOX, hDlg, 1003, dflt, 8, 15, 260, 20
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Cancel", 126, 46, 68, 24
CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 200, 46, 68, 24
CenterWindow hDlg
DIALOG SHOW MODAL hDlg, CALL ProcInputBox TO lRslt
FUNCTION = inputBoxStr
END FUNCTION
'-------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcInputBox()
IF CB.MSG = %WM_INITDIALOG THEN inputBoxStr = ""
IF CB.MSG = %WM_COMMAND AND (CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1) THEN
IF CB.CTL = %IDOK THEN CONTROL GET TEXT CB.HNDL, 1003 TO inputBoxStr
DIALOG END CB.HNDL
END IF
END FUNCTION
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
' custom about box
'-------------------------------------------------------------------------------------------------
SUB ShowAboutBox(BYVAL hParent AS DWORD)
LOCAL hDlg AS DWORD
DIALOG NEW PIXELS, hParent, EXE.NAME$+$SPC+$VER+" - About", , , W, H, %WS_POPUP OR %WS_BORDER _
OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %WS_CAPTION, %WS_EX_WINDOWEDGE _
OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, _
TO hDlg
DIALOG SET ICON hDlg, "#5"
AccelOkCancel hDlg
CONTROL ADD LABEL, hDlg, 1001, "", 10, 10, W-20, H-40
CONTROL SET TEXT hDlg, 1001, "This is a simple week calendar widget written by mougino@free.fr in June 2022." + $CR + $CR _
+ "The widget places itself in the notification bar when it starts, or when the calendar window is closed or minimized." + $CR + $CR _
+ "To show the widget, left-click the notification icon. To exit, right click the icon > Exit. " _
+ "Several other options are also provided by right-clicking the icon." + $CR + $CR _
+ "Two options appear at the bottom right of the calendar:" + $CR _
+ "- Week mode: ""w"" means work week (Monday to Friday) ; ""F"" means full week (Monday to Sunday)" + $CR _
+ "- Month mode: ""1"" means numeric month (01-12) : ""a"" means alphabetic month (Jan-Dec)"
CONTROL ADD BUTTON, hDlg, %IDOK, "OK", W-78, H-30, 68, 24
CONTROL ADD BUTTON, hDlg, 1002, "Web", (W-68)\2, H-30, 68, 24
CenterWindow hDlg
DIALOG SHOW MODAL hDlg, CALL ProcAboutBox
END SUB
'-------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcAboutBox()
IF CB.MSG = %WM_COMMAND AND (CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1) THEN
IF CB.CTL = 1002 THEN
ShellExecute %NULL, "open", "http://mougino.free.fr", "", "", %SW_SHOW
ELSE
DIALOG END CB.HNDL
END IF
END IF
END FUNCTION
'-------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------
' ini file routines
'-------------------------------------------------------------------------------------------------
MACRO INIFILE = EXE.PATH$ + EXE.NAME$ + ".ini"
'-------------------------------------------------------------------------------------------------
SUB ReadPrefs()
LOCAL zAsc AS ASCIIZ * %MAX_PATH
LOCAL i AS LONG
GetPrivateProfileString "Config", "month_alpha", "0", zAsc, %MAX_PATH, INIFILE
momo = VAL(zAsc)
GetPrivateProfileString "Config", "full_week", "0", zAsc, %MAX_PATH, INIFILE
wemo = VAL(zAsc)
GetPrivateProfileString "Config", "theme", "0", zAsc, %MAX_PATH, INIFILE
theme = VAL(zAsc)
END SUB
'-------------------------------------------------------------------------------------------------
SUB SetIni (BYVAL sSection AS STRING, BYVAL sKey AS STRING, BYVAL sValue AS STRING)
WritePrivateProfileString (BYCOPY sSection, BYCOPY sKey, BYCOPY sValue, INIFILE)
END SUB
'-------------------------------------------------------------------------------------------------