Tweet
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