Originally posted by Michael Mattias
View Post
Gosta, can you provide a compilable example? (I think I see the problem)
'
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
'
Leave a comment: