Announcement

Collapse
No announcement yet.

Timer Display

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

  • Michael Mattias
    replied
    I quit using timer because it didn't work while TCP OPEN is trying to connect...
    Of course it doesn't... no queued messages are processed until the current message has been disposed of... meaning TCP OPEN must complete before there's even a chance for WM_TIMER to be retrieved and handled.

    Started using another thread
    Of course you did.... .TCP OPEN can't be expected to complete in 1/10 second or less.



    MCM

    Leave a comment:


  • Mike Doty
    replied
    I quit using timer because it didn't work while TCP OPEN is trying to connect in my tests. Started using another thread.

    Leave a comment:


  • Michael Mattias
    replied
    The bar will not move unless you give up slices to the process. The only other way around it is to use a separate thread to run the DO/LOOP.
    OR... run the progress bar in a separate thread of execution, as demo'd here:

    Progress Bar Dialog for PB/CC programs October 24, 2002
    (Ignore the "PB/CC" in the thread title. This will work in a GUI program exactly the same way).

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Okay, playing around some more. When the prog goes in background (after 4-5 secs) it apparently tricks Windows into thinking there are TWO instances. Alt Tab is shows 2, clicking on one shows it in foreground (bright blue Title) and the other in bg (faded blue title).

    But Program Mgr only shows 1 instance. Curiouser and curiouser.

    Here's latest: http://www.swedesdock.com/powerbasic/Digital_Timer.exe

    Changed the name & button colors but otherwise the same as above.
    ===================================
    There is nothing new under the sun
    but there are lots
    of old things we don't know.
    Ambrose Bierce (1842-1914)
    ===================================

    Leave a comment:


  • Scott Slater
    replied
    Originally posted by Jeff Blakeney View Post
    DIALOG DOEVENTS is for MODELESS dialogs but Gösta's code is using a MODAL dialog which has its own message pump. I'm not sure if adding that line of code will work or not but it shouldn't, at least according to the documentation.
    I see that in the docs and that must have changed because anytime you did a loop in the code that runs under a MODAL or MODELESS windows/dialog you need to give up time slices so that the message pump can run. It doesn't just run by itself. You have to allow it to run. You can try the snippet below in place of Dialog DoEvents.

    A good example would be if you wrote your own copy file routine with a progress bar. The bar will not move unless you give up slices to the process. The only other way around it is to use a separate thread to run the DO/LOOP.

    You can use ApplyMsgYeild hDlg inside of loops to allow the message pump to get time slices.

    Code:
    Sub ApplyMsgYeild(ByVal hWnd As Dword)
       Local msg As tagMsg
    
       While PeekMessage(msg, hWnd, 0, 0, %PM_REMOVE)
          TranslateMessage msg
          DispatchMessage msg
       Wend
    End Sub

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Originally posted by Michael Mattias View Post
    >This should work now:
    Well, it don't...

    s_wrap and s_arrowKeys are not defined. I am thinking styles may be an element of the problem.
    I just did a search for them in WinApi32, ComDlg32 & Initcontrol and didn't find them. I've been using them for several years and don't know where they came from. I certainly never defined them. Nor do I know why they are accepted here if they are not defined anywhere, but they are. I do use #Dim All.

    BTW you might want to use conditional compilation...
    That's certainly less clumsy than the way I posted but it still left the BP constants to be dealt with.
    I really am trying to understand your problem. In this case you have earned some attention because you did "post allegedly failing code", in its entirety (mostly).
    I did post the entire code, just not in a form you could run easily.
    Chris HolbrookI can't get it to compile either. Just a suggestion Gösta, could you cut it down to the absolute minimum necessary to demonstrate the problem? I find that doing this often flushes the problem out BTW.
    I don't know that I could cut the code down to isolate the problem, Chris. There really isn't anything extra. Couple less textboxes, and arrow sets maybe but that's about it. I've commented out the offending stuff and this should run for you guys now. When (if) it runs, set it to say 10 seconds. The program will stop updating the Seconds TB (Title Bar fades)after about 5 secs but the program still runs (in the background presumably) as you can hear the seconds ticking as they run out.
    '
    Code:
    'PBWIN 9.02 - Win32Api 10/2009 - XP Pro SP
    '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 = 0 'Note set to 0 if you don't have ButtonPlus & rem Include
    '  #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"      
    '#If Not %ButtonPlus_Loaded    
    '   %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  
    '
    %Id_Exit_Btn = 999
    %Hours_tb = 1000
    %Hour_Spinner = 1002
    %Minutes_tb = 1010
    %Minute_Spinner = 1012
    %Seconds_tb = 1020
    %Second_Spinner = 1022
    %Start_Timer_Btn = 1100
    %Stop_Timer_Btn  = 1110
    %Reset_Timer_Btn  = 1120
    %Graphic_Target = 1200
    '
    %Top = %MB_SYSTEMMODAL
    '
    %Btn_Color = &he75718
    '
    $Title = Space$(20) & "Timer"
    '
    ' *******************************************************
    '
        'keep consistent style wherever used
    %spinner_style = %ws_child Or _  
                     %ws_visible 'Or _
                     '
    s_wrap Or _
                     '
    s_arrowkeys 
    '
    ' *******************************************************
    '
      Global hdlg As Dword                
      Global Comic(), Consolas() As Dword
      Global 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_Button_Plus1, g_Button_Plus2, g_Button_Plus3 As Long 
    '
    ' *******************************************************
    '
    '  
    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 
    ' 
    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 Secs_to_go, n, hrs, secs, mins, tmr, tmr1, Secs_To_Run As Long
    '
      Local  w, l, s 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 = Dialog Set Text hdlg, Using$("##:##:##  #, ", hrs, mins, secs, Secs_To_Run)
    ' 
    Macro Redraw_Textboxes
      n = Secs_to_go
      hrs = n \ 3600        
        n = n - (Hrs * 60)
      Mins = (n  \ 60)
       Secs = n - (mins * 60)
      idd = %Hours_tb: Control Set Text hdlg, idd, Right$(Str$(hrs), 2): Control ReDraw  hdlg, idd
      idd = %Minutes_tb: Control Set Text hdlg, idd, Right$(Str$(mins), 2): Control ReDraw  hdlg, idd
      idd = %Seconds_tb: Control Set Text hdlg, idd, Right$(Str$(Secs), 2): Control ReDraw  hdlg, idd
      'control set focus hdlg, idd 'Attempt to keep dialog updating
    End Macro
    '
    Function Time_Left As Long
      common_Locals
      idd = %Hours_tb: Control Get Text hdlg, idd To s$
       hrs = Val(s$)
       Secs_To_Run = hrs * 60 * 60
      idd = %Minutes_tb: Control Get Text hdlg, idd To s$
       mins = Val(s$)
       Secs_To_Run = Secs_To_Run + (mins * 60)
      idd = %Seconds_tb: Control Get Text hdlg, idd To s$
       secs = Val(s$)
       Secs_To_Run = Secs_To_Run + secs
       Function = Secs_To_Run
    End Function               
    ' 
    Sub Timer_Start
      common_locals
      Local hwin As Dword
      Local Time_to_Elapse As Long
      Secs_to_go = Time_Left 'calculates from textboxes
      If Secs_to_go = < 0 Then
         ? "Timer not set yet", %Top, Trim$($Title)
         Exit Sub
      End If
    '  ?Str$(Secs_to_go)
      Time_to_Elapse = Timer + 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 hdlg, g_Title$
    'start loop
      Do
         Secs_to_go = Time_to_Elapse - Timer
       '  Show_Time 'dialog header
       '  Graphic instat To n '<<< doesn't work?
       '  Graphic waitkey$ To w$
         Graphic inkey$ To w$
         n = Len(w$)
         Select Case n
           Case 0  
    '         Sleep 250 'wait awhile
           '
           Case 1 'key pressed  
             ' ? "key pressed", %top, w$ '<<< Never gets hit
               CSet g_Title$ = "Timer Stopped": Dialog Set Text hdlg, g_Title$
              Graphic Detach
              winbeep 200, 1000
              Exit Sub
           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          
          winbeep 100, 10
          tmr = Timer
       End If 
      Loop While Secs_to_go > 0 
    'end loop  
    trexit:
      Graphic Detach
      Redraw_Textboxes  'redraw tb's          
      CSet g_Title$ = "Time Elapsed": Dialog Set Text hdlg, g_Title$
      For ctr = 1 To 100
         winbeep 1000, 10
      Next ctr
    End Sub     
    '
    'D Biggs
    'Watekey:
    ' Dialog DoEvents
    ' If IsWin(hWin) = 0 Then Exit Function 
    ' Graphic waitkey$  To k$
    '   If k$ = "" Then GoTo WateKey
    '
    CallBack Function Dialog_Processor              
      Common_Locals                                           
      Select Case CbMsg     'This is TO determine the message TYPE 
         '       
         Case %WM_INITDIALOG'<- Initialiaton when the program loads 
         '
         Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
    '
         Case %wm_notify: 'Spinner_Macro   'for spinners
            pnmud = CB.lParam          
              If @pnmud.hdr.Code = 
    n_deltapos Then  '+1 or -1 
                 ctr =  @pnmud.idelta * -1 'change sign to match arrows
             End If
             tctl = CB.Ctl - 2
             Select Case CB.Ctl 
               Case %Hour_Spinner   '
                 Control Get Text hdlg, tctl To s$
                   ctr = Val(s$) + ctr                
                   If ctr > 24 Then ctr = 0
                   If ctr < 0 Then ctr = 24
                  Control Set Text hdlg, tctl,  Right$(Str$(ctr), 2)
               '
               Case %Minute_Spinner, %Second_Spinner
                 Control Get Text hdlg, tCtl To s$
                   ctr = Val(s$) + ctr                
                   If ctr > 60 Then ctr = 0
                   If ctr < 0 Then ctr = 60
                  Control Set Text hdlg, tCtl,  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
           Timer_start
         '
         Case %Stop_Timer_Btn  
         '
         Case %Reset_Timer_Btn 
            idd = %Hours_tb: Control Set Text hdlg, idd, "0"
            idd = %Minutes_tb: Control Set Text hdlg, idd, "0"
            idd = %Seconds_tb: Control Set Text hdlg, idd, "0"
            Dialog Set Text 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, hdlg, $Title, , , Dlg_Wd, Dlg_Ht, Stile To 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 hDlg   Call Dialog_Processor
    Exit Function
    Draw_Tb:
      spcr = 24
      Control Add Label, hdlg, idd + 1, l$ & " ", Col, Row, Wd, Ht, %ss_center
       Control Set Font hdlg, idd + 1, Comic(24) 
      Control Add TextBox, hdlg, idd, "OO", Col, Row + ht + 2, Wd, Ht, stile
       Control Set Font hdlg, idd, Consolas(60)
       Control ReDraw hdlg, idd
        Control Add $updown_class, Hdlg, idd1, "", Col + wd + 6, Row + ht + (ht / 2), 24, 48, %spinner_style
      Col = Col + Wd + spcr + 10 'just past label 
    Return     
    Draw_Btn:  
      Control Add Button, hdlg, idd, l$, col, row, wd, ht
      Control Set Font hdlg, idd, Comic(10)
      If %ButtonPlus_Loaded = 1 Then              
        z_Btn_Set_Face_Color(hdlg, Idd, Face_Color)
        z_Btn_Set_Text_Color(hdlg, Idd, Text_Color)
      End If
      col = Col + wd + spcr    
    Return  
    End Function  'Applikation beenden
    '
    Thanks your interest, guys. Here's the exe in all it's glory http://www.swedesdock.com/powerbasic/Timer.exe .

    ===================================
    The true measure of a man
    is how he treats someone
    who can do him absolutely no good.
    Samuel Johnson (1709 - 1784)
    ===================================
    Last edited by Gösta H. Lovgren-2; 12 Oct 2009, 08:51 PM.

    Leave a comment:


  • Michael Mattias
    replied
    If it's nothing proprietary you can email me the #INCLUDE file and I'll try it that way.

    Or even it it is, I'll destroy it when done and deny ever having seen it.

    [email protected]

    Leave a comment:


  • Chris Holbrook
    replied
    I can't get it to compile either. Just a suggestion Gösta, could you cut it down to the absolute minimum necessary to demonstrate the problem? I find that doing this often flushes the problem out BTW.

    Leave a comment:


  • Michael Mattias
    replied
    >This should work now:
    Well, it don't...
    Code:
    %ButtonPlus_Loaded = 0 'Note set to 0 if you don't have ButtonPlus & rem Include
    '  #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
    
    
        'keep consistent style wherever used
    %spinner_style = %WS_CHILD OR _
                     %WS_VISIBLE OR _
                     s_wrap OR _
                     s_arrowkeys
    s_wrap and s_arrowKeys are not defined. I am thinking styles may be an element of the problem.

    Try commenting out the #INCLUDE for the button plus file and see when it works.

    BTW you might want to use conditional compilation...
    Code:
    %ButtonPlus_Loaded = 0 
    #IF %ButtonPlusLoaded 
        #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
    #ENDIF
    Conditional compilation works with everything I've tried so far... #INCLUDE, #COMPILE, #TOOLS, DECLARE and of course, anything executable.

    I really am trying to understand your problem. In this case you have earned some attention because you did "post allegedly failing code", in its entirety (mostly).

    MCM

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Scott, Dialog DoEvents doesn't help anything. I had already tried it several times.

    Jeff, I'll try it with Threads. Don't have much experience with them though.

    Michael, regarding Grahics. I was going to that next. however it does npt explain why the Textbox Controls are not getting updated after 5 seconds.

    Regarding ButtonPlus, there are two subs beginning with z_Button that have BP constants in them that have to be remmed (3 lines altogether). This should work now:

    '
    Code:
    'PBWIN 9.02 - Win32Api 10/2009 - XP Pro SP
    '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 = 0 'Note set to 0 if you don't have ButtonPlus & rem Include
      #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"      
    #If Not %ButtonPlus_Loaded    
       %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  
     
    '
    %Id_Exit_Btn = 999
    %Hours_tb = 1000
    %Hour_Spinner = 1002
    %Minutes_tb = 1010
    %Minute_Spinner = 1012
    %Seconds_tb = 1020
    %Second_Spinner = 1022
    %Start_Timer_Btn = 1100
    %Stop_Timer_Btn  = 1110
    %Reset_Timer_Btn  = 1120
    %Graphic_Target = 1200
    '
    %Top = %MB_SYSTEMMODAL
    '
    %Btn_Color = &he75718
    '
    $Title = Space$(20) & "Timer"
    '
    ' *******************************************************
    '
        'keep consistent style wherever used
    %spinner_style = %ws_child Or _  
                     %ws_visible Or _
     
    s_wrap Or _
     
    s_arrowkeys 
    '
    ' *******************************************************
    '
      Global hdlg As Dword                
      Global Comic(), Consolas() As Dword
      Global 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_Button_Plus1, g_Button_Plus2, g_Button_Plus3 As Long 
    '
    ' *******************************************************
    '
    '  
    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 
    ' 
    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 Secs_to_go, n, hrs, secs, mins, tmr, tmr1, Secs_To_Run As Long
    '
      Local  w, l, s 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 = Dialog Set Text hdlg, Using$("##:##:##  #, ", hrs, mins, secs, Secs_To_Run)
    ' 
    Macro Redraw_Textboxes
      n = Secs_to_go
      hrs = n \ 3600        
        n = n - (Hrs * 60)
      Mins = (n  \ 60)
       Secs = n - (mins * 60)
      idd = %Hours_tb: Control Set Text hdlg, idd, Right$(Str$(hrs), 2): Control ReDraw  hdlg, idd
      idd = %Minutes_tb: Control Set Text hdlg, idd, Right$(Str$(mins), 2): Control ReDraw  hdlg, idd
      idd = %Seconds_tb: Control Set Text hdlg, idd, Right$(Str$(Secs), 2): Control ReDraw  hdlg, idd
      'control set focus hdlg, idd 'Attempt to keep dialog updating
    End Macro
    '
    Function Time_Left As Long
      common_Locals
      idd = %Hours_tb: Control Get Text hdlg, idd To s$
       hrs = Val(s$)
       Secs_To_Run = hrs * 60 * 60
      idd = %Minutes_tb: Control Get Text hdlg, idd To s$
       mins = Val(s$)
       Secs_To_Run = Secs_To_Run + (mins * 60)
      idd = %Seconds_tb: Control Get Text hdlg, idd To s$
       secs = Val(s$)
       Secs_To_Run = Secs_To_Run + secs
       Function = Secs_To_Run
    End Function               
    ' 
    Sub Timer_Start
      common_locals
      Local hwin As Dword
      Local Time_to_Elapse As Long
      Secs_to_go = Time_Left 'calculates from textboxes
      If Secs_to_go = < 0 Then
         ? "Timer not set yet", %Top, Trim$($Title)
         Exit Sub
      End If
    '  ?Str$(Secs_to_go)
      Time_to_Elapse = Timer + 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 hdlg, g_Title$
    'start loop
      Do
         Secs_to_go = Time_to_Elapse - Timer
       '  Show_Time 'dialog header
       '  Graphic instat To n '<<< doesn't work?
       '  Graphic waitkey$ To w$
         Graphic inkey$ To w$
         n = Len(w$)
         Select Case n
           Case 0  
    '         Sleep 250 'wait awhile
           '
           Case 1 'key pressed  
             ' ? "key pressed", %top, w$ '<<< Never gets hit
               CSet g_Title$ = "Timer Stopped": Dialog Set Text hdlg, g_Title$
              Graphic Detach
              winbeep 200, 1000
              Exit Sub
           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          
          winbeep 100, 10
          tmr = Timer
       End If 
      Loop While Secs_to_go > 0 
    'end loop  
    trexit:
      Graphic Detach
      Redraw_Textboxes  'redraw tb's          
      CSet g_Title$ = "Time Elapsed": Dialog Set Text hdlg, g_Title$
      For ctr = 1 To 100
         winbeep 1000, 10
      Next ctr
    End Sub     
    '
    'D Biggs
    'Watekey:
    ' Dialog DoEvents
    ' If IsWin(hWin) = 0 Then Exit Function 
    ' Graphic waitkey$  To k$
    '   If k$ = "" Then GoTo WateKey
    '
    CallBack Function Dialog_Processor              
      Common_Locals                                           
      Select Case CbMsg     'This is TO determine the message TYPE 
         '       
         Case %WM_INITDIALOG'<- Initialiaton when the program loads 
         '
         Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
    '
         Case %wm_notify: 'Spinner_Macro   'for spinners
            pnmud = CB.lParam          
              If @pnmud.hdr.Code = 
    n_deltapos Then  '+1 or -1 
                 ctr =  @pnmud.idelta * -1 'change sign to match arrows
             End If
             tctl = CB.Ctl - 2
             Select Case CB.Ctl 
               Case %Hour_Spinner   '
                 Control Get Text hdlg, tctl To s$
                   ctr = Val(s$) + ctr                
                   If ctr > 24 Then ctr = 0
                   If ctr < 0 Then ctr = 24
                  Control Set Text hdlg, tctl,  Right$(Str$(ctr), 2)
               '
               Case %Minute_Spinner, %Second_Spinner
                 Control Get Text hdlg, tCtl To s$
                   ctr = Val(s$) + ctr                
                   If ctr > 60 Then ctr = 0
                   If ctr < 0 Then ctr = 60
                  Control Set Text hdlg, tCtl,  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
           Timer_start
         '
         Case %Stop_Timer_Btn  
         '
         Case %Reset_Timer_Btn 
            idd = %Hours_tb: Control Set Text hdlg, idd, "0"
            idd = %Minutes_tb: Control Set Text hdlg, idd, "0"
            idd = %Seconds_tb: Control Set Text hdlg, idd, "0"
            Dialog Set Text 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, hdlg, $Title, , , Dlg_Wd, Dlg_Ht, Stile To 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 hDlg   Call Dialog_Processor
    Exit Function
    Draw_Tb:
      spcr = 24
      Control Add Label, hdlg, idd + 1, l$ & " ", Col, Row, Wd, Ht, %ss_center
       Control Set Font hdlg, idd + 1, Comic(24) 
      Control Add TextBox, hdlg, idd, "OO", Col, Row + ht + 2, Wd, Ht, stile
       Control Set Font hdlg, idd, Consolas(60)
       Control ReDraw hdlg, idd
        Control Add $updown_class, Hdlg, idd1, "", Col + wd + 6, Row + ht + (ht / 2), 24, 48, %spinner_style
      Col = Col + Wd + spcr + 10 'just past label 
    Return     
    Draw_Btn:  
      Control Add Button, hdlg, idd, l$, col, row, wd, ht
      Control Set Font hdlg, idd, Comic(10)
      If %ButtonPlus_Loaded = 1 Then              
        z_Btn_Set_Face_Color(hdlg, Idd, Face_Color)
        z_Btn_Set_Text_Color(hdlg, Idd, Text_Color)
      End If
      col = Col + wd + spcr    
    Return  
    End Function  'Applikation beenden
    '
    ============================================
    "A pound of pluck is worth a ton of luck."
    Garfield
    ============================================
    Last edited by Gösta H. Lovgren-2; 12 Oct 2009, 02:26 PM.

    Leave a comment:


  • Michael Mattias
    replied
    Why not CONTROL ADD GRAPHIC and SetTimer/WM_TIMER instead of GRAPHIC WINDOW (with additional thread of execution to manage)? With SS_NOTIFY style you can get clicks notifications on the graphic.

    Heck, you already have a dialog procedure. On WM_TIMER you use your GRAPHIC drawing commands to make a pretty display.

    BTW, it's just not possibile to compile that without that "button plus" file..... WAY too many "not defined" things.

    MCM
    Last edited by Michael Mattias; 12 Oct 2009, 12:45 PM.

    Leave a comment:


  • Jeff Blakeney
    replied
    DIALOG DOEVENTS is for MODELESS dialogs but Gösta's code is using a MODAL dialog which has its own message pump. I'm not sure if adding that line of code will work or not but it shouldn't, at least according to the documentation.

    The problem is the "Case %Start_Timer_Btn" in Dialog_Processor where he makes the call to Timer_start. This is a synchronous call and the Dialog_Processor code may not be allowed to run properly because the single thread of execution that program has is currently sitting in the Timer_start function waiting for the time to run out. If that call were switched to creating Timer_start as a thread, then the modal dialog could keep updating itself and the timer would keep running. It would also have the added benefit of making it so you could use the %Stop_Timer_Btn to kill the Timer_start thread early by setting a global variable or some other method.

    Leave a comment:


  • Scott Slater
    replied
    Try Adding Dialog DoEvents, no time slices are being allocated to the dialog box otherwise.

    Code:
      Do
         Secs_to_go = Time_to_Elapse - Timer
       '  Show_Time 'dialog header
       '  Graphic instat To n '<<< doesn't work?
       '  Graphic waitkey$ To w$
         Graphic inkey$ To w$
         n = Len(w$)
         Select Case n
           Case 0  
    '         Sleep 250 'wait awhile
           '
           Case 1 'key pressed  
             ' ? "key pressed", %top, w$ '<<< Never gets hit
               CSet g_Title$ = "Timer Stopped": Dialog Set Text hdlg, g_Title$
              Graphic Detach
              winbeep 200, 1000
              Exit Sub
           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          
          winbeep 100, 10
          tmr = Timer
          [COLOR="Red"]Dialog DoEvents[/COLOR] 
      End If
      Loop While Secs_to_go > 0

    Leave a comment:


  • Gösta H. Lovgren-2
    started a topic Timer Display

    Timer Display

    Been playing around with a Timer Display. Trouble is after about 5 seconds or so, it stops updating though it keeps timing. Windows puts in the background (Title bar fades) and it doesn't recognize key input anymore. Even clicking on it (which brightens the title bar) doesn't allow key input though it did before the 5 sec mark.

    '
    Code:
    'PBWIN 9.02 - Win32Api 10/2009 - XP Pro SP
    '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
    #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"      
    '
    %Id_Exit_Btn = 999
    %Hours_tb = 1000
    %Hour_Spinner = 1002
    %Minutes_tb = 1010
    %Minute_Spinner = 1012
    %Seconds_tb = 1020
    %Second_Spinner = 1022
    %Start_Timer_Btn = 1100
    %Stop_Timer_Btn  = 1110
    %Reset_Timer_Btn  = 1120
    %Graphic_Target = 1200
    '
    %Top = %MB_SYSTEMMODAL
    '
    %Btn_Color = &he75718
    '
    $Title = Space$(20) & "Timer"
    '
    ' *******************************************************
    '
        'keep consistent style wherever used
    %spinner_style = %ws_child Or _  
                     %ws_visible Or _
                     
    s_wrap Or _
                     
    s_arrowkeys 
    '
    ' *******************************************************
    '
      Global hdlg As Dword                
      Global Comic(), Consolas() As Dword
      Global 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
    '
    ' *******************************************************
    '
    '  
    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 
    ' 
    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 Secs_to_go, n, hrs, secs, mins, tmr, tmr1, Secs_To_Run As Long
    '
      Local  w, l, s 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 = Dialog Set Text hdlg, Using$("##:##:##  #, ", hrs, mins, secs, Secs_To_Run)
    ' 
    Macro Redraw_Textboxes
      n = Secs_to_go
      hrs = n \ 3600        
        n = n - (Hrs * 60)
      Mins = (n  \ 60)
       Secs = n - (mins * 60)
      idd = %Hours_tb: Control Set Text hdlg, idd, Right$(Str$(hrs), 2): Control ReDraw  hdlg, idd
      idd = %Minutes_tb: Control Set Text hdlg, idd, Right$(Str$(mins), 2): Control ReDraw  hdlg, idd
      idd = %Seconds_tb: Control Set Text hdlg, idd, Right$(Str$(Secs), 2): Control ReDraw  hdlg, idd
      'control set focus hdlg, idd 'Attempt to keep dialog updating
    End Macro
    '
    Function Time_Left As Long
      common_Locals
      idd = %Hours_tb: Control Get Text hdlg, idd To s$
       hrs = Val(s$)
       Secs_To_Run = hrs * 60 * 60
      idd = %Minutes_tb: Control Get Text hdlg, idd To s$
       mins = Val(s$)
       Secs_To_Run = Secs_To_Run + (mins * 60)
      idd = %Seconds_tb: Control Get Text hdlg, idd To s$
       secs = Val(s$)
       Secs_To_Run = Secs_To_Run + secs
       Function = Secs_To_Run
    End Function               
    ' 
    Sub Timer_Start
      common_locals
      Local hwin As Dword
      Local Time_to_Elapse As Long
      Secs_to_go = Time_Left 'calculates from textboxes
      If Secs_to_go = < 0 Then
         ? "Timer not set yet", %Top, Trim$($Title)
         Exit Sub
      End If
    '  ?Str$(Secs_to_go)
      Time_to_Elapse = Timer + 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 hdlg, g_Title$
    'start loop
      Do
         Secs_to_go = Time_to_Elapse - Timer
       '  Show_Time 'dialog header
       '  Graphic instat To n '<<< doesn't work?
       '  Graphic waitkey$ To w$
         Graphic inkey$ To w$
         n = Len(w$)
         Select Case n
           Case 0  
    '         Sleep 250 'wait awhile
           '
           Case 1 'key pressed  
             ' ? "key pressed", %top, w$ '<<< Never gets hit
               CSet g_Title$ = "Timer Stopped": Dialog Set Text hdlg, g_Title$
              Graphic Detach
              winbeep 200, 1000
              Exit Sub
           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          
          winbeep 100, 10
          tmr = Timer
       End If 
      Loop While Secs_to_go > 0 
    'end loop  
    trexit:
      Graphic Detach
      Redraw_Textboxes  'redraw tb's          
      CSet g_Title$ = "Time Elapsed": Dialog Set Text hdlg, g_Title$
      For ctr = 1 To 100
         winbeep 1000, 10
      Next ctr
    End Sub     
    '
    'D Biggs
    'Watekey:
    ' Dialog DoEvents
    ' If IsWin(hWin) = 0 Then Exit Function 
    ' Graphic waitkey$  To k$
    '   If k$ = "" Then GoTo WateKey
    '
    CallBack Function Dialog_Processor              
      Common_Locals                                           
      Select Case CbMsg     'This is TO determine the message TYPE 
         '       
         Case %WM_INITDIALOG'<- Initialiaton when the program loads 
         '
         Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
    '
         Case %wm_notify: 'Spinner_Macro   'for spinners
            pnmud = CB.lParam          
              If @pnmud.hdr.Code = 
    n_deltapos Then  '+1 or -1 
                 ctr =  @pnmud.idelta * -1 'change sign to match arrows
             End If
             tctl = CB.Ctl - 2
             Select Case CB.Ctl 
               Case %Hour_Spinner   '
                 Control Get Text hdlg, tctl To s$
                   ctr = Val(s$) + ctr                
                   If ctr > 24 Then ctr = 0
                   If ctr < 0 Then ctr = 24
                  Control Set Text hdlg, tctl,  Right$(Str$(ctr), 2)
               '
               Case %Minute_Spinner, %Second_Spinner
                 Control Get Text hdlg, tCtl To s$
                   ctr = Val(s$) + ctr                
                   If ctr > 60 Then ctr = 0
                   If ctr < 0 Then ctr = 60
                  Control Set Text hdlg, tCtl,  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
           Timer_start
         '
         Case %Stop_Timer_Btn  
         '
         Case %Reset_Timer_Btn 
            idd = %Hours_tb: Control Set Text hdlg, idd, "0"
            idd = %Minutes_tb: Control Set Text hdlg, idd, "0"
            idd = %Seconds_tb: Control Set Text hdlg, idd, "0"
            Dialog Set Text 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, hdlg, $Title, , , Dlg_Wd, Dlg_Ht, Stile To 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 hDlg   Call Dialog_Processor
    Exit Function
    Draw_Tb:
      spcr = 24
      Control Add Label, hdlg, idd + 1, l$ & " ", Col, Row, Wd, Ht, %ss_center
       Control Set Font hdlg, idd + 1, Comic(24) 
      Control Add TextBox, hdlg, idd, "OO", Col, Row + ht + 2, Wd, Ht, stile
       Control Set Font hdlg, idd, Consolas(60)
       Control ReDraw hdlg, idd
        Control Add $updown_class, Hdlg, idd1, "", Col + wd + 6, Row + ht + (ht / 2), 24, 48, %spinner_style
      Col = Col + Wd + spcr + 10 'just past label 
    Return     
    Draw_Btn:  
      Control Add Button, hdlg, idd, l$, col, row, wd, ht
      Control Set Font hdlg, idd, Comic(10)
      If %ButtonPlus_Loaded = 1 Then              
        z_Btn_Set_Face_Color(hdlg, Idd, Face_Color)
        z_Btn_Set_Text_Color(hdlg, Idd, Text_Color)
      End If
      col = Col + wd + spcr    
    Return  
    End Function  'Applikation beenden
    '
    Last edited by Gösta H. Lovgren-2; 12 Oct 2009, 11:08 AM.
Working...
X