Update of StopWatch to 10 ms accuracy
Following Paul Dixon's advice, I used the timeSetEvent routine and
replaced the TIMER results by a counter that gets triggered every 10 ms.
Optically one does not see any difference but the red hand will now be able
to stop at any of the 100 dots.
Supposedly this works only with Win XP. Since I do not have any earlier
versions running any more (and no Vista), I cannot test this _XP version
under any other systems.
Here is the link to the routine in the MSDN Library:
Rgds,
Gert Voland.
-
Paul,
Thanks for the hint. Looks like a great function.
It doesn't seem to be described in the win32.hlp that I have been using
but lately there was a post with links to newer versions.
I'll give it a try and update the code if I succeed.
Rgds, Gert.Leave a comment:
-
Gert,
If you consider that to be a problem then it is possible to run a timer with a much finer resolution. The following shows one way to create a 1msec timer but maybe a 10msec timer would better suit your application.Accuracy = +/- 0.015625 sec (= 1/64 sec) due to TIMER resolution.
Paul.
Code:$INCLUDE "WIN32API.INC" DECLARE FUNCTION test( BYVAL uID AS LONG, BYVAL uMsg AS LONG, _ BYVAL dwUser AS LONG, BYVAL dw1 AS LONG, BYVAL dw2 AS LONG) AS LONG GLOBAL COUNT AS LONG FUNCTION WINMAIN (BYVAL hInstance AS LONG, _ BYVAL hPrevInstance AS LONG, _ BYVAL lpCmdLine AS ASCIIZ PTR, _ BYVAL iCmdShow AS LONG) AS LONG 'start the timer '1=milliseconds between triggers, 0=maximum timer resolution, test=the routine to call TimerHandle& = timeSetEvent ( BYVAL 1, BYVAL 0, CODEPTR(test), BYVAL 0&, BYVAL %TIME_PERIODIC) PRINT "press a key to end." DO LOCATE 10,10 PRINT "Time=";FORMAT$(count&/1000,"#######.###");"secs." SLEEP 0 LOOP UNTIL INSTAT timeKillEvent TimerHandle& END FUNCTION FUNCTION test ( BYVAL uID AS LONG, BYVAL uMsg AS LONG, _ BYVAL dwUser AS LONG, BYVAL dw1 AS LONG, BYVAL dw2 AS LONG) AS LONG 'this is the routine that is run everytime the timer triggers INCR COUNT END FUNCTIONLeave a comment:
-
StopWatch: A graphic application written entirely in PB/CC
The code below is to demonstrate a graphical application written completely in PB/CC (V5.01)
- without using the console,
- without subclassing any windows and
- without the SDK event mechanism,
just using the built-in PB/CC features and a few API calls.
The creation of the buttons and the event interface is done using the include file
GrButtons.inc (V0.6), which also has been updated to PB/CC 5.01:
Please copy it from there for recompilation of StopWatch.
An .exe file can be found in the attachment.
The size of the StopWatch can be set as a command line parameter.
Colors can be changed easily as they are all controlled through equates.
Note the limited measurement accuracy of not better than 1/64 of a second.
Still, the display shows hundredths of seconds - I thought it looked better this way ...
Gert Voland.
Code:' StopWatch.bas ' Usage: StopWatch.exe [clockSize] ' ' Set clockSize on command line in the range between 100 and 1000 (default = 250). ' ' Line entry for End Time (mm:ss) with .OnClick routine to enforce format rules during entry. ' Range: 1 sec up to 1 hour (= 60:00). ' Display mm:ss.xx, xx = number of 1/100 sec (=> 00:00.00 to 60:00.00). ' Accuracy = +/- 0.015625 sec (= 1/64 sec) due to TIMER resolution. ' Set Sound: Activate Standard Alarm manually and put it on speaker. ' Author: Gert Voland ' Compiler: PBCC 5.01 ' OS: Windows XP ' Date: 15. Mar. 2009 ' Version: V0.3 ' Release: Public domain by the Author. Use at own risk. #DIM ALL #COMPILE EXE "StopWatch.exe" #BREAK ON #CONSOLE OFF '*** copy from here ******************************************************************************************* ' Copied from GrButtons.inc V0.6 %GWMainEquates = 1 ' This prevents the equates to be used again in the .inc file (do not change!) ' Overwrite the default equates here locally: '--- GW management -------------------------------------------------------------------------------------------- %GW_UseCaption = 1 ' = 0 => Useful with #CONSOLE ON. It uses fixed button windows without caption, locked to the Console. ' If used without the Console, the first button window (= BaseApplication) will have a caption. ' = 1 => All GW use a caption string to get movable button windows, not locked to the Console/BaseAppl. %GW_Debug = 0 ' 1 => Print errors to a QueryBox. 0 => Don't display them. ' They get checked in any case; see Return codes for GraphicDestroyWindow(), GraphicGetEvents() etc. '--- Button and Frame settings -------------------------------------------------------------------------------- %ButtonCorners = 25 ' Percentage of Button corner rounding. Range: 0 to 100. The button focus stays rectangular, though. %FrameCorners = 0 ' Percentage of Frame corner rounding. %DeltaFocus = 3 ' Number of pixels that the dotted button focus is smaller for GB and bigger for TB (Range: >= 0). %OffsetTBText = 4 ' Number of FontSize/4 that TB text is placed left of TB (Range: >= 1) %UseTBBullet = 1 ' 1 => Use a round bullet (like a Radio button). 0 => Use a square boxes for TB. %TickWidth = 1 ' 1 => thin X. 2 => thick X. For bullets it may be > 2. $LE_Continue = "" ' Continuation string when LE text does not fit in box (may be "..." or "" %LE_CaretWidth = 2 ' Width of caret (cursor) in LineEntry. Range: 1 or 2 '--- Some colors ---------------------------------------------------------------------------------------------- %darker_gray = &h404040 %lighter_gray = &hf0f0f0 %GW_BackColor = %RGB_LIGHTGRAY ' Background for black Console %GW_DisableColor = %RGB_GRAY ' Disable color for Button/Tickbox/LineEntry. Set to %GW_BackColor to let GB/TB "disappear" if disabled %GW_FocusColor = %RGB_BLACK ' Color of the button focus dots. => %RGB_LIGTHGRAY for black background (standard Console etc.) %LE_CaretColor = %RGB_SLATEGRAY ' Color used for the caret in LineEntry. '--- Equates for QueryBox$ ------------------------------------------------------------------------------------ %QB_w = 300 ' Width, can be adjusted to suit screen resolution etc. %QB_h = 150 ' Height for QB with two lines of text. Sizes and positions are automatically adjusted. %QB_FrameBorderColor = %darker_gray $QB_FrameFontName = "Arial" %QB_FrameFontStyle = 1 ' Bold %QB_FrameFontSize = 10 %QB_FrameTextColor = %RGB_BLACK %QB_ButtonBorderColor = %darker_gray $QB_ButtonFontName = "Microsoft Sans Serif" %QB_ButtonFontStyle = 0 ' Normal %QB_ButtonFontSize = 9 %QB_ButtonTextColor = %RGB_BLACK %QB_ButtonBackColor = %lighter_gray %QB_ButtonHoverBackColor = %RGB_GRAY %QB_ButtonHoverTextColor = %RGB_YELLOW %QB_ButtonHoverBorderColor = %RGB_DIMGRAY '*** end of copy ********************************************************************************************* 'Equates for configuring the clock '------------------------------------------------------------------------------ $title = "StopWatch" '--- clock_size/color/behavior --- %clock_reduct = 8 'reduction in per cent %clock_color = %GW_BackColor 'background of clock %clock_hand_jump = 0 '0 => second and minute hands move gradually; 1 => hands jump by 6 degrees %clock_extension = 50 'extension of GW downwards in percent '--- text size/color %text_color = %RGB_BLACK 'foreground color for time %text_size = 15 'size in percent of clockSize/2 ' The following dimensions are given in percent of clock_size/2 '--- quarter ticks --- %qtick_color = %RGB_BLACK %qtick_start = 86 'should be larger than longest hand! %qtick_end = 98 'relative end of quarter ticks %qtick_width = 5 'relative width of quarter ticks '--- 5-second ticks --- %s5tick_color = %RGB_GRAY %s5tick_start = 86 'relative start of 5-second ticks %s5tick_end = 92 'relative end of 5-second ticks %s5tick_width = 4 'relative width of 5-second ticks '--- second ticks --- %stick_color = %RGB_DARKGRAY %stick_start = 84 'relative start of second ticks %stick_end = 86 'relative end of second ticks %stick_width = 3 'relative width of second ticks '--- sec100 ticks --- %s100tick_color = %RGB_WHITE %s100tick_start = 95 'relative start of sec100 ticks %s100tick_end = 97 'relative end of sec100 ticks %s100tick_width = 2 'relative width of sec100 ticks '-- minute hand --- %mhand_color = %RGB_GRAY %mhand_size = 72 'relative size of minute hand %mhand_width = 7 'relative width %mhand_cap = 10 'relative size of minute hand end cap '-- second hand --- %shand_color = %RGB_GRAY %shand_size = 78 'relative size of second hand %shand_width = 6 'relative width %shand_cap = 16 'relative size of second hand end cap '-- sec100 hand --- %s100hand_color = %RGB_RED %s100hand_size = 90 'relative size of sec100 hand %s100hand_width = 4 'relative width %s100hand_cap = 20 'relative size of sec100 hand end cap '--- center axis color --- %axis_color = %RGB_RED %axis_size = 12 'relative size of axis '---------------------------------------------------------------------------------------------------- #INCLUDE "GrButtons.inc" 'use V0.6 for PB/CC 5.01 (see above: default equates get overwritten) ' Equates for button and frame IDs (must be >0 and unique) %GB_EndTime = 10 %GB_Go = 11 %GB_Stop = 12 %GB_Reset = 13 %GB_Quit = 14 %GB_FullScale = 15 '-- Macros/Equates --- MACRO D2R(deg) = (deg * 0.0174533) 'convert degrees to radians: radians = D2R(degrees) %false = 0 '--- Globals of StopWatch --- GLOBAL clockSize AS LONG '------------------------------------------------------------------------------ FUNCTION PBMAIN () AS LONG LOCAL nminute AS LONG LOCAL nsecond AS LONG LOCAL nsec100 AS LONG LOCAL end_it AS LONG 'true when GW gets closed LOCAL start_time AS DOUBLE 'time with 1/64 sec resolution (= 0.015625 sec) LOCAL now_time AS DOUBLE LOCAL retButton AS LONG LOCAL state AS LONG 'state after an action STATIC init AS LONG LOCAL final$, minutes$, seconds$ LOCAL end_time AS DOUBLE LOCAL nextActiveID AS LONG LOCAL cs AS LONG cs = VAL(COMMAND$) 'set clockSize in command line from 100 to 1000 IF cs < 100 OR cs > 1000 THEN clockSize = 250 ELSE clocksize = cs END IF CALL Create_GW_Buttons(1) 'initial setup state = %GB_Reset init = 0 'read preset time and convert it final$ = GraphicGetLEText(%GB_EndTime) minutes$ = EXTRACT$(final$, ":") seconds$ = REMAIN$(final$, ":") end_time = VAL(minutes$) * 60 + VAL(seconds$) DO now_time = (TIMER - start_time) * 100 'number of 1/100th seconds now_time = INT(now_time + 0.5) 'round to full 1/100th CALL Convert_Time (now_time, nminute, nsecond, nsec100) 'Do not start with negative values IF state = %GB_Reset OR nminute < 0 THEN nsec100 = 0 nsecond = 0 nminute = 0 END IF CALL Set_Clock (nminute, nsecond, nsec100, end_it) 'update clock part of the GW IF end_it THEN GOTO endStopWatch: SLEEP 0 'allow other processes GRAPHIC SCALE PIXELS 'use PB default for buttons! DO CALL GraphicGetEvents(retButton, nextActiveID) 'retButton = 0 if no button gets activated, IF retButton < 0 OR retButton = %GB_Quit THEN GOTO endStopWatch: 'quit in any case ' Read end time setting IF retButton = %GB_EndTime THEN final$ = GraphicGetLEText(%GB_EndTime) minutes$ = EXTRACT$(final$, ":") seconds$ = REMAIN$(final$, ":") end_time = VAL(minutes$) * 60 + VAL(seconds$) nextActiveID = 0 'do not activate any buttons automatically GraphicSetFocus(%GB_Go) END IF ' Activate %GW_EndTime if it is selected for immediate editing ' When this IF/END IF is REMed out, the LE %GW_EndTime will not be activated automatically ... IF GraphicGetFocus(%GB_EndTime) = 1 THEN nextActiveID = %GB_EndTime ELSE nextActiveID = 0 END IF SELECT CASE state CASE %GB_Reset IF init = 0 THEN init = 1 GraphicButtonsDisable(%GB_Stop) GraphicButtonsDisable(%GB_Reset) GraphicSetFocus(%GB_Go) END IF IF retButton = %GB_Go THEN GraphicButtonsDisable(%GB_EndTime) GraphicButtonsDisable(%GB_Quit) GraphicButtonsDisable(%GB_Reset) GraphicButtonsEnable(%GB_Stop) GraphicButtonsDisable(%GB_Go) GraphicSetFocus(%GB_Stop) state = %GB_Go start_time = TIMER END IF EXIT LOOP CASE %GB_Go IF now_time >= end_time * 100 THEN BEEP 'Alarm sound GraphicButtonsEnable(%GB_Quit) GraphicButtonsEnable(%GB_Reset) GraphicButtonsDisable(%GB_Stop) GraphicSetFocus(%GB_Reset) state = %GB_FullScale ITERATE DO END IF IF retButton = %GB_Stop THEN GraphicButtonsEnable(%GB_Quit) GraphicButtonsEnable(%GB_Reset) GraphicButtonsDisable(%GB_Stop) GraphicButtonsEnable(%GB_Go) GraphicSetFocus(%GB_Go) state = %GB_Stop ELSE EXIT LOOP 'set clock END IF CASE %GB_Stop IF retButton = %GB_Go THEN GraphicButtonsDisable(%GB_EndTime) GraphicButtonsDisable(%GB_Quit) GraphicButtonsDisable(%GB_Reset) GraphicButtonsEnable(%GB_Stop) GraphicButtonsDisable(%GB_Go) GraphicSetFocus(%GB_Stop) state = %GB_Go start_time = TIMER - now_time/100 EXIT LOOP ELSEIF retButton = %GB_Reset THEN GraphicButtonsEnable(%GB_EndTime) GraphicButtonsDisable(%GB_Stop) GraphicButtonsDisable(%GB_Reset) GraphicButtonsEnable(%GB_Go) GraphicSetFocus(%GB_EndTime) state = %GB_Reset END IF CASE %GB_FullScale IF retButton = %GB_Reset THEN GraphicButtonsEnable(%GB_EndTime) GraphicButtonsDisable(%GB_Reset) GraphicButtonsEnable(%GB_Go) GraphicSetFocus(%GB_EndTime) state = %GB_Reset EXIT LOOP END IF END SELECT LOOP LOOP endStopWatch: GraphicDestroyWindow(1) 'destroy the main graphic window END FUNCTION 'PBMAIN '------------------------------------------------------------------------------ SUB Create_GW_Buttons(BYVAL nID AS LONG) 'create graphic window and buttons LOCAL xdesktop AS LONG 'number of pixels in x direction LOCAL ydesktop AS LONG 'number of pixels in y direction LOCAL xpos AS LONG 'x position for GW LOCAL ypos AS LONG 'y position for GW LOCAL Button AS GraphicButton 'data set for button parameters 'test screen size first DESKTOP GET SIZE TO xdesktop, ydesktop 'no. pixels of screen IF $title = "" THEN 'position in middle of right edge xpos = xdesktop-clockSize-15 'some pixels away from edge ypos = ydesktop/2-clockSize/2 ELSE 'window in middle of screen xpos = xdesktop/8 ypos = ydesktop/8 END IF 'extend the GW down for display and buttons: start the GW with GrButtons.inc CALL GraphicCreateWindow(nID, $title, xpos, ypos, clockSize, clockSize * (1 + %clock_extension/100)) GRAPHIC SCALE PIXELS Button.ID = %GB_EndTime Button.Type = %GW_LineEntry Button.Width = (clockSize/200 * %text_size) * 5.6 Button.Height = clockSize/200 * %text_size * 2.2 Button.x = (clockSize * 0.25) - Button.Width/2 Button.y = clockSize/200 * 248 - Button.Height/2 Button.Text = "00:12" button.TextAlign = %GW_Center Button.nUnderChar = 0 Button.HotKey = "^E" Button.FontName = "Arial" Button.FontSize = clockSize/200 * %text_size Button.FontStyle = 1 Button.TextColor = %RGB_BLACK Button.BackColor = %clock_color Button.BorderColor = %clock_color Button.HoverFontStyle = 1 Button.HoverTextColor = %RGB_BLUE Button.HoverBackColor = %clock_color Button.HoverBorderColor = %clock_color Button.Focus = 0 Button.OnClick = CODEPTR(CheckTimeEntry) 'enforce the editing rules there Button.Disable = 0 'enabled CALL GraphicAddButton(Button) Button.ID = %GB_Quit Button.Type = %GW_Button Button.x = clockSize/200 * (8 + 0 * 48) Button.y = clockSize/200 * 272 Button.Width = clockSize/200 * 40 Button.Height = clockSize/200 * 20 Button.Text = "Quit" Button.nUnderChar = 1 Button.HotKey = "ESC" Button.FontSize = clockSize/200 * 8 Button.BackColor = %RGB_SILVER Button.BorderColor = %RGB_GRAY Button.HoverBackColor = %RGB_SILVER '%RGB_DARKGRAY Button.HoverBorderColor = %RGB_YELLOW Button.OnClick = 0 'no routine is set up CALL GraphicAddButton(Button) Button.ID = %GB_Reset Button.x = clockSize/200 * (8 + 1 * 48) Button.Text = "Reset" Button.HotKey = "^R" Button.HoverBorderColor = %RGB_BLACK CALL GraphicAddButton(Button) Button.ID = %GB_Stop Button.x = clockSize/200 * (8 + 2 * 48) Button.Text = "Stop" Button.HotKey = "^S" Button.Focus = 0 CALL GraphicAddButton(Button) Button.ID = %GB_Go Button.x = clockSize/200 * (8 + 3 * 48) Button.Text = "Go" Button.HotKey = "^G" Button.Focus = 1 'preset CALL GraphicAddButton(Button) END SUB 'Create_GW_Buttons '------------------------------------------------------------------------------ SUB Set_Clock (nminute AS LONG, nsecond AS LONG, nsec100 AS LONG, end_it AS LONG) 'set new clock values as hands LOCAL hDC AS DWORD 'hand of GW LOCAL mangle AS SINGLE 'minute angle LOCAL sangle AS SINGLE 'second angle LOCAL s100angle AS SINGLE 'sec100 angle LOCAL clock_red AS SINGLE 'reduced clock size 'these must be static because the calling loop is outside STATIC omangle AS SINGLE 'old minute angle STATIC osangle AS SINGLE 'old second angle STATIC os100angle AS SINGLE 'old sec100 angle os100angle = 999 'set an old value <> 0 clock_red = clockSize/2 * (1 + %clock_reduct/100) 'define origin in middle of GW; x is positive to the right; y is positive downwards! GRAPHIC SCALE (-clock_red, -clock_red) - (clock_red, clock_red * (1 + 2 * %clock_extension/100)) 'reduced by 20 % IF %clock_hand_jump = 0 THEN mangle = 6 * (nminute + nsecond/60) - 90 'moves gradually sangle = 6 * (nsecond + nsec100/100) - 90 ELSE mangle = 6 * nminute - 90 'jumps by 6 degrees sangle = 6 * nsecond - 90 END IF s100angle = 3.6 * nsec100 - 90 'jumps by 3.6 degrees IF s100angle <> os100angle OR sangle <> osangle OR mangle <> omangle THEN 'erase all old hands when seconds have changed by drawing a box with clock size GRAPHIC BOX (-clockSize/2, clockSize/2) - (clockSize/2, -clockSize/2), 0, %clock_color, -1 'draw everything new CALL Draw_Ticks 'update all ticks (yes, it takes a bit of CPU) CALL Draw_a_Line (mangle, -%mhand_cap, %mhand_size, %mhand_width, %mhand_color) 'new minute hand omangle = mangle 'remember this one CALL Draw_a_Line (sangle, -%shand_cap, %shand_size, %shand_width, %shand_color) 'new second hand osangle = sangle CALL Draw_a_Line (s100angle, -%s100hand_cap, %s100hand_size, %s100hand_width, %s100hand_color) 'new sec100 hand os100angle = s100angle CALL Draw_Axis CALL Print_Time (nminute, nsecond, nsec100) GRAPHIC REDRAW 'update clock with new positions END IF GRAPHIC GET DC TO hDC IF hDC = 0 THEN end_it = %true END SUB 'Set_Clock '------------------------------------------------------------------------------ SUB Convert_Time (now_time AS DOUBLE, nminute AS LONG, nsecond AS LONG, nsec100 AS LONG) 'convert time to mm, ss and xx LOCAL time AS DOUBLE time = now_time 'comes as 1/100 seconds nminute = INT(time/6000) time = time - nminute * 6000 nsecond = INT(time/100) nsec100 = time - nsecond * 100 END SUB 'Convert_Time '------------------------------------------------------------------------------ SUB Draw_Ticks 'calculate all tick positions LOCAL angle AS SINGLE FOR angle = 3.6 TO 360 STEP 3.6 'draw 100 ticks for 1/100 of a second, every 3.6 degrees CALL Draw_a_Line(angle, %s100tick_start, %s100tick_end, %s100tick_width, %s100tick_color) NEXT angle FOR angle = 6 TO 360 STEP 6 IF angle MOD 90 = 0 THEN 'do quarter ticks CALL Draw_a_Line(angle, %qtick_start, %qtick_end, %qtick_width, %qtick_color) ELSEIF angle MOD 30 = 0 THEN 'do 5-minute ticks CALL Draw_a_Line(angle, %s5tick_start, %s5tick_end, %s5tick_width, %s5tick_color) ELSE 'do second ticks at all the remaining angles CALL Draw_a_Line(angle, %stick_start, %stick_end, %stick_width, %stick_color) END IF NEXT angle END SUB 'Draw_Ticks '------------------------------------------------------------------------------ SUB Draw_a_Line (angle AS SINGLE, line_start AS LONG, line_end AS LONG, line_width AS LONG, line_color AS LONG) 'draw a single tick or hand LOCAL cos_rad AS SINGLE LOCAL sin_rad AS SINGLE LOCAL x1 AS LONG 'coordinates LOCAL y1 AS LONG LOCAL x2 AS LONG LOCAL y2 AS LONG cos_rad = COS(D2R(angle)) * clockSize/200 'cosine with radians normalized to xyclock/2 * 1/100 to be multiplied by n percent sin_rad = SIN(D2R(angle)) * clockSize/200 'sine with radians normalized to xyclock/2 * 1/100 to be multiplied by n percent x1 = line_start * cos_rad y1 = line_start * sin_rad x2 = line_end * cos_rad y2 = line_end * sin_rad GRAPHIC WIDTH line_width * clockSize/200 GRAPHIC LINE (x1, y1) - (x2, y2), line_color END SUB 'Draw_a_Line '------------------------------------------------------------------------------ SUB Draw_Axis 'draw a solid circle as axis in the middle of the GW LOCAL axis_size AS LONG 'pixel values relative to middle of GW axis_size = %axis_size/2 * clockSize/200 GRAPHIC WIDTH 2 'prevent pixel ring ' (upper left x, y) - (lower right x, y), edge color, inner color, fill style GRAPHIC ELLIPSE (axis_size, -axis_size) - (-axis_size, axis_size), %axis_color, %axis_color, 0 GRAPHIC WIDTH 1 'reset to 1 END SUB 'Draw_Axis '------------------------------------------------------------------------------ SUB Print_Time (nminute AS LONG, nsecond AS LONG, nsec100 AS LONG) 'print time as mm:ss.xx LOCAL t$ LOCAL xwidth AS LONG LOCAL yheight AS LONG STATIC init AS LONG STATIC hFont AS LONG LOCAL tsize AS LONG LOCAL xpos, ypos AS SINGLE GRAPHIC SCALE PIXELS IF init = 0 THEN init = 1 'titles tsize = clockSize/200 * %text_size * 0.5 FONT NEW "Arial", tsize, 1, 0, 0, 0 TO hFont GRAPHIC SET FONT hFont GRAPHIC COLOR %RGB_DIMGRAY t$ = "Set End Time " GRAPHIC TEXT SIZE t$ TO xwidth, yheight xpos = clockSize * 0.25 - xwidth/2 ypos = clockSize/200 * 205 GRAPHIC SET POS (xpos, ypos) GRAPHIC PRINT t$ t$ = "Elapsed Time " GRAPHIC TEXT SIZE t$ TO xwidth, yheight xpos = clockSize * 0.75 - xwidth/2 GRAPHIC SET POS (xpos, ypos) GRAPHIC PRINT t$ 'mm:ss.x FONT NEW "Arial", tsize, 1, 0, 0, 0 TO hFont GRAPHIC SET FONT hFont t$ = "mm : ss " GRAPHIC TEXT SIZE t$ TO xwidth, yheight xpos = clockSize * 0.25 - xwidth/2 ypos = ypos + yheight GRAPHIC SET POS (xpos, ypos) GRAPHIC PRINT t$ t$ = "mm : ss . xx " GRAPHIC TEXT SIZE t$ TO xwidth, yheight xpos = clockSize * 0.75 - xwidth/2 GRAPHIC SET POS (xpos, ypos) GRAPHIC PRINT t$ 'actual elapsed time tsize = clockSize/200 * %text_size FONT NEW "Arial", tsize, 1, 0, 0, 0 TO hFont END IF GRAPHIC SET FONT hFont GRAPHIC COLOR %text_color, %clock_color t$ = FORMAT$(nminute, "*0\:") + FORMAT$(nsecond, "*0\.") + FORMAT$(nsec100, "00\") GRAPHIC TEXT SIZE t$ TO xwidth, yheight xpos = clockSize * 0.54 ypos = clockSize/200 * 248 - yheight/2 GRAPHIC SET POS (xpos, ypos ) GRAPHIC PRINT t$ END SUB 'Print_Time '------------------------------------------------------------------------------ SUB CheckTimeEntry ' OnClick routine: A filter to enforce a correct format mm:ss. ' OverType mode always on; caret moves one digit to the right. ' With mm: from 00: to 60: and :ss from :00 to :59. ' Min. setting 00:01, Max. setting = 60:00. ' No caret at position 2 or 5. ' The content can be copied to the clipboard and can be inserted from there, ' when caret is at position 0 and the format fits. ' Use BaseApplication.OverType to retrieve and set the OverType mode. LOCAL sText$ LOCAL caretPos, editMode, validText AS LONG LOCAL minutes$, seconds$ LOCAL endTime, x AS LONG STATIC oldCaret AS LONG CALL LEGetTextParameters(sText$, caretPos, editMode) ' Read parameters validText = %false BaseApplication.OverType = 1 ' Set OverType in any case IF INSTR(sText$, ":") = 0 THEN GOTO notvalid: ' Do not delete : IF LEN(sText$) <> 5 THEN GOTO notvalid: ' Allow exactly mm:ss minutes$ = EXTRACT$(sText$, ":") seconds$ = REMAIN$(sText$, ":") endTime = VAL(minutes$) * 60 + VAL(seconds$) ' Total number of seconds IF endTime > 3600 THEN IF LEFT$(minutes$, 1) = "6" THEN ' Was this an attempt to set 60:00? sText$ = "60:00" caretPos = 0 ' Keep caret at 0 because there is nothing else changeable GOTO isvalid: END IF GOTO notvalid: END IF x = ASC(minutes$, 1) ' Only allow numbers in a certain range: IF x < 48 OR x > 54 THEN caretPos = 0 GOTO notvalid: ' 0 - 6 END IF x = ASC(minutes$, 2) IF x < 48 OR x > 57 THEN caretPos = 1 GOTO notvalid: ' 0 - 9 END IF x = ASC(seconds$, 1) IF x < 48 OR x > 53 THEN caretPos = 3 GOTO notvalid: ' 0 - 5 END IF x = ASC(seconds$, 2) IF x < 48 OR x > 57 THEN GOTO notvalid: ' 0 - 9, caretPos gets set to 4 later IF ISFALSE editMode THEN ' Check at the end after CR IF VAL(minutes$) = 0 AND VAL(seconds$) = 0 THEN GOTO notvalid: ' Do not allow 00:00 END IF IF caretPos > 4 THEN caretPos = 4 ' Do not let caret go past last digit IF caretPos = 2 THEN caretPos = 2 * caretPos - oldCaret ' Avoid position 2 coming from 1 or 3 isvalid: validText = %true notvalid: oldCaret = caretPos ' Store last caret position CALL LESetTextParameters(sText$, caretPos, validText) ' Write parameters back END SUB 'CheckTimeEntry '--- End of Program -----------------------------------------------------------Last edited by Gert Voland; 15 Mar 2009, 11:11 AM.
Leave a comment: