Announcement

Collapse
No announcement yet.

Timer Display

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

  • #41
    Have since dome a little updating:
    Code: http://www.swedesdock.com/powerbasic/Digital_Timer.bas
    Exe: http://www.swedesdock.com/powerbasic/Digital_Timer.exe

    ====================================================
    The only thing to do with good advice is pass it on.
    It is never any use to oneself.
    Oscar Wilde
    ====================================================
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

    Comment


    • #42
      Just today added 5 second/minute increment spinners to the display.


      '
      Code:
      'PBWIN 9.03 - Win32Api 10/2009 - XP Pro SP3
      '1} force on top when time is done
      #Dim All
      #Compile Exe
      #Optimize SPEED
      '#Debug Display On'off for production code
      #Include "WIN32API.INC" '10/2009
      #Include "COMDLG32.INC" '08/2008
      #Include "InitCtrl.inc" '08/2008
      '
      '
      ' *******************************************************
      '
      %ButtonPlus_Loaded = 1 'Note set to 0 if you don't have ButtonPlus, rem  Include &
                             '3 lines within 2 functions beginning with z_ (should be line numbers in the 80's)
                             ' if you still get errors
      #If %ButtonPlus_Loaded
         #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
      #EndIf
       
      #If Not %ButtonPlus_Loaded    'else will get extra errors from existing calls
         %BP_TEXT_COLOR    = 1
         %BP_ICON_ID       = 2
         %BP_ICON_WIDTH    = 3
         %BP_ICON_HEIGHT   = 4
         %BP_ICON_POS      = 5
         %BP_FACE_COLOR    = 6
         %BP_FACE_BLEND    = 7
         %BP_SPOT_COLOR    = 8
         %BP_SPOT_BLEND    = 9
         %BP_SPOT_WIDTH    = 10
         %BP_SPOT_HEIGHT   = 11
         %BP_SPOT_POS      = 12
      #EndIf
      ' #Else
      '   #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
      '#EndIf
      '
      ' *******************************************************
      '
      '
      %Id_Exit_Btn = 999
      %Hours_tb = 1000
      %Hour_Spinner = 1002
      %Minutes_tb = 1010
      %Minute_Spinner = 1012
      %Ten_Minute_Spinner = 1014
      %Seconds_tb = 1020
      %Second_Spinner = 1022
      %Ten_Second_Spinner = 1024
      %Start_Timer_Btn = 1100
      %Stop_Timer_Btn  = 1110
      %Reset_Timer_Btn  = 1120
      %Graphic_Target = 1200         
      '
      %Top = %MB_SYSTEMMODAL
      '
      %Btn_Color = &he75718
      %Neutral_Color = &hd8e9ec
      '
      $Title = Space$(20) & "Timer"
      '
      ' *******************************************************
      '
          'keep consistent style wherever used
      %spinner_style = %WS_CHILD Or _
                       %WS_VISIBLE 'Or _
                       's_wrap Or _
                      ' s_arrowkeys
      '
      ' *******************************************************
      '
        Global g_hdlg, hWin As Dword
        Global Comic(), Consolas() As Dword
        Global g_Secs_to_go, Dlg_ht, Dlg_Wd As Long 'Global in case want to use in Controls
        Global pnmud As nm_updown Ptr     'pointer to structure used by spinner
        Global g_Title As String * 50
        Global g_Start_Stop_Flag, g_Button_Plus1, g_Button_Plus2, g_Button_Plus3 As Long
      '
      ' *******************************************************
      '
      '
      #If %ButtonPlus_Loaded = 1
      Function  z_Btn_Set_Face_Color(ddlg As Dword, dId As Long, Btn_Color As Long) As Long
         ButtonPlus  ddlg, dId, %BP_FACE_BLEND, 255 'true color
         ButtonPlus dDlg, dId, %BP_FACE_COLOR, Btn_Color ' &H008FDF8F
      End Function
      '
      Function z_Btn_Set_Text_Color(ddlg As Dword, Id As Long, Btn_Color As Long) As Long
         ButtonPlus dDlg, Id, %BP_Text_COLOR, Btn_Color ' &H008FDF8F
      End Function
      #EndIf
      '
      Macro Common_Locals 'Macro easier than retyping and maintains coding consistency
        Local Stile, Row, col, ht, wd, Longest,ctr, ln, ln1, i As Long
        Local text_Color, Face_color, tctl, spcr, idd, idd1 As Long
        Local flag, n, hrs, secs, mins, tmr, tmr1, Secs_To_Run As Long
      '
        Local  w, l, s, s1, s2, s3 As String
      End Macro
      '
      Sub Fonts_Setup
        common_locals
               Dim Comic(2 To 72), Consolas(2 To 72)
               For ctr = 2 To 72
                 Font New "Comic Sans MS", ctr To Comic(ctr)
                 Font New "Consolas", ctr To Consolas(ctr)
               Next ctr
      End Sub
      '
      Macro Show_Time_in_Title
         s1$ = Right$(Using$("*0##", secs), 2)
         s2$ = Right$(Using$("*0##", mins), 2)
         s3$ = Right$(Using$("##", hrs), 2)'Right$(Str$(hrs) & ":", 3)  ')Using$("*0##:", hrs)
         If mins > 0 Then
            s1$ = s2$ & ":" & s1$ 'Str$(mins) & ":" & Right$(s1$, 2)
         End If
         If hrs > 0 Then
            s1$ = s3$ & ":" & s1$ 'Str$(hrs) & ":" & Right$(s1$, 5)
         End If
         Dialog Set Text g_hdlg, s1$'Using$("#:##", mins, secs)
      End Macro 
      '
      Macro Redraw_Textboxes
        n = g_Secs_to_go
        hrs = n \ 3600
          n = n - (Hrs * 3600) 'subtract hours
      ' ? Using$("gstg #, hrs #  n #", g_Secs_to_go, hrs, n)
        Mins = (n  \ 60)
      ' ? Using$("gstg #, hrs #  mins #", g_Secs_to_go, hrs, mins)
         Secs = n - (mins * 60)
        idd = %Hours_tb: Control Set Text g_hdlg, idd, Right$(Str$(hrs), 2): Control ReDraw  g_hdlg, idd
        idd = %Minutes_tb: Control Set Text g_hdlg, idd, Right$(Str$(mins), 2): Control ReDraw  g_hdlg, idd
        idd = %Seconds_tb: Control Set Text g_hdlg, idd, Right$(Str$(Secs), 2): Control ReDraw  g_hdlg, idd
        'control set focus g_hdlg, idd 'Attempt to keep dialog updating
      End Macro
      '
      Sub Disable_Buttons
        common_locals
        redraw_Textboxes 'to get hrs, mins,secs
         idd = %Start_Timer_Btn: l$ = Using$("##:##:##", hrs, mins, secs): Face_color = %Neutral_Color: Text_Color = %Neutral_Color: GoSub Color_Btn
         idd = %Reset_Timer_Btn: l$ = " ": Face_color = %Neutral_Color:  Text_Color = %Neutral_Color: GoSub Color_Btn
         idd = %Stop_Timer_Btn : l$ = "Stop ": Face_color = %Red: Text_Color = %White: GoSub Color_Btn
         'idd = %Id_Exit_Btn: l$ = "Press Any Key to Stop": Face_color = %White: Text_Color = %Black: GoSub Color_Btn
        Control Enable g_hdlg, %Stop_Timer_Btn
       Exit Sub
      '
      Color_Btn:
        Control Disable g_hdlg, idd
        Control Set Text g_hdlg, idd, l$
        #If %ButtonPlus_Loaded = 1
          z_Btn_Set_Face_Color(g_hdlg, Idd, Face_Color)
          z_Btn_Set_Text_Color(g_hdlg, Idd, Text_Color)
        #EndIf
        Control ReDraw g_hdlg, idd
      Return
      End Sub
      '
      '
      Sub Enable_Buttons
        common_locals
         idd = %Start_Timer_Btn: l$ = "&Start": Face_color = %Green: Text_Color = %Black: GoSub Color_Btn
         idd = %Reset_Timer_Btn: l$ = "&Reset": Face_color = %Blue:  Text_Color = %White: GoSub Color_Btn
         idd = %Stop_Timer_Btn : l$ = "Unknown": Face_color = %Neutral_Color: Text_Color = %Neutral_Color: GoSub Color_Btn
         idd = %Id_Exit_Btn: l$ = "Abandon Ship": Face_color = %White : Text_Color = %Black: GoSub Color_Btn
        Control Disable g_hdlg, %Stop_Timer_Btn
       Exit Sub
      '
      Color_Btn:
        Control Enable g_hdlg, idd
        Control Set Text g_hdlg, idd, l$
        #If %ButtonPlus_Loaded = 1
          z_Btn_Set_Face_Color(g_hdlg, Idd, Face_Color)
          z_Btn_Set_Text_Color(g_hdlg, Idd, Text_Color)
        #EndIf
        Control ReDraw g_hdlg, idd
      Return
      End Sub
      '
      ' *******************************************************
      '
      Function WorkerThread(ByVal x As Long) As Long
        Function = Timer_Start()
      End Function
      '
      ' *******************************************************
      '
      '
      Function Time_Left As Long
        common_Locals
        idd = %Hours_tb: Control Get Text g_hdlg, idd To s$
         hrs = Val(s$)
         Secs_To_Run = hrs * 60 * 60
        idd = %Minutes_tb: Control Get Text g_hdlg, idd To s$
         mins = Val(s$)
         Secs_To_Run = Secs_To_Run + (mins * 60)
        idd = %Seconds_tb: Control Get Text g_hdlg, idd To s$
         secs = Val(s$)
         Secs_To_Run = Secs_To_Run + secs
         Function = Secs_To_Run
      End Function
      '
      Function Timer_Start() As Long
        common_locals
        Local Time_to_Elapse As Long
        g_Secs_to_go = Time_Left 'calculates from textboxes
        If g_Secs_to_go = < 0 Then
           ? "Timer not set yet", %Top, Trim$($Title)
           Exit Function
        End If
      '
        Time_to_Elapse = Timer + g_Secs_to_go
      '  Graphic Window "", 1, 1, 1,  1 To hWin 'set dummy graphic window
      '  Graphic Attach hwin, 0
        CSet g_Title$ = "Timer At Work": Dialog Set Text g_hdlg, g_Title$
        Disable_Buttons
        flag = 0
      '
      'start loop *********************
        Do
         If g_Start_Stop_Flag = 1 Then 
           Exit Loop 'sent from Stop button
         End If  
      '
           g_Secs_to_go = Time_to_Elapse - Timer
      '     Graphic INKEY$ To w$
      '     n = Len(w$)
      '     Select Case n
      '       Case 0
      '       '
      '       Case 1 'key pressed
      '          'g_Start_Stop_Flag = 2
      '          'Exit Loop 
      '       Case 2 'extended key pressed  '<<< Never gets hit
      '         '?"extended"
      '         'Exit Loop
      '     End Select
         If Timer => tmr + 1 Then 'only once a second
            Redraw_Textboxes  'redraw tb's
            Show_Time_in_Title                                        '100  '10
            If g_Secs_to_go  < 61 And g_Secs_to_go  > 10 Then WinBeep 100, 50 'only in last 60 seconds
            If g_Secs_to_go  < 11 Then 
               WinBeep 1000, 20 'only in last 10 seconds
      '         Sleep 250
      '         WinBeep 2000, 10 'only in last 10 seconds
               'Sleep 250
            End If   
            tmr = Timer
         End If
        Loop While g_Secs_to_go > 0
      '********************
        Select Case g_Start_Stop_Flag
           Case 0
            CSet g_Title$ = "Timer Finished"
           Case 1
           CSet g_Title$ = "Timer Stopped by Button"
           Case 2
             CSet g_Title$ = "Timer Stopped by key"
        End Select                          
        Dialog Set Text g_hdlg, g_Title$
      'end loop '***********************
      '
      trexit:
      '  Graphic Window End
      '  Graphic Detach
        Redraw_Textboxes  'redraw tb's
      '**
        If flag + g_Start_Stop_Flag = 0 Then 'else no alarm
           For ctr = 1 To 10
              winbeep 2000, 1
              Sleep 100
           Next ctr
           '? "Timer expired", %Top, $title
           'SetWindowPos g_hdlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
           Dialog Show State g_hdlg, %SW_SHOWNORMAL   'restore if minimized after seeing Rodney Hicks post
           Control Set Focus g_hdlg, %Start_Timer_Btn      'brings to foreground
         End If
      '**  
        Enable_Buttons
      End Function
      '
      '
      CallBack Function Dialog_Processor
        Common_Locals
        Local h_thread, dwres As Dword
        '
        Select Case CbMsg     'This is TO determine the message TYPE
           '
           Case %WM_INITDIALOG'<- Initialiaton when the program loads
             Enable_Buttons
           '
           Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes
      '
           Case %WM_NOTIFY: 'Spinner_Macro   'for spinners
              pnmud = CB.lParam       'UDT defined in WinApi
                If @pnmud.hdr.Code = %udn_deltapos Then  '+1 or -1
                   ctr =  @pnmud.idelta * -1 'change sign to match arrows used
               End If
               tctl = CB.Ctl - 2 ' -2 to match to textboxes id's
               Select Case CB.Ctl
                 Case %Hour_Spinner   '
                   Control Get Text g_hdlg, tctl To s$
                     ctr = Val(s$) + ctr
                     If ctr > 24 Then ctr = 0
                     If ctr < 0 Then ctr = 24
                    Control Set Text g_hdlg, CB.Ctl - 2,  Right$(Str$(ctr), 2)
                 '
                 Case %Minute_Spinner, %Second_Spinner
                   Control Get Text g_hdlg, tCtl To s$
                     ctr = Val(s$) + ctr
                     If ctr > 60 Then ctr = 0
                     If ctr < 0 Then ctr = 60
                    Control Set Text g_hdlg, CB.Ctl - 2,  Right$(Str$(ctr), 2)
                 '
                 Case %Ten_Minute_Spinner, %Ten_Second_Spinner
                    tctl = CB.Ctl - 4 ' -4 to match to textboxes id's
                   Control Get Text g_hdlg, tCtl To s$
                     ctr = Val(s$) + (ctr * 5)
                     If ctr > 60 Then ctr = 0
                     If ctr < 0 Then ctr = 60
                    Control Set Text g_hdlg, CB.Ctl - 4,  Right$(Str$(ctr), 2)
               End Select
           '
           Case %WM_COMMAND  'This processes command messages
             Select Case CbCtl
               Case %Id_Exit_Btn
                 Select Case CbCtlMsg
                    Case 0
                      Dialog End CbHndl 'Applikation beenden
                 End Select
           '
           Case %Start_Timer_Btn
              g_Start_Stop_Flag = 0
              Thread Create WorkerThread(0)  To h_Thread
              Thread Close h_thread To dwres
               CSet g_Title$ = "Time Elapsed": Dialog Set Text g_hdlg, g_Title$
           '
           Case %Stop_Timer_Btn
              g_Start_Stop_Flag = 1
              Timer_start
               CSet g_Title$ = "Timer Stopped": Dialog Set Text g_hdlg, g_Title$
      '        WorkerThread(1)
           '
           Case %Reset_Timer_Btn
              idd = %Hours_tb: Control Set Text g_hdlg, idd, "0"
              idd = %Minutes_tb: Control Set Text g_hdlg, idd, "0"
              idd = %Seconds_tb: Control Set Text g_hdlg, idd, "0"
              Dialog Set Text g_hdlg, $Title
           '
             End Select
        End Select
      End Function
      Function PBMain
        Common_Locals
        Fonts_Setup
         Stile = Stile Or %WS_CAPTION
         Stile = Stile Or %WS_SYSMENU
         Stile = Stile Or %WS_THICKFRAME
         Stile = Stile Or %WM_HELP
         Stile = Stile Or %WS_BORDER  'doesn't do anything
        Dlg_ht = 250
        Dlg_Wd = 415
      '  Dialog Font "Consolas", 60 ' Big Unicodes
        Dialog New Pixels, g_hdlg, $Title, , , Dlg_Wd, Dlg_Ht, Stile To g_hdlg 'centered
        Row = 10
        col = 10
        Wd = 100
        Ht = 50
        Stile = %SS_RIGHT
        idd = %Hours_tb: idd1 = %Hour_Spinner: l$ = "Hours": GoSub Draw_tb
        idd = %Minutes_tb: idd1 = %Minute_Spinner: l$ = "Mins": GoSub Draw_tb
        idd = %Seconds_tb: idd1 = %Second_Spinner: l$ = "Secs": GoSub Draw_tb
        '
        Row = Row + (ht *3) + 5
        col = 20 '+(wd / 2)
        spcr = 30 'wd
         idd = %Start_Timer_Btn: l$ = "&Start": Face_color = %Green: Text_Color = %Black: GoSub Draw_Btn
         idd = %Reset_Timer_Btn: l$ = "Reset": : Face_color = %Blue: Text_Color = %White: GoSub Draw_Btn
         idd = %Stop_Timer_Btn: l$ = "Stop": : Face_color = %Red: Text_Color = %White: GoSub Draw_Btn
      '
         ht = 25
         Wd = dlg_wd - 20
         Col = 10
         Row = Dlg_ht - Ht - 2 'Just off bottom
         idd = %Id_Exit_Btn: l$ = "Abandon Ship": : Face_color = %White: Text_Color = %Blue: GoSub Draw_Btn
      '
           Dialog Show Modal g_hdlg   Call Dialog_Processor
      Exit Function
      ''''''''''''''''''''''
      Draw_Tb:
        spcr = 24
        Control Add Label, g_hdlg, idd + 1, l$ & " ", Col, Row, Wd, Ht, %SS_CENTER
         Control Set Font g_hdlg, idd + 1, Comic(24)
        Control Add TextBox, g_hdlg, idd, "OO", Col, Row + ht + 2, Wd, Ht, stile
         Control Set Font g_hdlg, idd, Consolas(60)
         Control ReDraw g_hdlg, idd               
       
        Local h1, h2, h3 As Long 
        h1 = Row + ht + (ht / 2) - 20
        h2 = Row + ht + (ht / 2) + 30
        Select Case idd1
          Case %Minute_Spinner  'draw 2 spinners
            Control Add $updown_class, g_hdlg, %Minute_Spinner, "", Col + wd + 6, h1, 24, 36, %spinner_style
            Control Add $updown_class, g_hdlg, %Ten_Minute_Spinner, "", Col + wd + 6, h2, 24, 36, %spinner_style
          Case %Second_Spinner
            Control Add $updown_class, g_hdlg, %Second_Spinner, "", Col + wd + 6, h1, 24, 36, %spinner_style
            Control Add $updown_class, g_hdlg, %Ten_Second_Spinner, "", Col + wd + 6, h2, 24, 36, %spinner_style
       
           Case Else 'draw 1 spinner
            Control Add $updown_class, g_hdlg, idd1, "", Col + wd + 6, Row + ht + (ht / 2), 24, 48, %spinner_style
        End Select 
       
        Col = Col + Wd + spcr + 10 'just past label
      Return
      Draw_Btn:
        Control Add Button, g_hdlg, idd, l$, ci1†”row, wd, ht
        Control Set Font g_hdlg, idd, Comic(14)
        #If %ButtonPlus_Loaded = 1
          z_Btn_Set_Face_Color(g_hdlg, Idd, Face_Color)
          z_Btn_Set_Text_Color(g_hdlg, Idd, Text_Color)
        #EndIf
        col = Col + wd + spcr
      Return
      End Function  'Applikation befurschtunkenspielenden
      '
      While running. Notoce the time in the Dialog Title. It updates on the task program bar when the Timer is minimized or in the background.

      Last edited by Gösta H. Lovgren-2; 21 Jul 2010, 12:18 PM.
      It's a pretty day. I hope you enjoy it.

      Gösta

      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

      Comment


      • #43
        Am resurrecting this old thread as I have a new problem. The Timer works wonderfully. Use it frequently as a reminder to do something in a particular time or something. (Setting recording time, etc for tv, as noted earlier)

        Anyway doing something else while it was in use, I happened to notice that it uses up to 50% of resources when running (Task Mgr) and next to nothing when paused. I use Timer as a timing mechanism and I suspect that's the resource hog.

        I'd like to (try to) use WM_Timer insttead of Timer but I've never been able to get my head around the concept, despite the heroic efforts of a couple of you guys in other threads.

        I'm guessing the resource hog is in here:
        Code:
         
        [color=#008080]'       ***    Power Color Coding for Power Basic Fellas (REAL MEN)   ***
        '
        '
        ' *******************************************************
        '[/color]
        [color=#0000FF]FUNCTION[/color]  Timer_Start_Up() [color=#0000FF]AS LONG[/color]
          [color=#0000FF]LOCAL[/color] Last_Sec, idd, Starting_Time, hr, Mn, sec, Time_Elapsed [color=#0000FF]AS LONG[/color]
          Starting_Time = [color=#0000FF]TIMER[/color]
        [color=#008080]'[/color]
          Disable_Buttons
        [color=#008080]'  start timing here[/color]
          [color=#0000FF]DO[/color]
           [color=#0000FF]IF[/color] g_Start_Stop_Flag = [color=#800000]1[/color] [color=#0000FF]THEN[/color]
             [color=#0000FF]EXIT LOOP[/color] [color=#008080]'sent from Stop button[/color]
           [color=#0000FF]END IF[/color]
          [color=#008080]'[/color]
            Time_Elapsed = [color=#0000FF]TIMER[/color] - Starting_Time
            hr = Time_Elapsed \ [color=#800000]3600[/color]
              Time_Elapsed -= hr * [color=#800000]3600[/color]
            mn = Time_Elapsed \ [color=#800000]60[/color]
              Time_Elapsed -= hr * [color=#800000]60[/color]
            sec = Time_Elapsed
            [color=#008080]'[/color]
            [color=#0000FF]IF[/color] sec &#60;&#62; Last_Sec [color=#0000FF]THEN[/color] [color=#008080]'only if changed, no flickering[/color]
               [color=#0000FF]CONTROL SET TEXT[/color] g_hdlg, [color=#838383]%Hours_tb[/color], [color=#0000FF]RIGHT$[/color]([color=#0000FF]STR$[/color](Hr), [color=#800000]2[/color])
               [color=#0000FF]CONTROL SET TEXT[/color] g_hdlg, [color=#838383]%Minutes_tb[/color], [color=#0000FF]RIGHT$[/color]([color=#0000FF]STR$[/color](mn), [color=#800000]2[/color])
               [color=#0000FF]CONTROL SET TEXT[/color] g_hdlg, [color=#838383]%Seconds_tb[/color], [color=#0000FF]RIGHT$[/color]([color=#0000FF]STR$[/color](sec), [color=#800000]2[/color])
               [color=#0000FF]CSET[/color] g_Title$ = [color=#0000FF]USING$[/color]([color=#106500]"Stopped at ##:##:##"[/color], hr, mn, sec)
            [color=#0000FF]END IF[/color]
         
           Last_Sec = sec
          [color=#0000FF]LOOP[/color]
        [color=#0000FF]END FUNCTION[/color]
        [color=#008080]'
        ' *******************************************************
        '[/color]

        Can anybody give me a clue (sample code to replace Timer) to get me started here?

        Thanks.

        PS run the timer here: http://www.swedesdock.com/powerbasic/Digital_Timer.exe
        Last edited by Gösta H. Lovgren-2; 8 Feb 2011, 07:37 AM.
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment


        • #44
          The thread can be suspended and resumed.
          Code:
          GLOBAL g_Start_Stop_Flag AS LONG
          FUNCTION PBMAIN
            LOCAL x AS LONG, hThread AS DWORD
            THREAD CREATE Second(x) TO hTHREAD
            ? "Exit"
            THREAD CLOSE hThread TO hThread
          END FUNCTION
          THREAD FUNCTION Second(BYVAL x AS LONG) AS LONG
            DO
              IF g_Start_Stop_Flag = 1 THEN EXIT FUNCTION
              SLEEP 1000
              BEEP 'Update
            LOOP
          END FUNCTION

          Comment


          • #45
            I'm sorry. Just not understanding what you mean here, Mike.
            It's a pretty day. I hope you enjoy it.

            Gösta

            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

            Comment


            • #46
              Suggestions:
              The dialog only needs to be updated once per second
              if the thread is not suspended. Update the hours,
              minutes and seconds from the TIME$. No globals
              or IF statements are needed. A WaitForSingleObject
              could replace the need for an elapsed time. Start
              and stop can be THREAD RESUME and THREAD SUSPEND.

              Comment


              • #47
                You can also put a CriticalSection around your update code to ensure your "Update the display" code is not interrupted by a thread switch.
                Michael Mattias
                Tal Systems (retired)
                Port Washington WI USA
                [email protected]
                http://www.talsystems.com

                Comment


                • #48
                  Originally posted by Mike Doty View Post
                  Suggestions:
                  The dialog only needs to be updated once per second
                  if the thread is not suspended.
                  It only is updated 1 per second.
                  Update the hours,
                  minutes and seconds from the TIME$.
                  I tried your suggestion, Mike, but it still takes +-50% processor time (Task Mgr). I changed all references to Timer with a function parsing Time$ (see code below).
                  ...
                  A WaitForSingleObject could replace the need for an elapsed time.
                  Not sure how to implement that. Maybe with %Wm_Timer?
                  Start
                  and stop can be THREAD RESUME and THREAD SUSPEND.
                  Not sure again what you mean here. Where would it go in code?

                  Code:
                  '  
                  '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                  '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                  Function Current_Time_in_Seconds As Long
                    Local ttl_secs, hrs, mins, secs As Long
                  '  Local tmr As Single
                  '  tmr = Timer
                    hrs = Val(Time$)
                    mins = Val(Mid$(Time$, 4))
                    secs = Val(Mid$(Time$, 7))
                    ttl_secs = hrs * 60 * 60
                    ttl_secs += mins * 60
                    ttl_secs += secs
                    Function = ttl_secs
                    '? Using$("## hours   ## minutes  ## seconds #, timer   #, ttlsecs", hrs, mins, secs, tmr, ttl_secs),, Time$ & FuncName$
                  End Function
                  '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                  '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                  '
                  Function Timer_Start_Down() As Long
                    common_locals
                    Local Time_to_Elapse As Long
                    '
                    g_Secs_to_go = Time_Left 'calculates from textboxes
                      If g_Secs_to_go = < 0 Then
                         ? "Timer not set yet", %Top, Trim$($Title)
                         Exit Function
                      End If
                    '
                    'Time_to_Elapse = Timer + g_Secs_to_go
                    Time_to_Elapse = Current_Time_in_Seconds + g_Secs_to_go
                   
                    '
                    CSet g_Title$ = "Timer At Work": Dialog Set Text g_hdlg, g_Title$
                      Disable_Buttons
                    flag = 0
                  '
                  'start loop *********************
                    Do
                     If g_Start_Stop_Flag = 1 Then 
                       Exit Loop 'sent from Stop button
                     End If  
                  '
                       g_Secs_to_go = Time_to_Elapse - Current_Time_in_Seconds 'Timer
                  '   If Timer => tmr + 1 Then 'only once a second
                     If Current_Time_in_Seconds => tmr + 1 Then 'only once a second
                        Redraw_Textboxes  'redraw tb's
                        Show_Time_in_Title                                        '100  '10
                        If g_Secs_to_go  < 61 And g_Secs_to_go  > 10 Then WinBeep 100, 50 'only in last 60 seconds
                        If g_Secs_to_go  < 11 Then 
                           WinBeep 1000, 20 'only in last 10 seconds
                        End If   
                        tmr = Current_Time_in_Seconds 'Timer
                     End If
                    Loop While g_Secs_to_go > 0
                  'done loop********************
                  '
                    Select Case g_Start_Stop_Flag
                       Case 0
                        CSet g_Title$ = "Timer Finished"
                       Case 1
                       CSet g_Title$ = "Timer Stopped by Button"
                       Case 2
                         CSet g_Title$ = "Timer Stopped by key"
                    End Select                          
                    Dialog Set Text g_hdlg, g_Title$
                  'end loop '***********************
                  '
                  trexit:
                  '  Graphic Window End
                  '  Graphic Detach
                    Redraw_Textboxes  'redraw tb's
                  '**
                    If flag + g_Start_Stop_Flag = 0 Then 'else no alarm
                       For ctr = 1 To 10
                          winbeep 2000, 1
                          Sleep 100
                       Next ctr
                       '? "Timer expired", %Top, $title
                       'SetWindowPos g_hdlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
                       Dialog Show State g_hdlg, %SW_SHOWNORMAL   'restore if minimized after seeing Rodney Hicks post
                       Control Set Focus g_hdlg, %Start_Timer_Btn      'brings to foreground
                     End If
                  '**  
                    Enable_Buttons
                  End Function
                  '
                  Michael MattiasYou can also put a CriticalSection around your update code to ensure your "Update the display" code is not interrupted by a thread switch.
                  Not sure how to implement that either or see how it could help here.

                  Thx your interest, boys.
                  Last edited by Gösta H. Lovgren-2; 8 Feb 2011, 11:49 AM.
                  It's a pretty day. I hope you enjoy it.

                  Gösta

                  JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                  LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                  Comment


                  • #49
                    If you have a dialog, why not just use SetTimer? You can always count how many ticks you've gotten and kill the timer at that point and do whatever it is you want to do when "time has expired."

                    Or, you can use a waitable timer object as demo'd here...
                    Waitable Timer Object Demo June 2005
                    .. and with that you don't even have to count - you just set the "zero hour" of the timer and when that is reached you do your thing.

                    MCM
                    Michael Mattias
                    Tal Systems (retired)
                    Port Washington WI USA
                    [email protected]
                    http://www.talsystems.com

                    Comment


                    • #50
                      Code:
                      #PBFORMS CREATED V2.01
                      GLOBAL ghDlg,ghThread AS DWORD
                       
                      #PBFORMS BEGIN INCLUDES
                      #INCLUDE ONCE "WIN32API.INC"
                      #PBFORMS END INCLUDES
                      #PBFORMS BEGIN CONSTANTS
                      %IDD_DIALOG1 =  101
                      %BTN_BUTTON1 = 1001
                      %BTN_BUTTON2 = 1002
                      %BTN_BUTTON3 = 1003
                      %BTN_SUSPEND = 1004
                      %BTN_RESUME  = 1005
                      #PBFORMS END CONSTANTS
                      #PBFORMS DECLARATIONS
                      CALLBACK FUNCTION ShowDIALOG1Proc()
                       LOCAL result AS LONG
                        SELECT CASE AS LONG CB.MSG
                          CASE %WM_INITDIALOG
                            ghDlg = CB.HNDL
                            CONTROL DISABLE CB.HNDL, %BTN_RESUME
                          CASE %WM_NCACTIVATE
                            STATIC hWndSaveFocus AS DWORD
                            IF ISFALSE CB.WPARAM THEN
                              ' Save control focus
                              hWndSaveFocus = GetFocus()
                            ELSEIF hWndSaveFocus THEN
                              ' Restore control focus
                              SetFocus(hWndSaveFocus)
                              hWndSaveFocus = 0
                            END IF
                          CASE %WM_COMMAND
                            ' Process control notifications
                            SELECT CASE AS LONG CB.CTL
                              ' /* Inserted by PB/Forms 02-08-2011 12:25:06
                              CASE %BTN_BUTTON1
                                IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                                  MSGBOX "%BTN_BUTTON1=" + FORMAT$(%BTN_BUTTON1), %MB_TASKMODAL
                                END IF
                              CASE %BTN_BUTTON2
                                IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                                  MSGBOX "%BTN_BUTTON2=" + FORMAT$(%BTN_BUTTON2), %MB_TASKMODAL
                                END IF
                              CASE %BTN_BUTTON3
                                IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                                  MSGBOX "%BTN_BUTTON3=" + FORMAT$(%BTN_BUTTON3), %MB_TASKMODAL
                                END IF
                              CASE %BTN_SUSPEND
                                IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                                  CONTROL DISABLE CB.HNDL, %BTN_SUSPEND
                                  CONTROL ENABLE  CB.HNDL, %BTN_RESUME
                                  THREAD SUSPEND ghThread TO lResult&
                                END IF
                              CASE %BTN_RESUME
                                IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                                    CONTROL DISABLE CB.HNDL, %BTN_RESUME
                                    CONTROL ENABLE CB.HNDL, %BTN_SUSPEND
                                    THREAD RESUME ghThread TO lResult&
                                END IF
                            END SELECT
                        END SELECT
                      END FUNCTION
                      FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
                        LOCAL lRslt AS LONG
                      #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
                        LOCAL hDlg  AS DWORD
                        DIALOG NEW hParent, "Basic structure (CPU under 1%)", 70, 70, 177, 49, _
                          %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
                          %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
                          %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
                          %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
                          %WS_EX_RIGHTSCROLLBAR, TO hDlg
                        CONTROL ADD BUTTON, hDlg, %BTN_BUTTON1, "Button1", 5, 5, 50, 15
                        CONTROL ADD BUTTON, hDlg, %BTN_BUTTON2, "Button2", 60, 5, 50, 15
                        CONTROL ADD BUTTON, hDlg, %BTN_BUTTON3, "Button3", 115, 5, 50, 15
                        CONTROL ADD BUTTON, hDlg, %BTN_SUSPEND, "Suspend", 5, 30, 50, 15
                        CONTROL ADD BUTTON, hDlg, %BTN_RESUME, "Resume", 115, 30, 50, 15
                      #PBFORMS END DIALOG
                        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
                      #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
                      #PBFORMS END CLEANUP
                        FUNCTION = lRslt
                      END FUNCTION
                       
                      THREAD FUNCTION Seconds(BYVAL x AS LONG) AS LONG
                        DO
                          SLEEP 1000
                          CONTROL SET TEXT ghDlg,%BTN_BUTTON1,TIME$
                          CONTROL SET TEXT ghDlg,%BTN_BUTTON2,TIME$
                          CONTROL SET TEXT ghDlg,%BTN_BUTTON3,TIME$
                        LOOP
                      END FUNCTION
                      '-------------------------------------------------- 
                      FUNCTION PBMAIN()
                        THREAD CREATE Seconds(0) TO ghThread
                        ShowDIALOG1 %HWND_DESKTOP
                        THREAD CLOSE ghThread TO ghThread
                      END FUNCTION

                      Comment


                      • #51
                        Sleep was the answer, Mike. Brilliant! I inserted a Sleep 1000 at the top of the Do Loop and it registers 0 usage in Task Mgr.

                        Good job.

                        If you have a dialog, why not just use SetTimer? You can always count how many ticks you've gotten and kill the timer at that point and do whatever it is you want to do when "time has expired."

                        Or, you can use a waitable timer object as demo'd here...
                        Waitable Timer Object Demo June 2005
                        .. and with that you don't even have to count - you just set the "zero hour" of the timer and when that is reached you do your thing.
                        I'd rather SLEEP any day. {grin}

                        Thanks guys.

                        PS: Changed it to Sleep 100 (for a more accurate timing update) and it STILL takes zero resources.
                        Last edited by Gösta H. Lovgren-2; 8 Feb 2011, 02:00 PM. Reason: Shorter nap.
                        It's a pretty day. I hope you enjoy it.

                        Gösta

                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                        Comment


                        • #52
                          >I'd rather SLEEP any day. {grin}

                          Everybody wants to go to heaven. Nobody wants to die.
                          Michael Mattias
                          Tal Systems (retired)
                          Port Washington WI USA
                          [email protected]
                          http://www.talsystems.com

                          Comment


                          • #53
                            Gosta, can you provide a compilable example? (I think I see the problem)
                            Engineer's Motto: If it aint broke take it apart and fix it

                            "If at 1st you don't succeed... call it version 1.0"

                            "Half of Programming is coding"....."The other 90% is DEBUGGING"

                            "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                            Comment


                            • #54
                              Originally posted by Michael Mattias View Post
                              >
                              Everybody wants to go to heaven. Nobody wants to die.
                              You can believe I'm in heaven now, baby. All I had to do was add a Sleep 100. That ain't dyin'. Hey, that ain't even breathin' heavy.

                              Gosta, can you provide a compilable example? (I think I see the problem)
                              Sure. Though Mike D already cured this hide there's. probably more than one way to skin this cat.

                              '
                              Code:
                              'PBWIN 9.03 - Win32Api 10/2009 - XP Pro SP3
                              '1} force on top when time is done
                              #Dim All
                              #Compile Exe
                              #Optimize SPEED
                              '#Debug Display On'off for production code
                              #Include "WIN32API.INC" '10/2009
                              #Include "COMDLG32.INC" '08/2008
                              #Include "InitCtrl.inc" '08/2008
                              '
                              '
                              ' *******************************************************
                              '
                              %ButtonPlus_Loaded = 1 'Note set to 0 if you don't have ButtonPlus, rem  Include &
                                                     '3 lines within 2 functions beginning with z_ (should be line numbers in the 80's)
                                                     ' if you still get errors
                              #If %ButtonPlus_Loaded
                                 #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
                              #EndIf
                               
                              #If Not %ButtonPlus_Loaded    'else will get extra errors from existing calls
                                 %BP_TEXT_COLOR    = 1
                                 %BP_ICON_ID       = 2
                                 %BP_ICON_WIDTH    = 3
                                 %BP_ICON_HEIGHT   = 4
                                 %BP_ICON_POS      = 5
                                 %BP_FACE_COLOR    = 6
                                 %BP_FACE_BLEND    = 7
                                 %BP_SPOT_COLOR    = 8
                                 %BP_SPOT_BLEND    = 9
                                 %BP_SPOT_WIDTH    = 10
                                 %BP_SPOT_HEIGHT   = 11
                                 %BP_SPOT_POS      = 12
                              #EndIf
                              '
                              ' *******************************************************
                              '
                              '
                              %Counting_Direction_Btn = 999
                              %Hours_tb = 1000
                              %Hour_Spinner = 1002
                              %Minutes_tb = 1010
                              %Minute_Spinner = 1012
                              %Ten_Minute_Spinner = 1014
                              %Seconds_tb = 1020
                              %Second_Spinner = 1022
                              %Ten_Second_Spinner = 1024
                              %Start_Timer_Btn = 1100
                              %Stop_Timer_Btn  = 1110
                              %Reset_Timer_Btn  = 1120
                              %Graphic_Target = 1200         
                              '
                              %Top = %MB_SYSTEMMODAL
                              '
                              %Btn_Color = &he75718
                              %Neutral_Color = &hd8e9ec
                              '
                              $Title = Space$(20) & "Timer"
                              '
                              ' *******************************************************
                              '
                                  'keep consistent style wherever used
                              %spinner_style = %WS_CHILD Or _
                                               %WS_VISIBLE 'Or _
                                               's_wrap Or _
                                              ' s_arrowkeys
                              '
                              ' *******************************************************
                              '
                                Global g_hdlg, hWin As Dword
                                Global Comic(), Consolas() As Dword
                                Global g_Counting_Direction, g_Secs_to_go, Dlg_ht, Dlg_Wd As Long 'Global in case want to use in Controls
                                Global pnmud As nm_updown Ptr     'pointer to structure used by spinner
                                Global g_Title As String * 50
                                Global g_Start_Stop_Flag, g_Button_Plus1, g_Button_Plus2, g_Button_Plus3 As Long
                              '
                              ' *******************************************************
                              '
                              '
                              #If %ButtonPlus_Loaded = 1
                              Function  z_Btn_Set_Face_Color(ddlg As Dword, dId As Long, Btn_Color As Long) As Long
                                 ButtonPlus  ddlg, dId, %BP_FACE_BLEND, 255 'true color
                                 ButtonPlus dDlg, dId, %BP_FACE_COLOR, Btn_Color ' &H008FDF8F
                              End Function
                              '
                              Function z_Btn_Set_Text_Color(ddlg As Dword, Id As Long, Btn_Color As Long) As Long
                                 ButtonPlus dDlg, Id, %BP_Text_COLOR, Btn_Color ' &H008FDF8F
                              End Function
                              #EndIf
                              '
                              Macro Common_Locals 'Macro easier than retyping and maintains coding consistency
                                Local Stile, Row, col, ht, wd, Longest,ctr, ln, ln1, i As Long
                                Local text_Color, Face_color, tctl, spcr, idd, idd1 As Long
                                Local flag, n, hrs, secs, mins, tmr, tmr1, Secs_To_Run As Long
                              '
                                Local  w, l, s, s1, s2, s3 As String
                              End Macro
                              '
                              Function Counting_Direction_is () As String
                                If g_Counting_Direction = 0 Then
                                   Function = "Counting Down"
                                  Else 
                                    Function = "Counting Up"
                                End If
                              End Function
                              '
                              Sub Fonts_Setup
                                common_locals
                                       Dim Comic(2 To 72), Consolas(2 To 72)
                                       For ctr = 2 To 72
                                         Font New "Comic Sans MS", ctr To Comic(ctr)
                                         Font New "Consolas", ctr To Consolas(ctr)
                                       Next ctr
                              End Sub
                              '
                              Macro Show_Time_in_Title
                                 s1$ = Right$(Using$("*0##", secs), 2)
                                 s2$ = Right$(Using$("*0##", mins), 2)
                                 s3$ = Right$(Using$("##", hrs), 2)'Right$(Str$(hrs) & ":", 3)  ')Using$("*0##:", hrs)
                                 If mins > 0 Then
                                    s1$ = s2$ & ":" & s1$ 'Str$(mins) & ":" & Right$(s1$, 2)
                                 End If
                                 If hrs > 0 Then
                                    s1$ = s3$ & ":" & s1$ 'Str$(hrs) & ":" & Right$(s1$, 5)
                                 End If
                                 Dialog Set Text g_hdlg, s1$'Using$("#:##", mins, secs)
                              End Macro 
                              '
                              Macro Redraw_Textboxes
                                n = g_Secs_to_go
                                hrs = n \ 3600
                                  n = n - (Hrs * 3600) 'subtract hours
                              ' ? Using$("gstg #, hrs #  n #", g_Secs_to_go, hrs, n)
                                Mins = (n  \ 60)
                              ' ? Using$("gstg #, hrs #  mins #", g_Secs_to_go, hrs, mins)
                                 Secs = n - (mins * 60)
                                idd = %Hours_tb: Control Set Text g_hdlg, idd, Right$(Str$(hrs), 2): Control ReDraw  g_hdlg, idd
                                idd = %Minutes_tb: Control Set Text g_hdlg, idd, Right$(Str$(mins), 2): Control ReDraw  g_hdlg, idd
                                idd = %Seconds_tb: Control Set Text g_hdlg, idd, Right$(Str$(Secs), 2): Control ReDraw  g_hdlg, idd
                                'control set focus g_hdlg, idd 'Attempt to keep dialog updating
                              End Macro
                              '
                              Sub Disable_Buttons
                                common_locals
                                redraw_Textboxes 'to get hrs, mins,secs
                                 idd = %Start_Timer_Btn: l$ = Using$("##:##:##", hrs, mins, secs): Face_color = %Neutral_Color: Text_Color = %Neutral_Color: GoSub Color_Btn
                                 idd = %Reset_Timer_Btn: l$ = " ": Face_color = %Neutral_Color:  Text_Color = %Neutral_Color: GoSub Color_Btn
                                 idd = %Stop_Timer_Btn : l$ = "Stop": Face_color = %Red: Text_Color = %White: GoSub Color_Btn
                                Control Enable g_hdlg, %Stop_Timer_Btn
                               Exit Sub
                              '
                              Color_Btn:
                                Control Disable g_hdlg, idd
                                Control Set Text g_hdlg, idd, l$
                                #If %ButtonPlus_Loaded = 1
                                  z_Btn_Set_Face_Color(g_hdlg, Idd, Face_Color)
                                  z_Btn_Set_Text_Color(g_hdlg, Idd, Text_Color)
                                #EndIf
                                Control ReDraw g_hdlg, idd
                              Return
                              End Sub
                              '
                              '
                              Sub Enable_Buttons
                                common_locals
                                 idd = %Start_Timer_Btn: l$ = "&Start": Face_color = %Green: Text_Color = %Black: GoSub Color_Btn
                                 idd = %Reset_Timer_Btn: l$ = "&Reset": Face_color = %Blue:  Text_Color = %White: GoSub Color_Btn
                                 idd = %Stop_Timer_Btn : l$ = "Stop": Face_color = %Neutral_Color: Text_Color = %Neutral_Color: GoSub Color_Btn
                                 idd = %Counting_Direction_Btn: l$ = Counting_Direction_is: Face_color = %White : Text_Color = %Black: GoSub Color_Btn
                                Control Disable g_hdlg, %Stop_Timer_Btn
                               Exit Sub
                              '
                              Color_Btn:
                                Control Enable g_hdlg, idd
                                Control Set Text g_hdlg, idd, l$
                                #If %ButtonPlus_Loaded = 1
                                  z_Btn_Set_Face_Color(g_hdlg, Idd, Face_Color)
                                  z_Btn_Set_Text_Color(g_hdlg, Idd, Text_Color)
                                #EndIf
                                Control ReDraw g_hdlg, idd
                              Return
                              End Sub
                              '
                              ' *******************************************************
                              '
                              Function WorkerThread(ByVal x As Long) As Long
                                If x = 0 Then Function = Timer_Start_Down()
                                If x = 1 Then Function = Timer_Start_Up()
                              End Function
                              '
                              ' *******************************************************
                              '
                              Function  Timer_Start_Up() As Long
                                Local Last_Sec, idd, Starting_Time, hr, Mn, sec, Time_Elapsed As Long
                                Starting_Time = Current_Time_in_Seconds 'Timer
                              '
                                Disable_Buttons
                              '  start timing here
                                Do  
                                 If g_Start_Stop_Flag = 1 Then 
                                   Exit Loop 'sent from Stop button
                                 End If  
                                '
                                  Time_Elapsed = Current_Time_in_Seconds - Starting_Time
                                  hr = Time_Elapsed \ 3600
                                    Time_Elapsed -= hr * 3600
                                  mn = Time_Elapsed \ 60
                                    Time_Elapsed -= hr * 60 
                                  sec = Time_Elapsed
                                  '
                                  If sec <> Last_Sec Then 'only if changed, no flickering
                                     Control Set Text g_hdlg, %Hours_tb, Right$(Str$(Hr), 2) 
                                     Control Set Text g_hdlg, %Minutes_tb, Right$(Str$(mn), 2) 
                                     Control Set Text g_hdlg, %Seconds_tb, Right$(Str$(sec), 2) 
                                     CSet g_Title$ = Using$("Stopped at ##:##:##", hr, mn, sec)
                                  End If
                                  
                                 Last_Sec = sec   
                                Loop
                              End Function
                              '
                              ' *******************************************************
                              '
                              '
                              Function Time_Left As Long
                              '  common_Locals
                                Local s As String
                                Local Secs_To_Run, hrs, mins, secs As Long 
                                Control Get Text g_hdlg, %Hours_tb To s$
                                  hrs = Val(s$)
                                  Secs_To_Run = hrs * 60 * 60
                                Control Get Text g_hdlg, %Minutes_tb To s$
                                  mins = Val(s$)
                                  Secs_To_Run += (mins * 60)
                                Control Get Text g_hdlg, %Seconds_tb To s$
                                  secs = Val(s$)
                                  Secs_To_Run += secs
                                Function = Secs_To_Run
                              End Function
                              '  
                              '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                              '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                              Function Current_Time_in_Seconds As Long
                                Local ttl_secs, hrs, mins, secs As Long
                              '  Local tmr As Single
                              '  tmr = Timer
                                hrs = Val(Time$)
                                mins = Val(Mid$(Time$, 4))
                                secs = Val(Mid$(Time$, 7))
                                ttl_secs = hrs * 60 * 60
                                ttl_secs += mins * 60
                                ttl_secs += secs
                                Function = ttl_secs
                                '? Using$("## hours   ## minutes  ## seconds #, timer   #, ttlsecs", hrs, mins, secs, tmr, ttl_secs),, Time$ & FuncName$
                              End Function
                              '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                              '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&    
                              '
                              Function Timer_Start_Down() As Long
                                common_locals
                                Local Time_to_Elapse As Long
                                '
                                g_Secs_to_go = Time_Left 'calculates from textboxes
                                  If g_Secs_to_go = < 0 Then
                                     ? "Timer not set yet", %Top, Trim$($Title)
                                     Exit Function
                                  End If
                                '
                                'Time_to_Elapse = Timer + g_Secs_to_go
                                Time_to_Elapse = Current_Time_in_Seconds + g_Secs_to_go
                                   
                                '
                                CSet g_Title$ = "Timer At Work": Dialog Set Text g_hdlg, g_Title$
                                  Disable_Buttons
                                flag = 0
                              '
                              'start loop *********************
                                Do
                                 If g_Start_Stop_Flag = 1 Then 
                                   Exit Loop 'sent from Stop button
                                 End If  
                              '             
                                  sleep 1000
                                   g_Secs_to_go = Time_to_Elapse - Current_Time_in_Seconds 'Timer
                              '   If Timer => tmr + 1 Then 'only once a second
                                 If Current_Time_in_Seconds => tmr + 1 Then 'only once a second
                                    Redraw_Textboxes  'redraw tb's
                                    Show_Time_in_Title                                        '100  '10
                                    If g_Secs_to_go  < 61 And g_Secs_to_go  > 10 Then WinBeep 100, 50 'only in last 60 seconds
                                    If g_Secs_to_go  < 11 Then 
                                       WinBeep 1000, 20 'only in last 10 seconds
                                    End If   
                                    tmr = Current_Time_in_Seconds 'Timer
                                 End If
                                Loop While g_Secs_to_go > 0
                              'done loop********************
                              '
                                Select Case g_Start_Stop_Flag
                                   Case 0
                                    CSet g_Title$ = "Timer Finished"
                                   Case 1
                                   CSet g_Title$ = "Timer Stopped by Button"
                                   Case 2
                                     CSet g_Title$ = "Timer Stopped by key"
                                End Select                          
                                Dialog Set Text g_hdlg, g_Title$
                              'end loop '***********************
                              '
                              trexit:
                              '  Graphic Window End
                              '  Graphic Detach
                                Redraw_Textboxes  'redraw tb's
                              '**
                                If flag + g_Start_Stop_Flag = 0 Then 'else no alarm
                                   For ctr = 1 To 10
                                      winbeep 2000, 1
                                      Sleep 100
                                   Next ctr
                                   '? "Timer expired", %Top, $title
                                   'SetWindowPos g_hdlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
                                   Dialog Show State g_hdlg, %SW_SHOWNORMAL   'restore if minimized after seeing Rodney Hicks post
                                   Control Set Focus g_hdlg, %Start_Timer_Btn      'brings to foreground
                                 End If
                              '**  
                                Enable_Buttons
                              End Function
                              '
                              '
                              CallBack Function Dialog_Processor
                                Common_Locals
                                Local h_thread, dwres As Dword
                                '
                                Select Case CbMsg     'This is TO determine the message TYPE
                                   '
                                   Case %WM_INITDIALOG'<- Initialiaton when the program loads
                                     Enable_Buttons
                                   '
                                   Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes
                              '
                                   Case %WM_NOTIFY: 'Spinner_Macro   'for spinners
                                      pnmud = CB.lParam       'UDT defined in WinApi
                                        If @pnmud.hdr.Code = %udn_deltapos Then  '+1 or -1
                                           ctr =  @pnmud.idelta * -1 'change sign to match arrows used
                                       End If
                                       tctl = CB.Ctl - 2 ' -2 to match to textboxes id's
                                       Select Case CB.Ctl
                                         Case %Hour_Spinner   '
                                           Control Get Text g_hdlg, tctl To s$
                                             ctr = Val(s$) + ctr
                                             If ctr > 24 Then ctr = 0
                                             If ctr < 0 Then ctr = 24
                                            Control Set Text g_hdlg, CB.Ctl - 2,  Right$(Str$(ctr), 2)
                                         '
                                         Case %Minute_Spinner, %Second_Spinner
                                           Control Get Text g_hdlg, tCtl To s$
                                             ctr = Val(s$) + ctr
                                             If ctr > 60 Then ctr = 0
                                             If ctr < 0 Then ctr = 60
                                            Control Set Text g_hdlg, CB.Ctl - 2,  Right$(Str$(ctr), 2)
                                         '
                                         Case %Ten_Minute_Spinner, %Ten_Second_Spinner
                                            tctl = CB.Ctl - 4 ' -4 to match to textboxes id's
                                           Control Get Text g_hdlg, tCtl To s$
                                             ctr = Val(s$) + (ctr * 5)
                                             If ctr > 60 Then ctr = 0
                                             If ctr < 0 Then ctr = 60
                                            Control Set Text g_hdlg, CB.Ctl - 4,  Right$(Str$(ctr), 2)
                                       End Select
                                   '
                                   Case %WM_COMMAND  'This processes command messages
                                     Select Case CbCtl
                                       Case %Counting_Direction_Btn
                                         Select Case CbCtlMsg
                                            Case 0      
                                              g_Counting_Direction = g_Counting_Direction Xor 1
                                              idd = %Counting_Direction_Btn: Control Set Text g_hdlg, idd, Counting_Direction_is
                                         End Select
                                   '
                                   Case %Start_Timer_Btn
                                      g_Start_Stop_Flag = 0
                                      Thread Create WorkerThread(g_Counting_Direction)  To h_Thread
                                      Thread Close h_thread To dwres
                                       CSet g_Title$ = "Time Elapsed": Dialog Set Text g_hdlg, g_Title$
                                   '
                                   Case %Stop_Timer_Btn
                                      g_Start_Stop_Flag = 1
                                      If g_Counting_Direction = 0 then
                                        Timer_Start_Down
                                       CSet g_Title$ = "Timer Stopped": Dialog Set Text g_hdlg, g_Title$
                                      End If       
                              '
                                      If g_Counting_Direction = 1 Then
                                        Enable_Buttons
                                        Reset g_Secs_to_go
                                        Redraw_Textboxes
                                        Dialog Set Text g_hdlg, g_Title$
                                      End If       
                                      
                                      
                              '        WorkerThread(1)
                                   '
                                   Case %Reset_Timer_Btn
                                      idd = %Hours_tb: Control Set Text g_hdlg, idd, "0"
                                      idd = %Minutes_tb: Control Set Text g_hdlg, idd, "0"
                                      idd = %Seconds_tb: Control Set Text g_hdlg, idd, "0"
                                      Dialog Set Text g_hdlg, $Title
                                   '
                                     End Select
                                End Select
                              End Function
                              ''
                              ''
                              Function PBMain
                                
                                Common_Locals
                              '  idd = Current_Time_in_Seconds: Exit Function
                                Fonts_Setup
                                 Stile = Stile Or %WS_CAPTION
                                 Stile = Stile Or %WS_SYSMENU
                                 Stile = Stile Or %WS_THICKFRAME
                                 Stile = Stile Or %WM_HELP
                                 Stile = Stile Or %WS_BORDER  'doesn't do anything
                                Dlg_ht = 250
                                Dlg_Wd = 415
                              '  Dialog Font "Consolas", 60 ' Big Unicodes
                                Dialog New Pixels, g_hdlg, $Title, , , Dlg_Wd, Dlg_Ht, Stile To g_hdlg 'centered
                                Row = 10
                                col = 10
                                Wd = 100
                                Ht = 50
                                Stile = %SS_RIGHT
                                idd = %Hours_tb: idd1 = %Hour_Spinner: l$ = "Hours": GoSub Draw_tb
                                idd = %Minutes_tb: idd1 = %Minute_Spinner: l$ = "Mins": GoSub Draw_tb
                                idd = %Seconds_tb: idd1 = %Second_Spinner: l$ = "Secs": GoSub Draw_tb
                                '
                                Row = Row + (ht *3) + 5
                                col = 20 '+(wd / 2)
                                spcr = 30 'wd
                                 idd = %Start_Timer_Btn: l$ = "&Start": Face_color = %Green: Text_Color = %Black: GoSub Draw_Btn
                                 idd = %Reset_Timer_Btn: l$ = "Reset": : Face_color = %Blue: Text_Color = %White: GoSub Draw_Btn
                                 idd = %Stop_Timer_Btn: l$ = "Down" : Face_color = %Red: Text_Color = %White: GoSub Draw_Btn
                              '
                                 ht = 25
                                 Wd = dlg_wd - 20
                                 Col = 10
                                 Row = Dlg_ht - Ht - 2 'Just off bottom
                                 idd = %Counting_Direction_Btn: l$ = Counting_Direction_Is: : Face_color = %White: Text_Color = %Blue: GoSub Draw_Btn
                              '
                                   Dialog Show Modal g_hdlg   Call Dialog_Processor
                              Exit Function
                              ''''''''''''''''''''''
                              Draw_Tb:
                                spcr = 24
                                Control Add Label, g_hdlg, idd + 1, l$ & " ", Col, Row, Wd, Ht, %SS_CENTER
                                 Control Set Font g_hdlg, idd + 1, Comic(24)
                                Control Add TextBox, g_hdlg, idd, "OO", Col, Row + ht + 2, Wd, Ht, stile
                                 Control Set Font g_hdlg, idd, Consolas(60)
                                 Control ReDraw g_hdlg, idd               
                                
                                Local h1, h2, h3 As Long 
                                h1 = Row + ht + (ht / 2) - 20
                                h2 = Row + ht + (ht / 2) + 30
                                Select Case idd1
                                  Case %Minute_Spinner  'draw 2 spinners
                                    Control Add $updown_class, g_hdlg, %Minute_Spinner, "", Col + wd + 6, h1, 24, 36, %spinner_style
                                    Control Add $updown_class, g_hdlg, %Ten_Minute_Spinner, "", Col + wd + 6, h2, 24, 36, %spinner_style
                                  Case %Second_Spinner
                                    Control Add $updown_class, g_hdlg, %Second_Spinner, "", Col + wd + 6, h1, 24, 36, %spinner_style
                                    Control Add $updown_class, g_hdlg, %Ten_Second_Spinner, "", Col + wd + 6, h2, 24, 36, %spinner_style
                                   
                                   Case Else 'draw 1 spinner
                                    Control Add $updown_class, g_hdlg, idd1, "", Col + wd + 6, Row + ht + (ht / 2), 24, 48, %spinner_style
                                End Select 
                                  
                                Col = Col + Wd + spcr + 10 'just past label
                              Return
                              Draw_Btn:
                                Control Add Button, g_hdlg, idd, l$, col, row, wd, ht
                                Control Set Font g_hdlg, idd, Comic(14)
                                #If %ButtonPlus_Loaded = 1
                                  z_Btn_Set_Face_Color(g_hdlg, Idd, Face_Color)
                                  z_Btn_Set_Text_Color(g_hdlg, Idd, Text_Color)
                                #EndIf
                                col = Col + wd + spcr
                              Return
                              End Function  'Applikation befurschtunkenspielenden
                              '
                              It's a pretty day. I hope you enjoy it.

                              Gösta

                              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                              Comment

                              Working...
                              X