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