I needed this but couldn't find it so I created it. I am open to suggestions to improve the code.
Code:
Option Compare Database
Option Explicit
Public Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
'Developed and tested under Access 2000
'
'Author: Insane_ai, member Access World Forums
' https://www.access-programmers.co.uk/
'
'Name: StrobeControl
'
'Version: 1.0
'
'Purpose: This provides a strobing effect to catch the user's attention
' There are two flashing colors set for this function by default
'
'Special Note regarding strobe frequency:
' Epilepsy Foundation
' http://www.epilepsyfoundation.org/about/photosensitivity/
' The frequency or speed of flashing light that is most likely to cause seizures varies
' from person to person.
' Generally, flashing lights most likely to trigger seizures are between the frequency
' of 5 to 30 flashes per second (Hertz).
' To reduce the likelihood of the strobe light triggering a seizure, the Epilepsy
' Foundation?s professional advisory board recommends that
' the flash rate be kept to under 2 Hertz with breaks every so often between flashes
'
'How to use:
' Basic (Minimal examples):
' 1. Use the fully qualified reference to the form and control
' 2. Define the length of the strobe effect in seconds.
' Example 1: Call Strobe(Forms!WebOrders.txtUnitCost, 6)
' Example 2: Call Strobe(Forms!WebOrders.WebOrderItemsSub.Form.UnitCost,5)
'
' Full usage Examples:
' 1. Use the fully qualified reference to the form and control
' 2. Define the length of the strobe effect in seconds.
' 3. Declare the Colors using vbColor codes or numeric colors
' Example 3: Call Strobe(Forms!WebOrders.txtUnitCost, 6, vbBlue,vbBlack)
' Example 4: Call Strobe(Forms!WebOrders.txtUnitCost,6,8421631,16711808)
'
'Limitations:
' A check to determine the type of control will be performed to determine if
' the effect can be applied.
' Excluded Objects:
' acCheckBox, acCustomControl, acLine, acOptionButton, acOptionGroup, acPageBreak,
' acSubform, acTabCtl, acPage
'
'Usage rights:
' Please feel free to use this code within your own projects whether they are
' private or commercial applications without obligation.
' This code may not be resold by itself or as part of a collection.
'
'
Public Sub Strobe(ByRef ctl As Control, intDuration As Integer, _
Optional ByVal varColor1 = vbWhite, Optional ByVal varColor2 = vbRed)
Dim intRate As Integer
Dim intOffset As Integer
Dim varOBC, varOFC
Dim i As Integer
intRate = 4 'Two Full Cycles per second
intOffset = 5 'Delay every x cycles
'Determine the type of control:
Select Case ctl.ControlType
Case acComboBox: GoTo FlashFull
Case acLabel: GoTo FlashFull
Case acListBox: GoTo FlashFull
Case acTextBox: GoTo FlashFull
Case acBoundObjectFrame: GoTo FlashBack
Case acImage: GoTo FlashBack
Case acObjectFrame: GoTo FlashBack
Case acRectangle: GoTo FlashBack
Case acCommandButton: GoTo FlashForward
Case acToggleButton: GoTo FlashForward
Case Else: 'Do Nothing
End Select
FlashFull:
varOBC = ctl.BackColor 'Capture original BackColor for later use
varOFC = ctl.ForeColor 'Capture original ForeColor for later use
For i = 1 To (intRate * intDuration)
If i Mod 2 = 0 Then 'Even
ctl.BackColor = varColor1
ctl.ForeColor = varColor2
ctl.Parent.Repaint
Else
ctl.BackColor = varColor2
ctl.ForeColor = varColor1
ctl.Parent.Repaint
End If
If i Mod intOffset = 0 Then
Sleep ((1000 / intRate) + ((1000 / intRate) * 0.3)) ' + 30% delay
Else
Sleep (1000 / intRate)
End If
Next i
ctl.BackColor = varOBC
ctl.ForeColor = varOFC
ctl.Parent.Repaint
GoTo DoneFlashing
FlashBack:
varOBC = ctl.BackColor 'Capture original BackColor for later use
For i = 1 To (intRate * intDuration)
If i Mod 2 = 0 Then 'Even
ctl.BackColor = varColor1
ctl.Parent.Repaint
Else
ctl.BackColor = varColor2
ctl.Parent.Repaint
End If
If i Mod intOffset = 0 Then
Sleep ((1000 / intRate) + ((1000 / intRate) * 0.3)) ' + 30% delay
Else
Sleep (1000 / intRate)
End If
Next i
ctl.BackColor = varOBC
ctl.Parent.Repaint
GoTo DoneFlashing
FlashForward:
varOFC = ctl.ForeColor 'Capture original ForeColor for later use
For i = 1 To (intRate * intDuration)
If i Mod 2 = 0 Then 'Even
ctl.ForeColor = varColor1
ctl.Parent.Repaint
Else
ctl.ForeColor = varColor2
ctl.Parent.Repaint
End If
If i Mod intOffset = 0 Then
Sleep ((1000 / intRate) + ((1000 / intRate) * 0.3)) ' + 30% delay
Else
Sleep (1000 / intRate)
End If
Next i
ctl.ForeColor = varOFC
ctl.Parent.Repaint
GoTo DoneFlashing
DoneFlashing:
Exit Sub
End Sub