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
Comment