Announcement

Collapse
1 of 2 < >

New Sub-Forum

In an effort to help make sure there are appropriate categories for topics of discussion that are happening, there is now a sub-forum for databases and database programming under Special Interest groups. Please direct questions, etc., about this topic to that sub-forum moving forward. Thank you.
2 of 2 < >

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Waitable Timer Object Demo

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Waitable Timer Object Demo

    RE-POST: Original thread lost during attempts to correct after forum software conversion

    Code:
    '-------------------------------------------------------------------------------
    '   WAITTIME.BAS
    '   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
    #DEBUG    ERROR ON
    #REGISTER NONE
    ' some variables may not be register variables, so we will make this the default.
    ' can be overidden procedure-by-procedure
    #DIM      ALL     ' DIM ALL is always in my opinion the 'Best Practice'
    #TOOLS    OFF
    
    '=====[Windows API Header Files] ============================
    '  If you don't need all of the functionality supported by these APIs
    '  (and who does?), you can selectively turn off various modules by putting
    '  the following constants in your program BEFORE you #include "win32api.inc":
    '
    '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
    '  %NOMMIDS = 1   ' no Multimedia ID definitions
    %NOMMIDS           = 1
    %NOGDI             = 1
    #INCLUDE             "WIN32API.INC"
    '==[End Windows API Header Files]====
    
    ' === [ COMMON CONTROLS]==========
    ' THESE EQUATES MUST BE COMMENTED OUT - NOT SET TO ZERO - TO ACTIVATE THE PARTICULAR CONTROL
    ' (Now *THAT* is weird!, hey?)
        %NOANIMATE       = 1  ' Animate control.
        %NOBUTTON        = 1  ' BUtton_xxx macros
        %NOCOMBO         = 1  ' combobox_xxx macros
       ' %NODATETIMEPICK  = 1
        %NODRAGLIST      = 1  ' APIs to make a listbox source and sink drag&drop actions.
        %NOEDIT          = 1  ' Edit_xxx macros
        %NOFLATSBAPIS    = 1
        %NOHEADER        = 1  ' Header bar control.
        %NOHOTKEY        = 1  ' HotKey control.
        %NOIMAGELIST     = 1  ' ImageList apis.
        %NOIPADDRESS     = 1
        %NOLIST          = 1  ' listbox_xxx macros
    '    %NOLISTVIEW      = 1  ' ListView control.
        %NOMENUHELP      = 1  ' APIs to help manage menus, especially with a status bar.
        %NOMONTHCAL      = 1
        %NOMUI           = 1
        %NONATIVEFONTCTL = 1
        %NOPAGESCROLLER  = 1
        %NOPROGRESS      = 1  ' Progress gas gauge.
        %NOREBAR         = 1
        %NOSTATUSBAR     = 1  ' Status bar control.
        %NOTABCONTROL    = 1
        %NOTOOLBAR       = 1  ' Customizable bitmap-button toolbar control.
        %NOTOOLTIPS      = 1
        %NOTRACKBAR      = 1  ' Customizable column-width tracking control.
        %NOTREEVIEW      = 1  ' TreeView control.
    '    %NOUPDOWN        = 1  ' Up and Down arrow increment/decrement control.
       #INCLUDE "COMMCTRL.INC"
    
    ' ===[ END COMMON CONTROLS]=========================
    
    '=====[GLOBAL datanames] ====================================
     ' None
    '=====[end GLOBAL datanames] ============================
    
    '==== [RESOURCES]========
    ' none (hell, it's only a demo)
    ' ===[ END RESOURCES]====
    
    
    ' Useful Things. They must be useful, because I used them.
    FUNCTION IsScClose (BYVAL wParam AS LONG ) AS LONG
        FUNCTION = (wParam AND &h0FFF0) = %SC_CLOSE
    END FUNCTION
    MACRO PostButtonClick(hWnd,ctrlid)
     PostMessage hWnd, %WM_COMMAND, MAKDWD(ctrlid,%BN_CLICKED), GetDlgItem(hWnd,Ctrlid)
    END MACRO
    ' create an unnamed Event for use in thread function params:
    MACRO   m_CreateThreadReadyEvent  =   CreateEvent (BYVAL %NULL, BYVAL %TRUE, BYVAL %FALSE, BYVAL %NULL)
    ' params:1  lpsecuritydescriptor, NULL = default security
    '        2  Manual Reset TRUE/FALSE
    '        3  initial state FALSE=unsignalled
    '        4  lpsz name, or %NULL for no name
    
    
    ' ==[ EQUATES, IDS UNIQUE TO THIS PROGRAM ]======
    $TIMER_OBJECT_NAME         = "Waitable_Timer_Object"
    $THREAD_READY_EVENT        = "Waitable_Timer_ThreadReadyEvent"
    $TIMER_CANCEL_EVENT        = "Cancel_Waiting_Timer"
    
    %PWM_TIMER_FIRED           =  %WM_USER + 1         '  message posted to main dialog when Timer fires
                                                       '  lparam : %NULL = wait was satisfied, %TRUE= canceled
    %PWM_TIMER_THREAD_END      =  %WM_USER + 2         '  when timer thread function is ending
    
    ' ===[Controls with IDs on the screen ]====
    ' 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
    ' what to do with the timer object
    %ID_RESET                    = 106      ' button, set or reset the timer object
    %ID_CANCEL_TIMER             = 107      ' Button, cancel the current timer settins
    ' messages and status
    %ID_CURRENT_STATUS_LIT       = 108      ' displayed so you know if you have action pending
    %ID_CONSOLE                  = 109      ' where messages go
    ' hasta la vista, baby
    %ID_QUIT                     = 110
    ' current time display
    %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            =  666&   ' the devil you say!
    
    ' 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 LONG         ' 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
    
    ' used in display
    FUNCTION FormatTimerFileTime (ft AS FILETIME) AS STRING
    
        LOCAL st AS SYSTEMTIME, 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
    
    ' ==========================================
    '           MAIN DIALOG PROCEDURE
    ' ==========================================
    
    CALLBACK FUNCTION MainDlgCallbackProc ()
    
     LOCAL  szText AS ASCIIZ * %MAX_PATH, iCheck AS LONG, sText AS STRING
     LOCAL  hCtrl  AS LONG, hCtrl2 AS LONG
     LOCAL  st AS SYSTEMTIME, ft AS FILETIME
     LOCAL  stCurrent AS SYSTEMTIME, ftCurrent AS FILETIME, icmp AS LONG
     LOCAL  iMin   AS LONG, iMax AS LONG, iPeriod AS LONG
     LOCAL  qPeriod AS QUAD
     LOCAL  hTimer AS LONG, bManualReset AS LONG, hEvent AS LONG, bInitialState AS LONG
     LOCAL  WTP    AS WTThreadParmsType
    
    ' 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, _
                   hTimerThread AS LONG
    
    
       ' --------------------------------
       ' NOTIFICATION PROCESSING
       ' --------------------------------
    
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                ' Set up console and show first message
                CONTROL  HANDLE  CBHNDL, %id_console TO hCtrl
                CALL        InitLvConsole (hCtrl)
                szText    = "Waitable Timer Demo Begins"
                CALL         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
                ' set the range for the periodic control (in seconds)
                iMax        = 60
                iMin        =  5
                CONTROL     SEND   CBHNDL, %id_updown, %UDM_SETRANGE, %NULL, MAKLNG (iMax, imin)
                ' NOTE: you CAN set the edit control outside this range by typing.
                ' (Because I didn't feel like editing it, that's why not).
    
                ' --------------------------------------------------------------
                ' 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
    
                ' set status text =
                sText     =  "Waiting for First Timer Setting"
                CONTROL      SET TEXT  CBHNDL, %ID_CURRENT_STATUS_LIT, sText
    
                ' disable the cancel button (nothing running, so nothing to cancel)
                CONTROL      DISABLE   CBHNDL, %ID_CANCEL_TIMER
    
                ' 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
                    ' save the (open) handle in one of our dialog's user areas
                    DIALOG SET USER CBHNDL, %SUB_TIMER_EVENT, hTimer
                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)
                ' and 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
                ' 06/15/05: Bug Fix: Original line (comment out) sets the timer to fire every millisecond..
               ' SetTimer   CBHNDL, %ID_TIMER_CURRENT, 1&, %NULL
                '.. when I 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
                ' and can put all the
                IF IsScClose (CBWPARAM) THEN
                    PostButtonClick   (CBHNDL, %ID_QUIT)
                    ' I do not want this message processed by the default handler, but
                    ' I'm not sure how to do this with DDT (not a DDT guy)
                    ' maybe this will work?  IT DOES, IT DOES!
                    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
                ' destroy the cancel event
                DIALOG GET USER   CBHNDL, %SUB_CANCEL_EVENT TO hEvent
                CloseHandle       hEvent
                ' kill the 'current time' timer
                 KillTimer  CBHNDL, %ID_TIMER_CURRENT
                ' any other cleanup can be done here, too.
    
    
            CASE %WM_COMMAND
    
                SELECT CASE AS LONG CBCTL
                    CASE %ID_RESET           ' set or reset the waitable timer object
    
                        IF ISTRUE    iTimerActive THEN
                            CALL     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
    
                            PostButtonClick    (CBHNDL, %ID_RESET)
                             ' exit, we'll get ID_RESET again
                            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
    
                            ' Get control time into filetime structure for editing against current time
                            SystemTimeToFileTime    st       , ft
                            ' since control returns local, we must test against local
                            GetLocalTime             stCurrent
                            'convert to filetime (UTC) so we can compare
                            SystemTimeToFileTime    stCurrent, ftCurrent
                            ' 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      =  m_createThreadReadyEvent
    
                        ' 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
                            ' close the handle to this event so it goes away
                        CloseHandle          WTP.hEventReady
                        ' set our Static indicators
                        IF ISTRUE hTimerThread THEN
                                 iTimerActive        = %TRUE
                                ' send message to console
                                szText              = "Timer Started,"
                                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
                                    CALL        FormatTimerFileTime (WTP.due.ft) TO  sText
                                    szText    = szText & " one time at " & sText
    
                                END IF
    
                                CONTROL HANDLE        CBHNDL, %ID_CONSOLE  TO hCtrl
                                CALL                  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
                                ' and enable the cancel function
                                CONTROL    ENABLE     CBHNDL, %ID_CANCEL_TIMER
                        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
                         CALL 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
                           '  and 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
                           '  and 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
               ' update the current time on the screen
               sText = "Now:" & TIME$
               CONTROL SET TEXT  CBHNDL, %ID_CURRENT_TIME, sText
    
           CASE %PWM_TIMER_FIRED
               ' put message on console that timer fired
               MessageBeep      IIF&(CBLPARAM, %MB_ICONHAND, %MB_OK)      ' "Beam, er, wake me up, Scotty!"
               szText         = IIF$(CBLPARAM=0, "Timer Fired ", "Timer Canceled")
               CONTROL HANDLE  CBHNDL, %ID_CONSOLE TO hCtrl
               CALL             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
    
                ' confirm the thread function has ended by waiting on it
                WaitForSingleObject  hTimerThread, %INFINITE
                ' reset our static variables
                iTimerActive     = %FALSE
                ' and we no longer need the thread handle
                THREAD CLOSE  hTimerThread   TO hTimerThread
                hTimerThread               = %NULL
                ' disable the cancel buttom since there is no longer an active timer to cancel
                CONTROL DISABLE      CBHNDL, %ID_CANCEL_TIMER
                ' and set the message area
                sText           = "No Timer Active"
                CONTROL SET TEXT  CBHNDL, %ID_CURRENT_STATUS_LIT, sText
    
        END SELECT
    
    
    
    END FUNCTION
    
    ' 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
    FUNCTION WaitableTimer_cancel (hWnd AS LONG, hTimerThread AS LONG) AS LONG
    
        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.. eventually
    
    END FUNCTION
    
    ' ============================================='
    ' THREAD FUNCTION WHICH IS RUN TO SET
    ' AND MONITOR THE WAITABLE TIMER
    ' ============================================='
    
    'Param in = pointer to WTThreadParmsType
    FUNCTION  WaitableTimer_ThreadFunction (BYVAL pWTP AS WtThreadParmsType PTR) AS LONG
    
        LOCAL  WTP  AS WTThreadParmsType
        LOCAL  WaitObject() AS LONG
        LOCAL  hEvent AS LONG, szEvent AS ASCIIZ * 64
        LOCAL  bWaitAll AS LONG, lPeriod  AS LONG, iWaitResult AS LONG
        LOCAL  iRC AS LONG
        LOCAL  uFileTime AS FILETIME
    
        ' copy the passed params
        TYPE  SET  WTP  = @pWTP
        ' signal calling function that it may now continue
        SetEvent         WTP.hEventReady
    
        ' set up a wait object array
        REDIM            WaitObject(2)
    
        ' the timer object will be object zero...
        DIALOG GET USER  WTP.hWnd, %SUB_TIMER_EVENT TO Waitobject (0)
        ' and the cancel event will be object one...
        DIALOG GET USER  WTP.HWnd, %SUB_CANCEL_EVENT TO WaitObject (1)
        '.. and period is not really used in this demo because that requires 'autoreset' timer
        ' and the author is a control freak so created the timer as 'manual reset.'
        lPeriod     = %FALSE
    
        ' we did all our work in the dialog in local time, but we must pass a UTC time when going for
        ' a time-certain:
        IF WTP.idType = %ID_ONE_TIME THEN
            ' 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
    
        ' now 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      ' of how we exited the waitformultipleobjects
          ' inform main dialog of action here....
          PostMessage    WTP.hWnd, %PWM_TIMER_FIRED, %NULL, iRc
          ' 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
        ' and 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
    
    '------------------------------------------------------------------------------
    '                     PROGRAM ENTRY POINT
    '------------------------------------------------------------------------------
    
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      BYVAL lpCmdLine     AS ASCIIZ PTR, _
                      BYVAL iCmdShow      AS LONG) AS LONG
    
    
        LOCAL   hDlg       AS LONG, iResult AS LONG
        LOCAL   iStyle     AS LONG, iExStyle  AS LONG
        LOCAL   iccex      AS Init_Common_ControlsEx
        LOCAL   sClass     AS STRING
    
        ' check that we are at least on Windows/98? Or will Win95 fail immediately on missing import? Don't know
        ' and cannot test because I use Win/98. I'll leave the user 'something' to do here...
    
        ' initialize the common controls library
         iccex.dwSize          = SIZEOF(iccex)
         iccex.dwICC           = %ICC_LISTVIEW_CLASSES OR %ICC_DATE_CLASSES OR %ICC_UPDOWN_CLASS
         InitCommonControlsEx    iccex
    
        ' =================================
        ' Create our User Interface Dialog
        ' =================================
    
        ' I would like a bigger font, that 8-pointer is too hard for me to read
    
        DIALOG      FONT  "System", 10
    
        iStyle    = %WS_MINIMIZEBOX OR %WS_SYSMENU OR %WS_OVERLAPPED OR %WS_VISIBLE OR %WS_CAPTION
        iExStyle =  %NULL
    
        DIALOG NEW 0, "Waitable Timer Object Demonstration", 44,41, 264, 225, _
                   iStyle, iExStyle TO hDlg
    
        ' Abort if the dialog could not be created
        IF hDlg = 0 THEN EXIT FUNCTION  ' Error occurred
    
       ' Now create our controls.
    
       ' group box for timer settings, does not require addressing;  default styles OK
        CONTROL ADD  FRAME, hDlg, -1&, "Timer Object Settings", 2,2, 260,66
    
        ' add the two option buttons, which we MUST do in order so we don't screw up the WS_GROUP settings
        iStyle        =  %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP   ' include group on *first* button
        iExStyle     =  %NULL
        CONTROL   ADD OPTION, hDlg, %ID_PERIODIC, "Periodic every", 22,18,62,10, iStyle
        iStyle        =  iStyle  AND (NOT %WS_GROUP)    ' turn off WS_GROUP for additional buttons in group
        CONTROL   ADD OPTION, hDlg, %ID_ONE_TIME, "Once at time certain", 22,34,82,10,iStyle
        ' text box in which we can enter the number of seconds when ID_PERIODIC
        ' will be the buddy control for the updown
        iStyle       =  %WS_CHILD OR %WS_VISIBLE OR %ES_NUMBER OR %ES_RIGHT OR %WS_GROUP
        CONTROL   ADD TEXTBOX, hDlg, %ID_PERIOD, "", 110, 18, 32,12, iStyle
    
        ' 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
        sclass       =  $UPDOWN_CLASS
        iStyle       =  %UDS_ALIGNLEFT  OR %UDS_SETBUDDYINT OR %WS_CHILD OR %WS_VISIBLE
        CONTROL   ADD sClass, hDlg, %ID_UPDOWN, "", 160, 20,12,8, iStyle
        ' Label to complete the picture when using ID_PERIODIC
        CONTROL   ADD LABEL,    hDlg, -1&, "Seconds", 150, 20,30,8
    
        ' date (or in this case, TIME) picker control to set time certain when ID_ONE_TIME
        sClass       =  $DATETIMEPICK_CLASS
        iStyle       =  %WS_CHILD OR %WS_VISIBLE OR %DTS_TIMEFORMAT OR %DTS_UPDOWN OR %WS_BORDER
        CONTROL   ADD  sClass, hDlg, %ID_TIME_CERTAIN, "", 108,35 , 64, 16, iStyle
    
        ' Label in which we we will display the current time, default styles OK
        iStyle      =   %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
        CONTROL   ADD LABEL, hDlg, %ID_CURRENT_TIME, "current time", 188, 8 , 68, 8, iStyle
    
        ' Static control in which we display current status of timer
        iStyle       = %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %SS_SUNKEN
        CONTROL   ADD LABEL, hDlg, %ID_CURRENT_STATUS_LIT, "Just Starting", 16, 79, 230, 18, iStyle
    
        ' action buttons default styles OK
        CONTROL   ADD BUTTON, hDlg, %ID_RESET, "Set/Reset"          ,  50, 52, 52, 14
        CONTROL   ADD BUTTON, hDlg, %ID_CANCEL_TIMER, "Cancel Timer", 145, 52, 52, 14
    
       ' Listview console for messages
       sClass    = $WC_LISTVIEW
       iStyle    =   %WS_GROUP  OR %LVS_REPORT       OR %LVS_SINGLESEL     OR %WS_VISIBLE OR %WS_CHILD _
                  OR %WS_BORDER OR %LVS_NOSORTHEADER OR %LVS_SHOWSELALWAYS
       CONTROL    ADD sCLass, hDlg, %ID_CONSOLE, "", 2,106, 260, 76, iStyle
    
       ' explicit quit, default button type
       CONTROL   ADD BUTTON, hDlg, %ID_QUIT, "Hasta la vista, Baby", 190, 192, 71,14
    
       ' and what's a demo without a little shameless self promotion?
       iStyle    = %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
       CONTROL   ADD LABEL, hDlg, -1&, "Demo Courtesy Michael Mattias Racine WI USA", 4, 211, 252,8, iStyle
    
      ' show the dialog..
    
    
        DIALOG SHOW MODAL hDlg, CALL MainDlgCallbackProc TO iResult
    
    
    END FUNCTION
    
    ' ===========================================================
    ' 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
    ' --------------------------------------------------------------
    FUNCTION InitLvConsole (BYVAL hWnd AS LONG) AS LONG
     ' set up the column headers for the console listview
       LOCAL  lvc AS lvcolumn, 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  = 430
       I       = SendMessage (hWnd, %LVM_INSERTCOLUMN, 1, BYVAL VARPTR(lvc))
    
    END FUNCTION
    
    ' ------------------------------------------------------------------
    '              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
    ' ------------------------------------------------------------------
    
    FUNCTION AddLvConsoleMessage (BYVAL hWnd AS LONG, szMessageText AS ASCIIZ, OPTIONAL BYVAL NoDateTime AS LONG) AS LONG
        ' add time in col 0, szText in col 1 and insure that the last (lowest)
        ' visible item in listview is this text
       LOCAL    lvi AS Lvitem
       LOCAL    szDf AS ASCIIZ * 32, szTF AS ASCIIZ * 32, systime AS SYSTEMTIME
       LOCAL    szdt AS ASCIIZ * 48, szdate AS ASCIIZ * 24, szTime AS ASCIIZ * 24
    
       IF ISTRUE NoDateTime THEN    ' we do not want a date in column zero
           szdt = SPACE$(01)
       ELSE                         ' duh, we DO want a date in column zero
           szDF              = "M'/'dd'/'yy"
           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 & CHR$(&h20) & 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
    
    ' // END OF FILE WAITTIME.BAS
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    Your Application

    Matthias,

    The Application doesn't compile it with the includes of José Roca or PowerBasic?
    Can you test it with your PBWin10 compiler?

    Thanks
    Stephane

    Comment


    • #3
      Stephane

      The following comments at the top of the source code are a bit of a give away:-

      ' 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.

      Note the date and the version numbers!!!!

      Iain Johnstone
      “None but those who have experienced them can conceive of the enticements of science” - Mary Shelley

      Comment


      • #4
        PB10 version, hope this can run.

        José Roca header.

        Code:
        '-------------------------------------------------------------------------------
        '   WAITTIME.BAS
        '   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
        #DEBUG    ERROR ON
        #REGISTER NONE
        ' some variables may not be register variables, so we will make this the default.
        ' can be overidden procedure-by-procedure
        #DIM      ALL     ' DIM ALL is always in my opinion the 'Best Practice'
        #TOOLS    OFF
        
        '=====[Windows API Header Files] ============================
        '  If you don't need all of the functionality supported by these APIs
        '  (and who does?), you can selectively turn off various modules by putting
        '  the following constants in your program BEFORE you #include "win32api.inc":
        '
        '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
        '  %NOMMIDS = 1   ' no Multimedia ID definitions
        %NOMMIDS           = 1
        %NOGDI             = 1
        #INCLUDE             "WIN32API.INC"
        
        $UPDOWN_CLASS  =  "msctls_updown32"
        $DATETIMEPICK_CLASS = "SysDateTimePick32"
        $WC_LISTVIEW = "SysListView32"
        
        '==[End Windows API Header Files]====
        
        ' === [ COMMON CONTROLS]==========
        ' THESE EQUATES MUST BE COMMENTED OUT - NOT SET TO ZERO - TO ACTIVATE THE PARTICULAR CONTROL
        ' (Now *THAT* is weird!, hey?)
            %NOANIMATE       = 1  ' Animate control.
            %NOBUTTON        = 1  ' BUtton_xxx macros
            %NOCOMBO         = 1  ' combobox_xxx macros
           ' %NODATETIMEPICK  = 1
            %NODRAGLIST      = 1  ' APIs to make a listbox source and sink drag&drop actions.
            %NOEDIT          = 1  ' Edit_xxx macros
            %NOFLATSBAPIS    = 1
            %NOHEADER        = 1  ' Header bar control.
            %NOHOTKEY        = 1  ' HotKey control.
            %NOIMAGELIST     = 1  ' ImageList apis.
            %NOIPADDRESS     = 1
            %NOLIST          = 1  ' listbox_xxx macros
        '    %NOLISTVIEW      = 1  ' ListView control.
            %NOMENUHELP      = 1  ' APIs to help manage menus, especially with a status bar.
            %NOMONTHCAL      = 1
            %NOMUI           = 1
            %NONATIVEFONTCTL = 1
            %NOPAGESCROLLER  = 1
            %NOPROGRESS      = 1  ' Progress gas gauge.
            %NOREBAR         = 1
            %NOSTATUSBAR     = 1  ' Status bar control.
            %NOTABCONTROL    = 1
            %NOTOOLBAR       = 1  ' Customizable bitmap-button toolbar control.
            %NOTOOLTIPS      = 1
            %NOTRACKBAR      = 1  ' Customizable column-width tracking control.
            %NOTREEVIEW      = 1  ' TreeView control.
        '    %NOUPDOWN        = 1  ' Up and Down arrow increment/decrement control.
           #INCLUDE "COMMCTRL.INC"
        
        ' ===[ END COMMON CONTROLS]=========================
        
        '=====[GLOBAL datanames] ====================================
         ' None
        '=====[end GLOBAL datanames] ============================
        
        '==== [RESOURCES]========
        ' none (hell, it's only a demo)
        ' ===[ END RESOURCES]====
        
        
        ' Useful Things. They must be useful, because I used them.
        FUNCTION IsScClose (BYVAL wParam AS LONG ) AS LONG
            FUNCTION = (wParam AND &h0FFF0) = %SC_CLOSE
        END FUNCTION
        MACRO PostButtonClick(hWnd,ctrlid)
         PostMessage hWnd, %WM_COMMAND, MAKDWD(ctrlid,%BN_CLICKED), GetDlgItem(hWnd,Ctrlid)
        END MACRO
        ' create an unnamed Event for use in thread function params:
        MACRO   m_CreateThreadReadyEvent  =   CreateEvent (BYVAL %NULL, BYVAL %TRUE, BYVAL %FALSE, BYVAL %NULL)
        ' params:1  lpsecuritydescriptor, NULL = default security
        '        2  Manual Reset TRUE/FALSE
        '        3  initial state FALSE=unsignalled
        '        4  lpsz name, or %NULL for no name
        
        
        ' ==[ EQUATES, IDS UNIQUE TO THIS PROGRAM ]======
        $TIMER_OBJECT_NAME         = "Waitable_Timer_Object"
        $THREAD_READY_EVENT        = "Waitable_Timer_ThreadReadyEvent"
        $TIMER_CANCEL_EVENT        = "Cancel_Waiting_Timer"
        
        %PWM_TIMER_FIRED           =  %WM_USER + 1         '  message posted to main dialog when Timer fires
                                                           '  lparam : %NULL = wait was satisfied, %TRUE= canceled
        %PWM_TIMER_THREAD_END      =  %WM_USER + 2         '  when timer thread function is ending
        
        ' ===[Controls with IDs on the screen ]====
        ' 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
        ' what to do with the timer object
        %ID_RESET                    = 106      ' button, set or reset the timer object
        %ID_CANCEL_TIMER             = 107      ' Button, cancel the current timer settins
        ' messages and status
        %ID_CURRENT_STATUS_LIT       = 108      ' displayed so you know if you have action pending
        %ID_CONSOLE                  = 109      ' where messages go
        ' hasta la vista, baby
        %ID_QUIT                     = 110
        ' current time display
        %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            =  666&   ' the devil you say!
        
        ' 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 LONG         ' 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
        
        ' used in display
        FUNCTION FormatTimerFileTime (ft AS FILETIME) AS STRING
        
            LOCAL st AS SYSTEMTIME, 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
        
        ' ==========================================
        '           MAIN DIALOG PROCEDURE
        ' ==========================================
        
        CALLBACK FUNCTION MainDlgCallbackProc ()
        
         LOCAL  szText AS ASCIIZ * %MAX_PATH, iCheck AS LONG, sText AS STRING
         LOCAL  hCtrl  AS LONG, hCtrl2 AS LONG
         LOCAL  st AS SYSTEMTIME, ft AS FILETIME
         LOCAL  stCurrent AS SYSTEMTIME, ftCurrent AS FILETIME, icmp AS LONG
         LOCAL  iMin   AS LONG, iMax AS LONG, iPeriod AS LONG
         LOCAL  qPeriod AS QUAD
         LOCAL  hTimer AS LONG, bManualReset AS LONG, hEvent AS LONG, bInitialState AS LONG
         LOCAL  WTP    AS WTThreadParmsType
        
        ' 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, _
                       hTimerThread AS LONG
        
        
           ' --------------------------------
           ' NOTIFICATION PROCESSING
           ' --------------------------------
        
            SELECT CASE AS LONG CBMSG
                CASE %WM_INITDIALOG
                    ' Set up console and show first message
                    CONTROL  HANDLE  CBHNDL, %id_console TO hCtrl
                    CALL        InitLvConsole (hCtrl)
                    szText    = "Waitable Timer Demo Begins"
                    CALL         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, 
        M_SETBUDDY, hCtrl, %NULL
                    ' set the range for the periodic control (in seconds)
                    iMax        = 60
                    iMin        =  5
                    CONTROL     SEND   CBHNDL, %id_updown, 
        M_SETRANGE, %NULL, MAKLNG (iMax, imin)
                    ' NOTE: you CAN set the edit control outside this range by typing.
                    ' (Because I didn't feel like editing it, that's why not).
        
                    ' --------------------------------------------------------------
                    ' 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, 
        M_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
        
                    ' set status text =
                    sText     =  "Waiting for First Timer Setting"
                    CONTROL      SET TEXT  CBHNDL, %ID_CURRENT_STATUS_LIT, sText
        
                    ' disable the cancel button (nothing running, so nothing to cancel)
                    CONTROL      DISABLE   CBHNDL, %ID_CANCEL_TIMER
        
                    ' 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
                        ' save the (open) handle in one of our dialog's user areas
                        DIALOG SET USER CBHNDL, %SUB_TIMER_EVENT, hTimer
                    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)
                    ' and 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
                    ' 06/15/05: Bug Fix: Original line (comment out) sets the timer to fire every millisecond..
                   ' SetTimer   CBHNDL, %ID_TIMER_CURRENT, 1&, %NULL
                    '.. when I 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
                    ' and can put all the
                    IF IsScClose (CBWPARAM) THEN
                        PostButtonClick   (CBHNDL, %ID_QUIT)
                        ' I do not want this message processed by the default handler, but
                        ' I'm not sure how to do this with DDT (not a DDT guy)
                        ' maybe this will work?  IT DOES, IT DOES!
                        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
                    ' destroy the cancel event
                    DIALOG GET USER   CBHNDL, %SUB_CANCEL_EVENT TO hEvent
                    CloseHandle       hEvent
                    ' kill the 'current time' timer
                     KillTimer  CBHNDL, %ID_TIMER_CURRENT
                    ' any other cleanup can be done here, too.
        
        
                CASE %WM_COMMAND
        
                    SELECT CASE AS LONG CBCTL
                        CASE %ID_RESET           ' set or reset the waitable timer object
        
                            IF ISTRUE    iTimerActive THEN
                                CALL     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
        
                                PostButtonClick    (CBHNDL, %ID_RESET)
                                 ' exit, we'll get ID_RESET again
                                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
        
                                ' Get control time into filetime structure for editing against current time
                                SystemTimeToFileTime    st       , ft
                                ' since control returns local, we must test against local
                                GetLocalTime             stCurrent
                                'convert to filetime (UTC) so we can compare
                                SystemTimeToFileTime    stCurrent, ftCurrent
                                ' 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      =  m_createThreadReadyEvent
        
                            ' 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
                                ' close the handle to this event so it goes away
                            CloseHandle          WTP.hEventReady
                            ' set our Static indicators
                            IF ISTRUE hTimerThread THEN
                                     iTimerActive        = %TRUE
                                    ' send message to console
                                    szText              = "Timer Started,"
                                    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
                                        CALL        FormatTimerFileTime (WTP.due.ft) TO  sText
                                        szText    = szText & " one time at " & sText
        
                                    END IF
        
                                    CONTROL HANDLE        CBHNDL, %ID_CONSOLE  TO hCtrl
                                    CALL                  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
                                    ' and enable the cancel function
                                    CONTROL    ENABLE     CBHNDL, %ID_CANCEL_TIMER
                            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
                             CALL 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
                               '  and 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
                               '  and 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
                   ' update the current time on the screen
                   sText = "Now:" & TIME$
                   CONTROL SET TEXT  CBHNDL, %ID_CURRENT_TIME, sText
        
               CASE %PWM_TIMER_FIRED
                   ' put message on console that timer fired
                   MessageBeep      IIF&(CBLPARAM, %MB_ICONHAND, %MB_OK)      ' "Beam, er, wake me up, Scotty!"
                   szText         = IIF$(CBLPARAM=0, "Timer Fired ", "Timer Canceled")
                   CONTROL HANDLE  CBHNDL, %ID_CONSOLE TO hCtrl
                   CALL             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
        
                    ' confirm the thread function has ended by waiting on it
                    WaitForSingleObject  hTimerThread, %INFINITE
                    ' reset our static variables
                    iTimerActive     = %FALSE
                    ' and we no longer need the thread handle
                    THREAD CLOSE  hTimerThread   TO hTimerThread
                    hTimerThread               = %NULL
                    ' disable the cancel buttom since there is no longer an active timer to cancel
                    CONTROL DISABLE      CBHNDL, %ID_CANCEL_TIMER
                    ' and set the message area
                    sText           = "No Timer Active"
                    CONTROL SET TEXT  CBHNDL, %ID_CURRENT_STATUS_LIT, sText
        
            END SELECT
        
        
        
        END FUNCTION
        
        ' 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
        FUNCTION WaitableTimer_cancel (hWnd AS LONG, hTimerThread AS LONG) AS LONG
        
            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.. eventually
        
        END FUNCTION
        
        ' ============================================='
        ' THREAD FUNCTION WHICH IS RUN TO SET
        ' AND MONITOR THE WAITABLE TIMER
        ' ============================================='
        
        'Param in = pointer to WTThreadParmsType
        THREAD FUNCTION  WaitableTimer_ThreadFunction (BYVAL pWTP AS WtThreadParmsType PTR) AS LONG
        
            LOCAL  WTP  AS WTThreadParmsType
            LOCAL  WaitObject() AS LONG
            LOCAL  hEvent AS LONG, szEvent AS ASCIIZ * 64
            LOCAL  bWaitAll AS LONG, lPeriod  AS LONG, iWaitResult AS LONG
            LOCAL  iRC AS LONG
            LOCAL  uFileTime AS FILETIME
        
            ' copy the passed params
            TYPE  SET  WTP  = @pWTP
            ' signal calling function that it may now continue
            SetEvent         WTP.hEventReady
        
            ' set up a wait object array
            REDIM            WaitObject(2)
        
            ' the timer object will be object zero...
            DIALOG GET USER  WTP.hWnd, %SUB_TIMER_EVENT TO Waitobject (0)
            ' and the cancel event will be object one...
            DIALOG GET USER  WTP.HWnd, %SUB_CANCEL_EVENT TO WaitObject (1)
            '.. and period is not really used in this demo because that requires 'autoreset' timer
            ' and the author is a control freak so created the timer as 'manual reset.'
            lPeriod     = %FALSE
        
            ' we did all our work in the dialog in local time, but we must pass a UTC time when going for
            ' a time-certain:
            IF WTP.idType = %ID_ONE_TIME THEN
                ' 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
        
            ' now 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      ' of how we exited the waitformultipleobjects
              ' inform main dialog of action here....
              PostMessage    WTP.hWnd, %PWM_TIMER_FIRED, %NULL, iRc
              ' 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
            ' and 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
        
        '------------------------------------------------------------------------------
        '                     PROGRAM ENTRY POINT
        '------------------------------------------------------------------------------
        
        FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                          BYVAL hPrevInstance AS LONG, _
                          BYVAL lpCmdLine     AS ASCIIZ PTR, _
                          BYVAL iCmdShow      AS LONG) AS LONG
        
        
            LOCAL   hDlg       AS LONG, iResult AS LONG
            LOCAL   iStyle     AS LONG, iExStyle  AS LONG
            LOCAL   iccex      AS Init_Common_ControlsEx
            LOCAL   sClass     AS STRING
        
            ' check that we are at least on Windows/98? Or will Win95 fail immediately on missing import? Don't know
            ' and cannot test because I use Win/98. I'll leave the user 'something' to do here...
        
            ' initialize the common controls library
             iccex.dwSize          = SIZEOF(iccex)
             iccex.dwICC           = %ICC_LISTVIEW_CLASSES OR %ICC_DATE_CLASSES OR %ICC_UPDOWN_CLASS
             InitCommonControlsEx    iccex
        
            ' =================================
            ' Create our User Interface Dialog
            ' =================================
        
            ' I would like a bigger font, that 8-pointer is too hard for me to read
        
            DIALOG      FONT  "System", 10
        
            iStyle    = %WS_MINIMIZEBOX OR %WS_SYSMENU OR %WS_OVERLAPPED OR %WS_VISIBLE OR %WS_CAPTION
            iExStyle =  %NULL
        
            DIALOG NEW 0, "Waitable Timer Object Demonstration", 44,41, 264, 225, _
                       iStyle, iExStyle TO hDlg
        
            ' Abort if the dialog could not be created
            IF hDlg = 0 THEN EXIT FUNCTION  ' Error occurred
        
           ' Now create our controls.
        
           ' group box for timer settings, does not require addressing;  default styles OK
            CONTROL ADD  FRAME, hDlg, -1&, "Timer Object Settings", 2,2, 260,66
        
            ' add the two option buttons, which we MUST do in order so we don't screw up the WS_GROUP settings
            iStyle        =  %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP   ' include group on *first* button
            iExStyle     =  %NULL
            CONTROL   ADD OPTION, hDlg, %ID_PERIODIC, "Periodic every", 22,18,62,10, iStyle
            iStyle        =  iStyle  AND (NOT %WS_GROUP)    ' turn off WS_GROUP for additional buttons in group
            CONTROL   ADD OPTION, hDlg, %ID_ONE_TIME, "Once at time certain", 22,34,82,10,iStyle
            ' text box in which we can enter the number of seconds when ID_PERIODIC
            ' will be the buddy control for the updown
            iStyle       =  %WS_CHILD OR %WS_VISIBLE OR %ES_NUMBER OR %ES_RIGHT OR %WS_GROUP
            CONTROL   ADD TEXTBOX, hDlg, %ID_PERIOD, "", 110, 18, 32,12, iStyle
        
            ' 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
            sclass       =  $UPDOWN_CLASS
            iStyle       =  
        S_ALIGNLEFT  OR 
        S_SETBUDDYINT OR %WS_CHILD OR %WS_VISIBLE
            CONTROL   ADD sClass, hDlg, %ID_UPDOWN, "", 160, 20,12,8, iStyle
            ' Label to complete the picture when using ID_PERIODIC
            CONTROL   ADD LABEL,    hDlg, -1&, "Seconds", 150, 20,30,8
        
            ' date (or in this case, TIME) picker control to set time certain when ID_ONE_TIME
            sClass       =  $DATETIMEPICK_CLASS
            iStyle       =  %WS_CHILD OR %WS_VISIBLE OR %DTS_TIMEFORMAT OR %DTS_UPDOWN OR %WS_BORDER
            CONTROL   ADD  sClass, hDlg, %ID_TIME_CERTAIN, "", 108,35 , 64, 16, iStyle
        
            ' Label in which we we will display the current time, default styles OK
            iStyle      =   %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
            CONTROL   ADD LABEL, hDlg, %ID_CURRENT_TIME, "current time", 188, 8 , 68, 8, iStyle
        
            ' Static control in which we display current status of timer
            iStyle       = %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %SS_SUNKEN
            CONTROL   ADD LABEL, hDlg, %ID_CURRENT_STATUS_LIT, "Just Starting", 16, 79, 230, 18, iStyle
        
            ' action buttons default styles OK
            CONTROL   ADD BUTTON, hDlg, %ID_RESET, "Set/Reset"          ,  50, 52, 52, 14
            CONTROL   ADD BUTTON, hDlg, %ID_CANCEL_TIMER, "Cancel Timer", 145, 52, 52, 14
        
           ' Listview console for messages
           sClass    = $WC_LISTVIEW
           iStyle    =   %WS_GROUP  OR %LVS_REPORT       OR %LVS_SINGLESEL     OR %WS_VISIBLE OR %WS_CHILD _
                      OR %WS_BORDER OR %LVS_NOSORTHEADER OR %LVS_SHOWSELALWAYS
           CONTROL    ADD sCLass, hDlg, %ID_CONSOLE, "", 2,106, 260, 76, iStyle
        
           ' explicit quit, default button type
           CONTROL   ADD BUTTON, hDlg, %ID_QUIT, "Hasta la vista, Baby", 190, 192, 71,14
        
           ' and what's a demo without a little shameless self promotion?
           iStyle    = %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
           CONTROL   ADD LABEL, hDlg, -1&, "Demo Courtesy Michael Mattias Racine WI USA", 4, 211, 252,8, iStyle
        
          ' show the dialog..
        
        
            DIALOG SHOW MODAL hDlg, CALL MainDlgCallbackProc TO iResult
        
        
        END FUNCTION
        
        ' ===========================================================
        ' 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
        ' --------------------------------------------------------------
        FUNCTION InitLvConsole (BYVAL hWnd AS LONG) AS LONG
         ' set up the column headers for the console listview
           LOCAL  lvc AS lvcolumn, 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  = 430
           I       = SendMessage (hWnd, %LVM_INSERTCOLUMN, 1, BYVAL VARPTR(lvc))
        
        END FUNCTION
        
        ' ------------------------------------------------------------------
        '              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
        ' ------------------------------------------------------------------
        
        FUNCTION AddLvConsoleMessage (BYVAL hWnd AS LONG, szMessageText AS ASCIIZ, OPTIONAL BYVAL NoDateTime AS LONG) AS LONG
            ' add time in col 0, szText in col 1 and insure that the last (lowest)
            ' visible item in listview is this text
           LOCAL    lvi AS Lvitem
           LOCAL    szDf AS ASCIIZ * 32, szTF AS ASCIIZ * 32, systime AS SYSTEMTIME
           LOCAL    szdt AS ASCIIZ * 48, szdate AS ASCIIZ * 24, szTime AS ASCIIZ * 24
        
           IF ISTRUE NoDateTime THEN    ' we do not want a date in column zero
               szdt = SPACE$(01)
           ELSE                         ' duh, we DO want a date in column zero
               szDF              = "M'/'dd'/'yy"
               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 & CHR$(&h20) & 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
        
        ' // END OF FILE WAITTIME.BAS

        Comment


        • #5
          Code didn't resist to time, updated...

          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
          '______________________________________________________________________________
          '

          Comment

          Working...
          X