Code:
'Waitable Timer Object Demo Program
'Author: Michael Mattias Racine WI USA June 4 2995
'Compiler: PowerBASIC Inc PB/Windows version 7.02
'Win32API.INC : May 9 2002
'Commctrl.Inc : April 8 2002
' USE AND DISTRIBUTION
' Placed in the public domain by the author 6/5/05. Author hereby waives any claim
' of copyright or patent avaialable. MCM 6/5/05.
' OPERATION
' Software can have one timer active at any one time. Doing a "Set/Reset" with an active
' timer will cancel any active timer before setting a new timer.
' 6/15/05: Bug fix. Had set current timer to 1 MILLISECOND when it should have been 1000 Milliseconds
'-------------------------------------------------------------------------------
#COMPILE EXE '#Win 8.04#
#REGISTER NONE
#DIM ALL
#INCLUDE "Win32Api.inc"
#INCLUDE "CommCtrl.inc"
$TIMER_OBJECT_NAME = "Waitable_Timer_Object"
$THREAD_READY_EVENT = "Waitable_Timer_ThreadReadyEvent"
$TIMER_CANCEL_EVENT = "Cancel_Waiting_Timer"
%PWM_TIMER_FIRED = %WM_APP + 1 'Message posted to main dialog when Timer fires
'Lparam : %NULL = wait was satisfied, %TRUE= canceled
%PWM_TIMER_THREAD_END = %WM_APP + 2 'When timer thread function is ending
'What kind of timer
%ID_PERIODIC = 101 'Option box
%ID_ONE_TIME = 102 'Option box
%ID_PERIOD = 103 'Number of seconds when ID_PERIODIC
%ID_UPDOWN = 104 'Set the number of seconds when ID_PERIODIC
%ID_TIME_CERTAIN = 105 'Date picker control: next event time when ID_ONE_TIME
%ID_RESET = 106 'Button, set or reset the timer object
%ID_CANCEL_TIMER = 107 'Button, cancel the current timer settins
%ID_CURRENT_STATUS_LIT = 108 'Displayed so you know if you have action pending
%ID_CONSOLE = 109 'Where messages go
%ID_QUIT = 110
%ID_CURRENT_TIME = 112
'Where we keep track of dialog-specific data required (to eliminate GLOBAL variables)
%SUB_USER_MODE = 1& 'Store ID_PERIODIC or ID_ONE_TIME
%SUB_PERIOD = 2& 'If periodic timer, how many seconds
%SUB_TIMER_EVENT = 3& 'Store handle to timer event
%SUB_CANCEL_EVENT = 4& 'Store handle to cancel event
'Values used to support the 'DDT' CONTROL SET OPTION syntax
%ID_OPTION_MIN = %ID_PERIODIC
%ID_OPTION_MAX = %ID_ONE_TIME
'Id of the 'current time' timer
%ID_TIMER_CURRENT = 201
'Params needed by each thread function
UNION DueTimeUnion
ft AS FILETIME 'Set when time certain
q AS QUAD 'Set when periodic
END UNION
TYPE WTThreadParmsType
hWnd AS DWORD 'Calling window; where completion message is posted
idType AS LONG 'Control ID; tells us if this is a periodic (repeating) or one time timer
Due AS DueTimeUnion 'Number of 100 nanoseconds or time certain depending on idType
hEventReady AS LONG 'To release calling thread after params are copied to local var
END TYPE
'______________________________________________________________________________
FUNCTION FormatTimerFileTime(ft AS FILETIME) AS STRING 'Used in display
LOCAL st AS SYSTEMTIME
LOCAL szOut AS ASCIIZ * 64
LOCAL szFormat AS ASCIIZ * 64
FileTimeToSystemTime(ft, st)
szFormat = "hh':'mm':'ss tt"
GetTimeFormat(%LOCALE_SYSTEM_DEFAULT, BYVAL %NULL, st, szFormat, szOut, SIZEOF(szOut))
FUNCTION = szOut
END FUNCTION
'______________________________________________________________________________
FUNCTION WaitableTimer_cancel(hWnd AS LONG, hTimerThread AS LONG) AS LONG
'Since this cancel function is only called in the context of the dialog proc,
'hWnd is a valid CBHNDL and the DIALOG functions work.
'can't use symbol 'cancelwaitabletimer' because windows uses that symbol
LOCAL hEvent AS LONG
'Signal the cancel event to release the waiting thread
DIALOG GET USER hWnd, %SUB_CANCEL_EVENT TO hEvent
PulseEvent(hEvent) 'Signal and reset
'This will result in the posting of a PWM_TIMER_THREAD_END message
END FUNCTION
'______________________________________________________________________________
#IF ((%DEF(%PB_WIN32)) AND (%PB_REVISION > &H0805))
THREAD FUNCTION WaitableTimer_ThreadFunction(BYVAL pWTP AS WtThreadParmsType POINTER) AS LONG
#ELSE
FUNCTION WaitableTimer_ThreadFunction(BYVAL pWTP AS WtThreadParmsType POINTER) AS LONG
#ENDIF
'Thread function which is run to set and monitor the waitable timer
'Param in = pointer to WTThreadParmsType
LOCAL uFileTime AS FILETIME
LOCAL WTP AS WTThreadParmsType
LOCAL szEvent AS ASCIIZ * 64
LOCAL WaitObject() AS LONG
LOCAL hEvent AS LONG
LOCAL bWaitAll AS LONG
LOCAL lPeriod AS LONG
LOCAL iWaitResult AS LONG
LOCAL iRC AS LONG
TYPE SET WTP = @pWTP 'Copy the passed params
SetEvent(WTP.hEventReady) 'Signal calling function that it may now continue
REDIM WaitObject(2) 'Set up a wait object array
DIALOG GET USER WTP.hWnd, %SUB_TIMER_EVENT TO Waitobject(0) 'The timer object will be object zero...
DIALOG GET USER WTP.HWnd, %SUB_CANCEL_EVENT TO WaitObject(1)'The cancel event will be object one...
lPeriod = %FALSE 'Period is not really used in this demo because that requires 'autoreset' timer
IF WTP.idType = %ID_ONE_TIME THEN 'Pass a UTC time when going for a time-certain:
'Change the due time from local to UTC time
LocalFileTimeToFileTime(WTP.Due.ft, uFileTime) 'Cannot have same source and destination
TYPE SET WTP.Due.ft = uFileTime
END IF
'Wait for either the timer to fire or the cancel event to be set
bWaitAll = %FALSE 'We want the wait to return EITHER if timer fires OR canceled
DO
'Because the Waitable timer we created was manual reset, the 'period' does nothing and
'we have to reset the timer each time it fires(assuming we want to re-fire, that is)
SetWaitableTimer(WaitObject(0), BYVAL VARPTR(WTP.Due), lPeriod, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
iWaitResult = WaitForMultipleObjects(BYVAL 2, _ 'Number of objects
BYVAL VARPTR(Waitobject(0)), _ 'Address of first object
bWaitAll, _ 'Set above
%INFINITE) 'Real men wait INFINITE
SELECT CASE AS LONG iWaitResult
CASE %WAIT_OBJECT_0 'Timer fired
iRC = %FALSE 'Return code for "normal timer event"
CASE %WAIT_OBJECT_0 + 1 'Cancel was fired
iRc = %TRUE 'The return code for canceled
CASE ELSE
MSGBOX "Unexpected return from WFMO", %MB_ICONHAND, "Programmer Error - Somewhere"
EXIT DO
END SELECT
PostMessage(WTP.hWnd, %PWM_TIMER_FIRED, %NULL, iRc) 'Inform main dialog of action here
'And decide if we should go loop-de-loop or not
'We should cancel the timer if we are not going to reuse it.
IF ISTRUE iRC THEN 'Timer was canceled so exit the loop, after terminating the timer
CancelWaitableTimer(WaitObject(0))
EXIT DO
ELSE 'Timer fired normally, so...
IF WTP.idType = %ID_ONE_TIME THEN 'Was a one time time-certain timer, so exit
CancelWaitableTimer(WaitObject(0))
EXIT DO
END IF 'Implied ELSE is this is a repeating timer, so we want to loop-de-loop.
END IF
LOOP
'Post the message that will reset our static vars after waiting for the thread object to be signalled
PostMessage(WTP.hWnd, %PWM_TIMER_THREAD_END, %NULL, %NULL)
END FUNCTION
'______________________________________________________________________________
FUNCTION InitLvConsole(BYVAL hWnd AS LONG) AS LONG
'Functions to initialize and add messages to the 'console'
'this code previously posted at:
'http://www.powerbasic.com/support/forums/Forum7/HTML/002062.html
'Initialize the console: call once, before adding any messages
'hwnd = handle to listview control
'Set up the column headers for the console listview
LOCAL lvc AS lvcolumn
LOCAL szText AS ASCIIZ * 128
LOCAL LvExStyle AS DWORD
LOCAL I AS LONG
'Set the extended style for the control
lvExStyle = %LVS_EX_LABELTIP OR %WS_EX_CLIENTEDGE
I = SendMessage(hWnd, %LVM_SETEXTENDEDLISTVIEWSTYLE, lvExStyle, lvExStyle)
'Add the column headers
lvc.mask = %LVCF_FMT OR %LVCF_TEXT OR %LVCF_WIDTH
lvc.pszText = VARPTR(szText)
lvc.iSubItem = 0
lvc.iImage = 0
lvc.iOrder = 0
'Column zero, date and time
szText = "Date and Time"
lvc.fmt = %LVCFMT_LEFT
lvc.cx = 125
I = SendMessage(hWnd, %LVM_INSERTCOLUMN, 0, BYVAL VARPTR(lvc))
'Column one, message text
szText = "Message"
lvc.fmt = %LVCFMT_LEFT
lvc.cx = 330
I = SendMessage(hWnd, %LVM_INSERTCOLUMN, 1, BYVAL VARPTR(lvc))
END FUNCTION
'______________________________________________________________________________
FUNCTION AddLvConsoleMessage(BYVAL hWnd AS LONG, szMessageText AS ASCIIZ, OPTIONAL BYVAL NoDateTime AS LONG) AS LONG
'Add message text to 'console' output
'HWnd = Handle to listview control
'szMessageText = Text to be printed.
'NoDate = If present and TRUE, no date is printed and the
' message text looks like a continuation of the previous line
'Add time in col 0, szText in col 1 and insure that the last(lowest)
'Visible item in listview is this text
LOCAL systime AS SYSTEMTIME
LOCAL lvi AS LVITEM
LOCAL szDf AS ASCIIZ * 32
LOCAL szTF AS ASCIIZ * 32
LOCAL szdt AS ASCIIZ * 48
LOCAL szdate AS ASCIIZ * 24
LOCAL szTime AS ASCIIZ * 24
IF ISTRUE NoDateTime THEN 'We do not want a date in column zero
szdt = $SPC
ELSE 'We do want a date in column zero
szDF = "yyyy'-'MM'-'dd"
szTF = "hh':'mm':'ss tt" ' hh:mm AMorPM
GetLocalTime(systime)
GetTimeFormat(BYVAL %NULL, BYVAL %NULL, SysTime, szTF, szTime, SIZEOF(szTime))
GetDateFormat(BYVAL %NULL, BYVAL %NULL, SysTime, szDf, szDate, SIZEOF(szDate))
szdt = szDate & $SPC & szTime
END IF
'Into which item do we put this entry?
lvi.iItem = SendMessage(hWnd,%LVM_GETITEMCOUNT, 0,0) 'Returns row # "next"
'Common param
lvi.mask = %LVIF_TEXT
'Column 0, date and time, insert the row
lvi.iSubItem = 0 'Column number
lvi.pszText = VARPTR(szDt)
SendMessage(hWnd, %LVM_INSERTITEM, 0, VARPTR(lvi))
'Column 1, the text. Update the row just inserted.
lvi.isubitem = 1
lvi.pszText = VARPTR(szMessageText)
SendMessage(hWnd, %LVM_SETITEM,0, VARPTR(lvi))
'Make sure this item is visible..
Listview_EnsureVisible(hWnd, lvi.iItem, %FALSE)
'FALSE= partially visible is *not* OK and scroll will occur if necessary to make this row fully visible
END FUNCTION
'______________________________________________________________________________
CALLBACK FUNCTION MainDlgCallbackProc()
LOCAL WTP AS WTThreadParmsType
LOCAL systime AS SYSTEMTIME
LOCAL st AS SYSTEMTIME
LOCAL stCurrent AS SYSTEMTIME
LOCAL ft AS FILETIME
LOCAL ftCurrent AS FILETIME
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL sText AS STRING
LOCAL qPeriod AS QUAD
LOCAL iCheck AS LONG
LOCAL hCtrl AS LONG
LOCAL hCtrl2 AS LONG
LOCAL icmp AS LONG
LOCAL iMin AS LONG
LOCAL iMax AS LONG
LOCAL iPeriod AS LONG
LOCAL hTimer AS LONG
LOCAL bManualReset AS LONG
LOCAL hEvent AS LONG
LOCAL bInitialState AS LONG
'A couple of STATIC vars. You could never get away with this if you wanted multiple timers or multiple
'Instances of the dialof running at one time; We can do this because we will NEVER have more than one
'Of these dialogs or more than one worker thread.
'To make this screen independent of STATIC vars would add about 250 lines of code, much of which
'Would be pretty cryptic.
STATIC iTimerActive AS LONG
STATIC hTimerThread AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
CONTROL HANDLE CBHNDL, %id_console TO hCtrl 'Set up console and show first message
InitLvConsole(hCtrl)
szText = "Waitable Timer Demo Begins"
AddlvConsoleMessage(hCtrl, szText)
'Make the number of seconds edit control the buddy of the updown contol
CONTROL HANDLE CBHNDL, %id_period TO hCtrl
CONTROL SEND CBHNDL, %id_updown, %UDM_SETBUDDY, hCtrl, %NULL
iMax = 60 'Set the range for the periodic control(in seconds)
iMin = 05
CONTROL SEND CBHNDL, %id_updown, %UDM_SETRANGE, %NULL, MAKLNG(iMax, imin)
'Set up original default selection = periodic, 15 seconds
CONTROL SET OPTION CBHNDL, %id_Periodic, %ID_OPTION_MIN, %ID_OPTION_MAX
'The text will set itself because we use style UDS_SETBUDDYINT in the updown
'And the buddy association is already made.
iMin = 15
CONTROL SEND CBHNDL, %id_updown, %UDM_SETPOS, %NULL, MAKLNG(iMin, 0)
'Disable the date time picker control associated with the ID_TIME_CERTAIN option,
'Since we are defaulting to periodic
CONTROL DISABLE CBHNDL, %id_time_certain
sText = "Waiting for First Timer Setting"
CONTROL SET TEXT CBHNDL, %ID_CURRENT_STATUS_LIT, sText
CONTROL DISABLE CBHNDL, %ID_CANCEL_TIMER 'Disable the cancel button(nothing running, so nothing to cancel)
'Create the waitable timer object we will use
szText = $TIMER_OBJECT_NAME
bManualReset = %TRUE 'We will handle all resetting ourself
hTimer = CreateWaitableTimer(BYVAL %NULL, bManualReset, szText)
IF ISTRUE hTimer THEN
DIALOG SET USER CBHNDL, %SUB_TIMER_EVENT, hTimer 'Save the(open) handle in one of our dialog's user areas
ELSE
MSGBOX "Could not create Waitable Timer Object, you sure this is Win/98 or later?"
END IF
'Create the Cancel event
szText = $TIMER_CANCEL_EVENT
bManualReset = %TRUE 'We'll handle ourself
bInitialState = %FALSE 'Unsignalled
hEvent = CreateEvent(BYVAL %NULL, bManualReset, bInitialState, szText)
'Save the event handle in our dialog
DIALOG SET USER CBHNDL, %SUB_CANCEL_EVENT, hEvent
'Set up a standard Windows timer for the current time display, once a second plenty good enough
SetTimer(CBHNDL, %ID_TIMER_CURRENT, 1, %NULL)
'When wanted it to fire every 1000 milliseconds(once per second)
SetTimer(CBHNDL, %ID_TIMER_CURRENT, 1000, %NULL)
'Here you could post a button click CBHNDL, %ID_RESET to have the demo start up
'with the default settings. Tested OK, but for a demo I don't like it.
'PostbuttonClick (CBHNDL, %ID_RESET)
CASE %WM_SYSCOMMAND
'Convert a close message into a our exit function so we do our normal cleanup
IF (CBWPARAM AND &h0FFF0) = %SC_CLOSE THEN
PostMessage(CBHNDL, %WM_COMMAND, MAKDWD(%ID_QUIT, %BN_CLICKED), GetDlgItem(CBHNDL, %ID_QUIT) )
FUNCTION = 1 'Force DDT to skip messsage
EXIT FUNCTION
END IF
CASE %WM_DESTROY
'We can never get here with any timer still active
'Destroy the waitable timer object
DIALOG GET USER CBHNDL, %SUB_TIMER_EVENT TO hEvent
CloseHandle(hEvent)
DIALOG GET USER CBHNDL, %SUB_CANCEL_EVENT TO hEvent 'Destroy the cancel event
CloseHandle(hEvent)
KillTimer(CBHNDL, %ID_TIMER_CURRENT) 'Kill the 'current time' timer
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %ID_RESET 'Set or reset the waitable timer object
IF ISTRUE iTimerActive THEN
WaitableTimer_Cancel(CBHNDL, hTimerThread)
'This will result in the posting of a PWM_END-THREAD MESSAGE
'That will reset our static vars so we will
'Post ourself another ID_RESET message
'When we go to process that one, any active timers won't exist anymore
PostMessage(CBHNDL, %WM_COMMAND, MAKDWD(%ID_RESET, %BN_CLICKED), GetDlgItem(CBHNDL, %ID_RESET) )
EXIT FUNCTION
END IF
'When we get here, the timer is not active. So we can just fire it up
'Which mode is set, periodic or time certain?
CONTROL GET CHECK CBHNDL, %ID_ONE_TIME TO iCheck
IF iCheck = 1 THEN 'This is the way ddt works, 1 means checked. You'd
'Think there would be 'factory' equates for this wouldn't you?
'In-line numeric literals. Yechh!
'Get the time currently set in the datepicker control
'Returns *local* time in st
CONTROL SEND CBHNDL, %ID_TIME_CERTAIN, %DTM_GETSYSTEMTIME, %NULL, VARPTR(st) TO iCmp
IF iCmp <> %GDT_VALID THEN
MSGBOX "Invalid Time", %MB_ICONHAND, "Error"
EXIT FUNCTION
END IF
SystemTimeToFileTime(st, ft) 'Get control time into filetime structure for editing against current time
GetLocalTime(stCurrent) 'Since control returns local, we must test against local
SystemTimeToFileTime(stCurrent, ftCurrent) 'Convert to filetime (UTC) so we can compare
iCmp = CompareFileTime(ft, ftCurrent)
IF iCmp > 0 THEN 'First time (from picker control) is later than second time, so OK to proceed
RESET WTP
WTP.idType = %ID_ONE_TIME 'Just use the control value: It's unique.
TYPE SET WTP.Due.ft = Ft 'set the destination time (which is LOCAL)
'The waitable timer requires UTC time; we convert later (in thread function)
ELSE
MSGBOX "Can't set a time certain timer to a time less than 'now'", %MB_ICONHAND, "User Misunderstanding"
EXIT FUNCTION
END IF
ELSE
'The ID_periodic button must be checked, so set the timer that way
'Get the period amount from the period control
CONTROL GET TEXT CBHNDL, %ID_PERIOD TO sText
iPeriod = VAL(sText) 'Style ES
IF iPeriod < 1 THEN
MSGBOX "Must have period of at least one second", %MB_ICONHAND, "User Misunderstanding"
EXIT FUNCTION
END IF
'Move parameters to a parameter block
RESET WTP
WTP.idType = %ID_PERIODIC 'Why not just use the clicked option? It's unique.
'Put the period into a FILETIME structure.. which is actually nothing
'More than a quad integer
'To put seconds into 100 nanosecond chunks, multiply y 10^7
'Relative times must be negative so multiply by -1, too.
WTP.Due.q = iperiod * 10000000& * -1&&
END IF
'If we get this far, our 'unique to timer type' parameters are set and we are ready to go
'After setting the common parameters:
WTP.hWnd = CBHNDL
WTP.hEventReady = CreateEvent(BYVAL %NULL, BYVAL %TRUE, BYVAL %FALSE, BYVAL %NULL)
'Start the thread function, and wait till it signals it has copied the params
THREAD CREATE WaitableTimer_ThreadFunction(BYVAL VARPTR(WTP)) TO hTimerThread
WaitForSingleObject(WTP.hEventReady, %INFINITE)
CloseHandle(WTP.hEventReady) 'Close the handle to this event so it goes away
IF hTimerThread THEN 'Set our Static indicators
iTimerActive = %TRUE
szText = "Timer Started," 'Send message to console
IF WTP.idType = %ID_PERIODIC THEN
szText = szText & " periodic every " & STR$(iPeriod) & " seconds"
ELSE
'I would like to format the time for which the timer is set
FormatTimerFileTime(WTP.due.ft) TO sText
szText = szText & " one time at " & sText
END IF
CONTROL HANDLE CBHNDL, %ID_CONSOLE TO hCtrl
AddLvConsoleMessage(hCtrl, szText)
sText = szText & ". Click <cancel> to interrupt or <Reset> to cancel and start a new timer."
CONTROL SET TEXT CBHNDL, %ID_CURRENT_STATUS_LIT, sText
CONTROL ENABLE CBHNDL, %ID_CANCEL_TIMER 'Enable the cancel function
ELSE
MSGBOX "Could not start timer thread function",%MB_ICONQUESTION, "Say What?"
END IF
'Note we keep the hTimerThread handle open because we need to wait on it when we
'Interrupt a timer with a cancel
CASE %ID_CANCEL_TIMER 'Can only occur when a timer is active
WaitableTimer_Cancel(CBHNDL, hTimerThread)
'Will reset all the necessary vars when timer thread ends
'And will disable the cancel button. (Eventually it does that)
CASE %ID_QUIT
'If a timer is active, force the user to cancel it. This is for demo puposes;
'In Real Life you'd probably just cancel the timer for them.
IF iTimerActive THEN
MSGBOX "Can't Quit, must first cancel the any current timer", %MB_ICONINFORMATION, "Problem Quitting"
ELSE
DIALOG END CBHNDL, 0
END IF
CASE %ID_ONE_TIME, %ID_PERIODIC ' user clicked an option. Enable/disable the controls based on which option is currently selected
CONTROL GET CHECK CBHNDL, %ID_ONE_TIME TO iCheck
IF iCheck = 1 THEN
'If one time is checked, enable the date-time picker...
CONTROL ENABLE CBHNDL, %ID_TIME_CERTAIN
'Disable the manual entry of period and its updown control
CONTROL DISABLE CBHNDL, %id_Period
CONTROL DISABLE CBHNDL, %id_updown
ELSE 'The periodic must be checked so flip-flop the enable/disable choices
CONTROL DISABLE CBHNDL, %ID_TIME_CERTAIN
'Enable the manual entry of period and its updown control
CONTROL ENABLE CBHNDL, %id_Period
CONTROL ENABLE CBHNDL, %id_updown
END IF
END SELECT ' of which control sent us a WM_COMMAND
CASE %WM_TIMER
sText = "Time " & TIME$ 'Update the current time on the screen
CONTROL SET TEXT CBHNDL, %ID_CURRENT_TIME, sText
CASE %PWM_TIMER_FIRED
'IIF&(CBLPARAM, , ) 'Put message on console that timer fired
WinBeep(1500, 100) 'Put message on console that timer fired
szText = IIF$(CBLPARAM = 0, "Timer Fired ", "Timer Canceled")
CONTROL HANDLE CBHNDL, %ID_CONSOLE TO hCtrl
AddLvConsoleMessage(hCtrl, szText)
'If the timer is periodic, it will stay in loop
'If timer was one time, we no longer have a thread function, but we handle that in a different message
CASE %PWM_TIMER_THREAD_END
WaitForSingleObject(hTimerThread, %INFINITE) 'Confirm the thread function has ended by waiting on it
iTimerActive = %FALSE 'Reset our static variables
THREAD CLOSE hTimerThread TO hTimerThread 'And we no longer need the thread handle
hTimerThread = %NULL
CONTROL DISABLE CBHNDL, %ID_CANCEL_TIMER 'Disable the cancel buttom since there is no longer an active timer to cancel
sText = "No Timer Active" 'Set the message area
CONTROL SET TEXT CBHNDL, %ID_CURRENT_STATUS_LIT, sText
END SELECT
END FUNCTION
'______________________________________________________________________________
FUNCTION WINMAIN(BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL lpCmdLine AS ASCIIZ POINTER, BYVAL iCmdShow AS LONG) AS LONG
LOCAL sClass AS STRING
LOCAL hIcon AS DWORD
LOCAL hDlg AS DWORD
LOCAL iStyle AS DWORD
LOCAL iExStyle AS DWORD
LOCAL iResult AS LONG
DIALOG FONT "Segoe UI", 9
DIALOG NEW %HWND_DESKTOP, "Waitable Timer Object Demonstration", , , 264, 213, _
%WS_MINIMIZEBOX OR %WS_SYSMENU OR %WS_OVERLAPPED OR %WS_VISIBLE OR %WS_CAPTION TO hDlg
hIcon = ExtractIcon(GetModuleHandle(""), "AuxiliaryDisplayCpl.dll", 03)
SetClassLong(hDlg, %GCL_HICON, hIcon)
'Group box for timer settings, does not require addressing; default styles OK
CONTROL ADD FRAME, hDlg, -1, "Timer Object Settings", 2, 2, 260, 66
CONTROL ADD OPTION, hDlg, %ID_PERIODIC, "Periodic every", 22, 18, 62, 10, _
%WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP
CONTROL ADD OPTION, hDlg, %ID_ONE_TIME, "Once at time certain", 22, 34, 82, 10, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP
CONTROL ADD TEXTBOX, hDlg, %ID_PERIOD, "", 110, 18, 32,10, _
%WS_CHILD OR %WS_VISIBLE OR %ES_NUMBER OR %ES_RIGHT OR %WS_GROUP, %WS_EX_STATICEDGE
'Updown control to set the number of seconds when ID_PERIODIC
'we'll make the buddy control association in WM_INITDIALOG
'This control will move itself inside the buddy textbox, so position here is not terribly signficant
CONTROL ADD "msctls_updown32", hDlg, %ID_UPDOWN, "", 160, 20, 12, 8, _
%UDS_ALIGNLEFT OR %UDS_SETBUDDYINT OR %WS_CHILD OR %WS_VISIBLE
'Label to complete the picture when using ID_PERIODIC
CONTROL ADD LABEL, hDlg, -1, "seconds", 147, 20, 30, 8
'Date (or in this case, TIME) picker control to set time certain when ID_ONE_TIME
CONTROL ADD "SysDateTimePick32", hDlg, %ID_TIME_CERTAIN, "", 108, 35, 64, 13, _
%WS_CHILD OR %WS_VISIBLE OR %DTS_TIMEFORMAT OR %DTS_UPDOWN OR %WS_BORDER
'Label in which we we will display the current time, default styles OK
CONTROL ADD LABEL, hDlg, %ID_CURRENT_TIME, "current time", 188, 8, 68, 8, _
%WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
'Static control in which we display current status of timer
CONTROL ADD LABEL, hDlg, %ID_CURRENT_STATUS_LIT, "Just Starting", 16, 79, 230, 18, _
%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %SS_SUNKEN
'Action buttons default styles OK
CONTROL ADD BUTTON, hDlg, %ID_RESET, "Set/Reset", 50, 50, 52, 14
CONTROL ADD BUTTON, hDlg, %ID_CANCEL_TIMER, "Cancel Timer", 145, 50, 52, 14
'Listview console for messages
CONTROL ADD "SysListView32", hDlg, %ID_CONSOLE, "", 2, 106, 260, 76, _
%WS_GROUP OR %LVS_REPORT OR %LVS_SINGLESEL OR %WS_VISIBLE OR %WS_CHILD OR _
%WS_BORDER OR %LVS_NOSORTHEADER OR %LVS_SHOWSELALWAYS
'Explicit quit, default button type
CONTROL ADD BUTTON, hDlg, %ID_QUIT, "Quit", 190, 192, 71,14
'And what's a demo without a little shameless self promotion?
CONTROL ADD LABEL, hDlg, -1, "Demo Courtesy Michael Mattias Racine WI USA" & $CRLF & _
"Updated by Pierre Bellisle 2016-03", 4, 190, 182, 19, _
%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
DIALOG SHOW MODAL hDlg, CALL MainDlgCallbackProc TO iResult
DestroyIcon(hIcon)
END FUNCTION
'______________________________________________________________________________
'
Leave a comment: