File "nimoclock.bas"
Path: /nimoclock/nimoclock.bas
File size: 28.8 KB
MIME-type: text/plain
Charset: 8 bit
#COMPILE EXE "nimoclock.exe"
#DIM ALL
$EXE = "nimo clock"
$VERSION = "3.0 (31-AUG-2018)"
%ALLOW_ONLY_ONE_INSTANCE = 1
#RESOURCE "res\nimoclock.pbr"
'--------------------------------------------------------------------------------
' ** Includes **
'--------------------------------------------------------------------------------
#INCLUDE ONCE "inc\ContextMenu.inc"
#INCLUDE ONCE "inc\tooltip.inc"
#INCLUDE ONCE "inc\nimocalc.inc"
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Constants **
'--------------------------------------------------------------------------------
%ID_TIMER1 = %WM_USER + 400
%WM_CALENDAR = %WM_USER + 2048
%IDC_DUMMY = 1000
%IDC_TIME_LABEL = 1001
%IDC_DATE_LABEL = 1002
%IDC_CAL_LABEL = 1003
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Global variables **
'--------------------------------------------------------------------------------
GLOBAL ClockDescriptor AS DialogDescriptor
GLOBAL tFont, dFont AS DWORD
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function GetCurDate returns full date string for current date
'--------------------------------------------------------------------------------
FUNCTION GetCurDate() AS STRING
LOCAL day AS LONG
LOCAL month AS LONG
LOCAL year AS LONG
day = VAL(MID$(DATE$,4,2))
month = VAL(LEFT$(DATE$,2))
year = VAL(RIGHT$(DATE$,4))
FUNCTION = ShortDateStr(year, month, day)
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function ShortDateStr returns a date in the format "Mon.3aug2011(w31)"
'--------------------------------------------------------------------------------
FUNCTION ShortDateStr(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS STRING
FUNCTION = ShortDayName(year,month,day) & FORMAT$(day, "0") & $SPC _
& ShortMonthName(month) &$SPC & FORMAT$(year, "0") _
& IIF$(LNG="FR","(s","(w") & FORMAT$(WeekNb(year,month,day), "0") & ")"
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function LongDateStr returns a date formatted "Monday 3 August 2011 (week 31)"
'--------------------------------------------------------------------------------
FUNCTION LongDateStr(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS STRING
FUNCTION = LongDayName(year,month,day) & $SPC & FORMAT$(day, "0") & $SPC _
& LongMonthName(month) &$SPC & FORMAT$(year, "0") _
& $SPC & IIF$(LNG="FR","(semaine","(week") & $SPC & FORMAT$(WeekNb(year,month,day), "0") & ")"
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function GetCurTime returns current time HH:MM (e.g. "09:26")
'--------------------------------------------------------------------------------
FUNCTION GetCurTime() AS STRING
FUNCTION = LEFT$(TIME$,5)
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function Julian - returns Julian Day Number (JDN)
' Actually it counts days elapsed since "11/25/-4713" (= Nov. 25, 4714 BCE)
'--------------------------------------------------------------------------------
FUNCTION Julian(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS LONG
LOCAL Days AS LONG, yearsBC AS LONG, yearsAD AS LONG
IF month < 3 THEN ' January or February?
month = month + 12 ' 13th or 14th month ....
DECR year ' .... of prev. year
END IF
yearsBC = 4714 - 1 ' 4713 BC thru 1 BC
yearsAD = year - 1 ' 1 AD thru (year of date minus 1)
Days = INT((yearsBC + yearsAD) * 365.25) ' calculate days in years
Days = Days - (year \ 100) ' substract century leapdays
Days = Days + (year \ 400) ' re-add valid ones
Days = Days + INT(30.6 * (month - 1) + .2) ' days in months elapsed (+ adjustment)
FUNCTION = Days + day ' days in month of date
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function JulianDayOfWeek returns day of the week (Mon=1..Sun=7)
'--------------------------------------------------------------------------------
FUNCTION JulianDayOfWeek(JDN AS LONG) AS BYTE
FUNCTION = JDN MOD 7 + 1
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function DayOfWeek same than above with different input format
'--------------------------------------------------------------------------------
FUNCTION DayOfWeek(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS BYTE
LOCAL JD AS LONG
JD = Julian(year, month, day)
FUNCTION = JulianDayOfWeek(JD)
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function WeekOne returns first day of first week for the given year
' Note: This is only a helper function for WeekNbStr
'--------------------------------------------------------------------------------
FUNCTION WeekOne(BYVAL year AS LONG) AS LONG
LOCAL temp AS LONG, Thursday AS BYTE
Thursday = 4
temp = Julian(year,1,1) - 1 ' Dec. 31 of prev. year
DO
INCR temp
LOOP UNTIL JulianDayOfWeek(temp) = Thursday ' until first Thursday of year is found
FUNCTION = temp - 3 ' first day of first week is a Monday
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Function WeekNbStr returns ISO-proof weeknumber for a date in the form "(w12)"
'--------------------------------------------------------------------------------
FUNCTION WeekNb(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS BYTE
LOCAL FirstDay AS LONG, FinalDay AS LONG, ToDay AS LONG
FirstDay = WeekOne(year)
FinalDay = WeekOne(year + 1) - 1
ToDay = Julian(year, month, day)
SELECT CASE ToDay
CASE < FirstDay
' it is week 52 or 53, but which one?
' therefore we need week one of previous year as a starting point
FirstDay = WeekOne(year - 1)
CASE > FinalDay
' there is only one possibility: week nbr 1
FUNCTION = 1
EXIT FUNCTION
END SELECT
FUNCTION = ((ToDay - FirstDay) \ 7) + 1
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Return the short name of a day in the week for a given date
'--------------------------------------------------------------------------------
FUNCTION ShortDayName(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS STRING
FUNCTION = READ$( DayOfWeek(year, month, day) + IIF(LNG="FR",0,7) )
DATA lun., mar., mer., jeu., ven., sam., dim.
DATA Mon., Tue., Wed., Thu., Fri., Sat., Sun.
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Return the short name of a given month number
'--------------------------------------------------------------------------------
FUNCTION ShortMonthName(BYVAL Month AS LONG) AS STRING
FUNCTION = READ$(Month + IIF(LNG="FR",0,12))
DATA jan., fv., mars, avr., mai, juin, juil.
DATA aot, sept., oct., nov., dc.
DATA Jan., Feb., Mar., Apr., May, Jun., Jul.
DATA Aug., Sept., Oct., Nov., Dec.
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Return the long name of a day in the week for a given date
'--------------------------------------------------------------------------------
FUNCTION LongDayName(BYVAL year AS LONG, _
BYVAL month AS LONG, _
BYVAL day AS LONG) AS STRING
FUNCTION = READ$( DayOfWeek(year, month, day) + IIF(LNG="FR",0,7) )
DATA lundi, mardi, mercredi, jeudi, vendredi, samedi, dimanche
DATA Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' Return the long name of a given month number
'--------------------------------------------------------------------------------
FUNCTION LongMonthName(BYVAL Month AS LONG) AS STRING
FUNCTION = READ$(Month + IIF(LNG="FR",0,12))
DATA janvier, fvrier, mars, avril, mai, juin, juillet
DATA aot, septembre, octobre, novembre, dcembre
DATA January, February, March, April, May, June, July
DATA August, September, October, November, December
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB SetToolTip(hDlg AS LONG)
CALL tooltip_settooltip (GetDlgItem(hDlg, %IDC_DATE_LABEL), IIF$(LNG="FR", _
"Maintenez dplacez l'heure pour bouger la fentre" + $CR + _
"Double cliquez sur l'heure pour lancer la calculatrice" + $CR + _
"Cliquez gauche sur la date pour ouvrir le calendrier" + $CR + _
"Cliquez droit (date,heure) pour ouvrir le menu d'option" _
, _
"Drag and drop the time to move the window" + $CR + _
"Double left click on time to launch calculator" + $CR + _
"Simple left click on date to open calendar" + $CR + _
"Simple right click (date,time) to open contextual menu" _
))
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB ChangeLanguage(BYVAL DiDe AS DialogDescriptor POINTER)
IF @DiDe.Handler = ClockDescriptor.Handler THEN ' Treat differently for each Dialog having a Context Menu
RefreshDialog DiDe
SetToolTip @DiDe.Handler
END IF
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB GetDimensions (BYVAL hDlg AS DWORD, BYVAL tx AS STRING, BYVAL hFont AS DWORD, _ ' input parameters
BYREF w AS LONG, BYREF h AS LONG, BYREF y0 AS LONG) ' output parameters
LOCAL th, x, y, Px AS LONG
CONTROL ADD GRAPHIC, hDlg, 999, "", -1024, -1024, 100, 100
GRAPHIC ATTACH hDlg, 999
GRAPHIC SET FONT hFont
GRAPHIC TEXT SIZE tx TO w, th ' only useful for w (text width), th (text height) is not consistant!!
CONTROL KILL hDlg, 999
CONTROL ADD GRAPHIC, hDlg, 999, "", -1024-w, -1024-th, w, th
GRAPHIC ATTACH hDlg, 999
GRAPHIC COLOR %BLACK, %WHITE
GRAPHIC CLEAR
GRAPHIC SET FONT hFont
GRAPHIC PRINT tx
' So we scan the graphic control for upper and botommer pixels
FOR y = 0 TO th-1
FOR x = 0 TO w-1
GRAPHIC GET PIXEL (x, y) TO Px
IF Px <> %WHITE THEN EXIT FOR
NEXT x
IF Px <> %WHITE THEN EXIT FOR
NEXT y
y0 = y - 1 ' Y-offset is set
FOR y = th-1 TO 0 STEP -1
FOR x = 0 TO w-1
GRAPHIC GET PIXEL (x, y) TO Px
IF Px <> %WHITE THEN EXIT FOR
NEXT x
IF Px <> %WHITE THEN EXIT FOR
NEXT y
h = y + 1 - y0 ' correct height is set
CONTROL KILL hDlg, 999
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB RefreshDialog(BYVAL DiDe AS DialogDescriptor POINTER)
LOCAL tim, dat AS STRING
LOCAL tw, th, ty0, ow, oh, oy0 AS LONG
LOCAL dX, dY AS LONG ' desktop offset
IF @DiDe.Handler = ClockDescriptor.Handler THEN ' Treat differently for each Dialog having a Context Menu
IF tFont = 0 THEN FONT NEW @DiDe.FontName, @DiDe.FontSize * 4, @DiDe.FontAttr TO tFont
IF dFont = 0 THEN FONT NEW @DiDe.FontName, @DiDe.FontSize, @DiDe.FontAttr TO dFont
' Get current time 'tim' and date 'dat'
tim = GetCurTime()
dat = GetCurDate()
' Get *EXACT* 'tim' and 'dat' graphic strings dimensions & coordinate (Y-offset)
GetDimensions @DiDe.Handler, tim, tFont, tw, th, ty0
GetDimensions @DiDe.Handler, dat, dFont, ow, oh, oy0
' Calculate dialog offset if necessary
dX = 0
dY = 0
IF ISTRUE(@DiDe.Caption) THEN
dX = 5
IF ISTRUE(@DiDe.TaskBar) THEN dY = TaskBarHeight ELSE dY = CaptionHeight
END IF
' Kill all humans, er no controls!
CONTROL KILL @DiDe.Handler, %IDC_TIME_LABEL
CONTROL KILL @DiDe.Handler, %IDC_DATE_LABEL
' Adapt dialog size to the new font!
DIALOG SET SIZE @DiDe.Handler, dX + MAX(tw, ow), dY + th + oh
DIALOG SET COLOR @DiDe.Handler, -1, @DiDe.BgndCol
' Recreate graphic controls at the good size and position
IF ow > tw THEN ' date larger than time
CONTROL ADD GRAPHIC, @DiDe.Handler, %IDC_TIME_LABEL, "", INT((ow - tw) / 2), 0, tw, th
CONTROL ADD GRAPHIC, @DiDe.Handler, %IDC_DATE_LABEL, "", 0, th, ow, oh, %SS_NOTIFY
ELSE
CONTROL ADD GRAPHIC, @DiDe.Handler, %IDC_TIME_LABEL, "", 0, 0, tw, th
CONTROL ADD GRAPHIC, @DiDe.Handler, %IDC_DATE_LABEL, "", INT((tw - ow) / 2), th, ow, oh, %SS_NOTIFY
END IF
' Refresh content of time graphic control
GRAPHIC ATTACH @DiDe.Handler, %IDC_TIME_LABEL
GRAPHIC COLOR @DiDe.FgndCol, @DiDe.BgndCol
GRAPHIC SET FONT tFont
GRAPHIC CLEAR
GRAPHIC SET POS (0, -ty0)
GRAPHIC PRINT tim
' Refresh content of date graphic control
GRAPHIC ATTACH @DiDe.Handler, %IDC_DATE_LABEL
GRAPHIC COLOR @DiDe.FgndCol, @DiDe.BgndCol
GRAPHIC SET FONT dFont
GRAPHIC CLEAR
GRAPHIC SET POS (0, -oy0)
GRAPHIC PRINT dat
SetToolTip @DiDe.Handler
DIALOG REDRAW @DiDe.Handler
END IF
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB ChangeFont(BYVAL DiDe AS DialogDescriptor POINTER)
IF @DiDe.Handler = ClockDescriptor.Handler THEN ' Treat differently for each Dialog having a Context Menu
FONT END tFont : tFont = 0
FONT END dFont : dFont = 0
END IF
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB DefaultFont(BYVAL DiDe AS DialogDescriptor POINTER)
IF @DiDe.Handler = ClockDescriptor.Handler THEN ' Treat differently for each Dialog having a Context Menu
@DiDe.FontName = "Tahoma"
@DiDe.FontSize = 12
@DiDe.FontAttr = 1 ' 1 = "Bold"
END IF
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB DefaultColors(BYVAL DiDe AS DialogDescriptor POINTER)
IF @DiDe.Handler = ClockDescriptor.Handler THEN ' Treat differently for each Dialog having a Context Menu
@DiDe.FgndCol = %BLACK
@DiDe.BgndCol = RGB(224,223,227)
END IF
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB Settings()
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB About()
LOCAL TXT AS STRING
TXT = EXE.NAME$ & " Version " & $VERSION
SELECT CASE LNG
CASE "FR"
TXT = TXT & $CRLF & "Lanc depuis " & EXE.PATH$
TXT = TXT & $CRLF
TXT = TXT & $CRLF & "Simple-clic sur la date = calendrier"
TXT = TXT & $CRLF & "Double-clic sur l'heure = calculatrice"
TXT = TXT & $CRLF & "Clic bouton droit = menu d'apparence"
TXT = TXT & $CRLF & "Ascenseur de la souris = transparence"
TXT = TXT & $CRLF
TXT = TXT & $CRLF & "Cliquez OK pour visiter le site du dveloppeur"
CASE "EN"
TXT = TXT & $CRLF & "Launched from " & EXE.PATH$
TXT = TXT & $CRLF
TXT = TXT & $CRLF & "Simple-clic on date = calendar"
TXT = TXT & $CRLF & "Double-clic on time = calculator"
TXT = TXT & $CRLF & "Right-clic = window appearance menu"
TXT = TXT & $CRLF & "Mouse-wheel = transparency"
TXT = TXT & $CRLF
TXT = TXT & $CRLF & "Clic OK to visit the developer's website"
END SELECT
MSGBOX TXT, %MB_ICONINFORMATION, IIF$(LNG="FR","A propos","About")
ShellExecute BYVAL 0&, "open", "http://mougino.free.fr" & CHR$(0), BYVAL 0&, BYVAL 0&, %SW_SHOW
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
FUNCTION PBMAIN()
ShowClockDialog %HWND_DESKTOP
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcClockDialog()
' MAIN DIALOG'S CALLBACK PROCEDURE
' A 1s timer is created under %WM_INITDIALOG
' and it will trigger a %WM_TIMER message every 1 second
' which will update the clock
LOCAL PID AS DWORD
LOCAL pt AS POINTAPI
STATIC time, date AS STRING
STATIC idEvent AS LONG
' Handle CallBack Messages linked to Context Menu
HandleContextCbMsg VARPTR(ClockDescriptor), CB.MSG, CB.CTL, CB.WPARAM, CB.LPARAM
' Start handling other CallBack Messages
SELECT CASE CB.MSG
' CallBack Message sent right before the dialog is displayed
CASE %WM_INITDIALOG
idEvent = SetTimer(CB.HNDL, %ID_TIMER1, 1000, BYVAL %NULL)
DIALOG POST CB.HNDL, %WM_TIMER, %ID_TIMER1, 0
' Change cursor to link-hand when hovering over date
CASE %WM_SETCURSOR
CONTROL SET FOCUS CB.HNDL, %IDC_DUMMY ' to be able to process mouse wheel
IF GetDlgCtrlId(CB.WPARAM) = %IDC_DATE_LABEL THEN
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
SetWindowLong CB.HNDL, %dwl_msgresult, 1
FUNCTION = 1
END IF
' CallBack Message sent when user double clicks on dialog -> launch calculator
CASE %WM_LBUTTONDBLCLK
THREAD CREATE ShowCalcDialog(BYVAL 0) TO PID ' in a thread to avoid parent-dependency,
' else every minute calc will loose focus, it will return to the updating clock dialog!
' CallBack Message sent when user drags the dialog (i.e. moves the mouse over it while pressing left button)
CASE %WM_LBUTTONDOWN
GetCursorPos pt
ScreenToClient CB.HNDL, pt
IF CB.WPARAM = %MK_LBUTTON THEN SendMessage CB.HNDL, %WM_NCLBUTTONDOWN, %HTCaption, BYVAL %Null ' force drag
' CASE %WM_MOUSEMOVE
' GetCursorPos pt
' ScreenToClient CB.HNDL, pt
' CallBack Message is a Timer event (every 1000 ms)
CASE %WM_TIMER
IF CB.WPARAM = %ID_TIMER1 THEN ' Make sure it's the correct timer id
IF GetCurTime() <> time OR GetCurDate() <> date THEN ' only refresh time when it changes
time = GetCurTime()
date = GetCurDate()
RefreshDialog VARPTR(ClockDescriptor)
END IF
END IF
' CallBack Message sent when computer wakes up from standby (sleep) or hibernate (deep sleep) mode
CASE %WM_PowerBroadcast
IF (CB.WPARAM = %PBT_APMRESUMESUSPEND OR _
CB.WPARAM = %PBT_APMRESUMESTANDBY OR _
CB.WPARAM = %PBT_APMRESUMECRITICAL) THEN RefreshDialog VARPTR(ClockDescriptor)
' CallBack Message is a Mouse or Keyboard event
CASE %WM_COMMAND
SELECT CASE CB.CTL
' User simple-clicked on date -> show calendar
CASE %IDC_DATE_LABEL
IF CB.CTLMSG = %STN_CLICKED THEN
ShowCalendarDialog CB.HNDL
END IF
END SELECT
' CallBack Message sent when the dialog is being destroyed
CASE %WM_DESTROY
' If a timer identifier exists make sure to stop the timer events
IF idEvent THEN KillTimer CB.HNDL, idEvent
END SELECT
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
%MCN_SELCHANGE = (0-750) + 1
'--------------------------------------------------------------------------------
TYPE NMSELCHANGE
hdr AS NMHDR
stSelStart AS SYSTEMTIME
stSelEnd AS SYSTEMTIME
END TYPE
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcCalendarDialog
LOCAL pNMSC AS NMSELCHANGE PTR
LOCAL DateStr AS STRING
SELECT CASE CB.MSG
CASE %WM_COMMAND
' The user selected the CLOSE button
IF CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL, 0
CASE %WM_NOTIFY
' Set up the NMSELCHANGE pointer passed in Cb.Lparam
pNMSC = CB.LPARAM
' Detect changes in the calendar control
IF @pNMSC.hdr.code = %MCN_SELCHANGE THEN ' Get selected date/time
DateStr = LongDateStr(@pNMSC.stSelStart.wYear, _
@pNMSC.stSelStart.wMonth, _
@pNMSC.stSelStart.wDay)
CONTROL SET TEXT CB.HNDL, %IDC_CAL_LABEL, DateStr
END IF
CASE %WM_SYSCOLORCHANGE, %WM_WININICHANGE
' If user changes system settings (color, etc), forward the change
' notification message to the Calendar control
CONTROL SEND CB.HNDL, %WM_CALENDAR, CB.MSG, CB.WPARAM, CB.LPARAM
END SELECT
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowClockDialog(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW PIXELS, hParent, EXE.NAME$,,, 130, 53 TO hDlg
DIALOG SET ICON hDlg, "ICO1"
ClockDescriptor.Handler = hDlg ' dialog handle
ClockDescriptor.AllowMinimize = 0 ' icon "_" in caption (title bar) / "minimize" in context menu
ClockDescriptor.AllowMaximize = 0 ' icon "[]" in caption (title bar) / "maximize" in context menu
ClockDescriptor.AllowResize = 0 ' dialog can be resized by user
ClockDescriptor.OnTop = 1 ' dialog is always on top
ClockDescriptor.InScr = 0 ' dialog can be off the screen
ClockDescriptor.Caption = 1 ' dialog has a caption (title bar) and a border
ClockDescriptor.TaskBar = 0 ' dialog appears in Task Bar
ClockDescriptor.SysTray = 0 ' dialog appears in SysTray
ClockDescriptor.Transparency = 255 ' dialog transparency from 0 (invisible) to 255 (plain dialog)
ClockDescriptor.FgndTrspt = 0 ' writings are completely transparent
ClockDescriptor.BgndTrspt = 0 ' dialog background is completely transparent
ClockDescriptor.FgndCol = %BLACK ' font color
ClockDescriptor.BgndCol = RGB(224,223,227) ' background color
ClockDescriptor.FontName = "Tahoma" ' font family
ClockDescriptor.FontSize = 12 ' font size
ClockDescriptor.FontAttr = 1 ' font attribute (0 = Normal ; 1 = Bold ...)
ClockDescriptor.SettingsEntry = 0 ' enable "$EXE settings..." entry in context menu
CreateSystray EXE.NAME$, "ICO1", _ ' SysTray label and icon
VARPTR(ClockDescriptor)
CONTROL ADD LABEL, hDlg, %IDC_DUMMY, "", 0, 0, 0, 0
CONTROL ADD GRAPHIC, hDlg, %IDC_TIME_LABEL, "", 0, 0, 0, 0
CONTROL ADD GRAPHIC, hDlg, %IDC_DATE_LABEL, "", 0, 0, 0, 0, %SS_NOTIFY
DIALOG SHOW MODAL hDlg, CALL ProcClockDialog TO lRslt
FUNCTION = lRslt
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB CenterChildDlg (BYVAL hParent AS DWORD, BYVAL hChild AS DWORD)
LOCAL xParent AS LONG, yParent AS LONG
LOCAL xChild AS LONG, yChild AS LONG
LOCAL nLeft AS LONG, nTop AS LONG
DIALOG GET CLIENT hParent TO xParent, yParent ' retrieve metrics of parent's client area
DIALOG GET SIZE hChild TO xChild, yChild ' metrics of child dialog
nLeft = (xParent - xChild) ' x position of topleft corner
nTop = (yParent - yChild) ' y position of topleft corner
DIALOG SET LOC hChild, nLeft, nTop ' put child dialog in place
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
%MCS_MULTISELECT = &H0002
%MCM_SETMAXSELCOUNT = (&H1000) + 4
'--------------------------------------------------------------------------------
FUNCTION ShowCalendarDialog(BYVAL hParent AS DWORD) AS LONG
LOCAL hDlg AS DWORD
LOCAL st AS SYSTEMTIME
LOCAL rc, rc2 AS RECT
LOCAL x, y AS LONG
LOCAL day AS LONG
LOCAL month AS LONG
LOCAL year AS LONG
LOCAL hFont0 AS DWORD
DIALOG NEW hParent, IIF$(LNG="FR","Calendrier","Calendar"), , , 400, 212, _
%WS_POPUP OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
%WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
day = VAL(MID$(DATE$,4,2))
month = VAL(LEFT$(DATE$,2))
year = VAL(RIGHT$(DATE$,4))
CONTROL ADD LABEL, hDlg, %IDC_CAL_LABEL, LongDateStr(year, month, day), 8, 8, 280, 14
CONTROL ADD BUTTON, hDlg, %IDCANCEL, IIF$(LNG="FR","&Fermer","&Close"), 340, 6, 50, 14
CONTROL ADD "SysMonthCal32", hDlg, %WM_CALENDAR, "", 0, 26, 396, 190, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %MCS_MULTISELECT, _
%WS_EX_CLIENTEDGE
FONT NEW "Tahoma", 12, 1 TO hFont0
CONTROL SET FONT hDlg, %IDC_CAL_LABEL, hFont0
' Enable selection of up to 31 days.
' See COMMCTRL.INC for other useful messages, equates and Type structures
CONTROL SEND hDlg, %WM_CALENDAR, %MCM_SETMAXSELCOUNT, 31, 0
' place calendar according to coordinates and
' width/height of parent dialog (i.e. the clock)
GetWindowRect hParent, rc
GetClientRect hParent, rc2
rc.nLeft = rc.nLeft + ((rc.nRight - rc.nLeft) - (rc2.nRight - rc2.nLeft)) - 3
rc.nTop = rc.nTop + ((rc.nBottom - rc.nTop) - (rc2.nBottom - rc2.nTop)) - 3
DIALOG UNITS hDlg, 0, 0 TO PIXELS x, y
SetWindowPos hDlg, 0, rc.nLeft + x - 410 , rc.nTop + y - 257, _
0, 0, %SWP_NOSIZE OR %SWP_NOZORDER
CenterChildDlg BYVAL hParent, BYVAL hDlg
DIALOG SHOW MODAL hDlg CALL ProcCalendarDialog
FONT END hFont0
END FUNCTION
'--------------------------------------------------------------------------------