Skip to content

Commit

Permalink
prelim3
Browse files Browse the repository at this point in the history
  • Loading branch information
DecimalTurn committed Dec 17, 2017
1 parent 72aeef0 commit 444333f
Show file tree
Hide file tree
Showing 13 changed files with 323 additions and 133 deletions.
Binary file modified Pomodoro_Timer.xlsb
Binary file not shown.
108 changes: 27 additions & 81 deletions src/Pomodoro_Timer.xlsb/API_AlwaysOnTop.bas
Original file line number Diff line number Diff line change
Expand Up @@ -20,97 +20,43 @@ End Enum
'See also: https://sysmod.wordpress.com/2016/09/03/conditional-compilation-vba-excel-macwin3264/
'For Mac declarations

#If Mac Then
#If MAC_OFFICE_VERSION >= 15 Then
#If VBA7 Then ' 64-bit Excel 2016 for Mac
Declare PtrSafe Function SetWindowPos _
Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" _
(ByVal hWnd As LongPtr, _
ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long

Declare PtrSafe Function FindWindow _
Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
#Else ' 32-bit Excel 2016 for Mac
Declare Function SetWindowPos _
Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long

Declare Function FindWindow _
Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#End If
#Else ' 32-bit Excel 2011 for Mac

Declare Function SetWindowPos _
Lib "Applications:Microsoft Office 2011:Office:MicrosoftOffice.framework:MicrosoftOffice" _

#If VBA7 Then ' Excel 2010 or later for Windows

'VBA version 7 compiler, therefore >= Office 2010
'PtrSafe means function works in 32-bit and 64-bit Office
'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office

Public Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long

Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr

#Else ' pre Excel 2010 for Windows
'VBA version 6 or earlier compiler, therefore <= Office 2007

Public Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long

Declare Function FindWindow _
Lib "Applications:Microsoft Office 2011:Office:MicrosoftOffice.framework:MicrosoftOffice" _
Alias "FindWindowA" _

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

#End If
#Else
#If VBA7 Then ' Excel 2010 or later for Windows

'VBA version 7 compiler, therefore >= Office 2010
'PtrSafe means function works in 32-bit and 64-bit Office
'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office

Public Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long

Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr

#Else ' pre Excel 2010 for Windows
'VBA version 6 or earlier compiler, therefore <= Office 2007

Public Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

#End If
#End If



35 changes: 7 additions & 28 deletions src/Pomodoro_Timer.xlsb/API_Sleep.bas
Original file line number Diff line number Diff line change
Expand Up @@ -3,35 +3,14 @@ Attribute VB_Name = "API_Sleep"

Option Explicit

#If Mac Then
#If MAC_OFFICE_VERSION >= 15 Then
#If VBA7 Then ' 64-bit Excel 2016 for Mac

Public Declare PtrSafe Sub Sleep _
Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" _
(ByVal dwMilliseconds As Long)
#Else ' 32-bit Excel 2016 for Mac

Public Declare Sub Sleep _
Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" _
(ByVal dwMilliseconds As Long)

#End If
#Else ' 32-bit Excel 2011 for Mac
Public Declare Sub Sleep _
Lib "Applications:Microsoft Office 2011:Office:MicrosoftOffice.framework:MicrosoftOffice" _
(ByVal dwMilliseconds As Long)
#End If
#Else
#If VBA7 Then ' Excel 2010 or later for Windows

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 64 Bit Systems

#Else ' pre Excel 2010 for Windows

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#If VBA7 Then ' Excel 2010 or later for Windows

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 64 Bit Systems

#Else ' pre Excel 2010 for Windows

#End If
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems

#End If


Expand Down
205 changes: 205 additions & 0 deletions src/Pomodoro_Timer.xlsb/CountDown_mac.bas
Original file line number Diff line number Diff line change
@@ -0,0 +1,205 @@
Attribute VB_Name = "CountDown_mac"
Option Explicit

Const FREQ = 1

Sub Launch_timer_mac()
'Stop the code if the form is not visible
If UFIsVisible = False Then: Debug.Print "Form is not visible. The code will now stop.": End

Dim frm As UserForm
Set frm = PomodoroTimer
Call Optimize_VBA_Performance(True)

OngoingTimer = True
StopTimer = False
CloseTimer = False
frm.CommandButton2.caption = "Cancel"

'Reset the colors
PomodoroTimer.BackColor = -2147483633
frm.TextBox2.BackColor = -2147483633
frm.tBx1.BackColor = -2147483633

StartTime = Now()
TodaysDate = Date


Dim M As Double, S As Double
Dim TotalTime
Dim EndTime As Double
Dim RemaingTime As Double

TotalTime = 60 * AllowedTime + AllowedTimeSec
EndTime = DateAdd("s", TotalTime, Now())
RemaingTime = DateDiff("s", Now(), EndTime)

RemaingTime = DateDiff("s", Now(), EndTime)
M = Int(RemaingTime / 60)
S = RemaingTime - 60 * M

With frm.tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With

'Released the control to the OS
'DoEvents

'Now "sleep"
Application.OnTime Now + TimeValue("00:00:01") * FREQ, "Launch_timer_mac2"

End Sub

Sub Launch_timer_mac2()
Dim frm As UserForm
Set frm = PomodoroTimer

Dim M As Double, S As Double
Dim TotalTime
Dim EllapsedtTime
Dim StartTime As Double
Dim EndTime As Double
Dim RemaingTime As Double

TotalTime = 60 * AllowedTime + AllowedTimeSec
' EllapsedtTime = TotalTime - (60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1))
' M = Int(EllapsedtTime / 60)
' S = EllapsedtTime - 60 * M
' EndTime = DateAdd("s", TotalTime, Now())
' StartTime = Now() - TimeValue("00:" & Format(CStr(M), "00") & ":" & Format(CStr(S), "00"))
RemaingTime = 60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1)

If RemaingTime > 0 And Not StopTimer Then
RemaingTime = RemaingTime - FREQ
M = Int(RemaingTime / 60)
S = RemaingTime - 60 * M

With frm.tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With

'Released the control to the OS
'DoEvents

'Now "sleep"
Application.OnTime Now + TimeValue("00:00:01") * FREQ, "Launch_timer_mac2"

Else

'Since we are using the "Application.ontime" technique, it is possible that some public variables will have lost their values
If TodaysDate = 0 Then TodaysDate = Date
If StartTime = 0 Then
EllapsedtTime = TotalTime - RemaingTime
M = Int(EllapsedtTime / 60)
S = EllapsedtTime - 60 * M
StartTime = Now() - TimeValue("00:" & Format(CStr(M), "00") & ":" & Format(CStr(S), "00"))
End If

'Recording session
If StopTimer = False Or ThisWorkbook.Sheets("Settings").Range("Record_unfinished").Value2 = True Then
If (TotalTime - RemaingTime) / 60 > ThisWorkbook.Sheets("Settings").Range("No_Recording_limit") Then
Call Add_new_record(TodaysDate, StartTime, Now, Not (StopTimer), Range("TaskNameRng"))
End If
End If

Call Optimize_VBA_Performance(False, xlAutomatic)

If StopTimer = False Then 'If the timer was stopped by the user
'Proceed with the Break
If ThisWorkbook.Sheets("Settings").Range("Sound_end_Pomodoro") = True Then Beep
frm.TextBox2.Value = "Break"
Call TakeBreak_mac
Else
'Do nothing
frm.CommandButton2.caption = "Start"
OngoingTimer = False
End If

If CloseTimer Then Unload frm
End If
End Sub

Private Sub TakeBreak_mac()
Dim frm As UserForm
Set frm = PomodoroTimer
'Reset StopTimer:
StopTimer = False

Call Optimize_VBA_Performance(True)

Dim M As Double, S As Double
M = BreakTime
S = BreakTimeSec

With frm.tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With

Call TakeBreak_mac2

End Sub

Private Sub TakeBreak_mac2()
Dim frm As UserForm
Set frm = PomodoroTimer
Dim M As Long, S As Long
Dim EndTime As Double
Dim RemaingTime As Double
Dim TotalTime As Long

TotalTime = 60 * BreakTime + BreakTimeSec
RemaingTime = 60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1)

If RemaingTime > 0 And Not StopTimer Then
RemaingTime = RemaingTime - FREQ
M = Int(RemaingTime / 60)
S = RemaingTime - 60 * M

'Flashing
If TotalTime - RemaingTime < 9 Then
If S Mod 2 = 1 Then
frm.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color
frm.TextBox2.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color
frm.tBx1.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color
Else
frm.BackColor = -2147483633 'Normal color
frm.TextBox2.BackColor = -2147483633 'Normal color
frm.tBx1.BackColor = -2147483633 'Normal color
End If
End If

With frm.tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With
'Released the control to the OS
'DoEvents
'Now "sleep"
Application.OnTime Now + TimeValue("00:00:01") * FREQ, "TakeBreak_mac2"

Else

If StopTimer = False Then
If ThisWorkbook.Sheets("Settings").Range("Sound_end_Break") = True Then Beep
'Remain in color to get the user's attention
frm.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color
frm.TextBox2.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color
frm.tBx1.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color
Else
frm.BackColor = -2147483633 'Normal color
frm.TextBox2.BackColor = -2147483633 'Normal color
frm.tBx1.BackColor = -2147483633 'Normal color
End If
frm.TextBox2.Value = ""
frm.CommandButton2.caption = "Start"
OngoingTimer = False

'Redo basic calculations form the initialize macro
M = Int(AllowedTime)
S = (AllowedTime - Int(AllowedTime)) * 60
With frm.tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With

Call Optimize_VBA_Performance(False, xlAutomatic)
End If
End Sub
5 changes: 3 additions & 2 deletions src/Pomodoro_Timer.xlsb/Main.bas
Original file line number Diff line number Diff line change
Expand Up @@ -13,16 +13,17 @@ Public CloseTimer As Boolean 'User clicked the X
Public OngoingTimer As Boolean 'Take the value true after the timer has started (was initialized)
Public StartTime As Variant
Public TodaysDate As Variant
Public UFIsVisible As Boolean

Sub PomodoroSession()
AllowedTime = Range("Pomodoro")
AllowedTimeSec = Range("Pomodoro_sec")
BreakTime = Range("Break")
BreakTimeSec = Range("Break_sec")
AutoLaunch = True
If Range("Run_in_seperate_instance").Value = True And Reopen_decision = True Then
If Range("Run_in_seperate_instance").Value = True And Reopen_decision = True And Not IsMac Then
MsgBox "To let you work with Excel while the timer is running, this file will now be reopen in a second instance of Excel." & vbNewLine & _
"Once, the file has been reopen, you will need to relaunch the timer."
"Once, the file has been reopened, you will need to relaunch the timer."
Call OpenItSelfInAnotherInstance
End If
ThisWorkbook.Application.WindowState = xlMinimized
Expand Down
Loading

0 comments on commit 444333f

Please sign in to comment.