Strobe Effect - VBA

Status
Not open for further replies.
I

Insane_ai

Not Really an A.I.
Local time
Today, 05:37
Joined
Mar 20, 2009
Messages
264
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
 
Thanks for posting this and for informing mods by reporting your post

I have similar flashing message code as part of my Attention Seeking database. However, in my example I just toggle the message visibility on and off using a timer event.

I haven't tried the code but you seem to be swopping fore colour and back colour repeatedly. That will certainly get users' attention and perhaps irritate the hell out of your users!

Can I suggest you supply a quick demo of the effect.:D
 
I've had a quick play but not looked at the code as yet.

You didn't include a colour selector after all.
All the controls flash as intended but the app stopped responding when I tried changing the colours

As I have a colour converter app, I've attached it & also included it in the form.
It seems to work but not as smoothly as it does normally. Perhaps some clashing code?
Also a simple color selector would probably be better. See https://social.msdn.microsoft.com/Forums/office/en-US/3b95d3bf-1ecb-4c8e-a946-cd87f6194cf9/color-picker-for-access-project?forum=accessdev
This brings up the built in Access color selector BUT the output is HEX so needs to be converted to OLE before it can be used here

Also can't work out why the file is so big. Is it just the embedded image?
Will look at it properly in the next day or so
 

Attachments

Last edited:
Double click the Color 1/2 field to show the color chooser. Click the ok button in the color chooser to set it. The number will be the value and the color will become the backcolor of the color fields.


This was working for me with AC2000
 
Ah I see! :banghead:
It works in A2010 as well
Perhaps a good idea to state that you need to double click on the form....!
 
Nifty little piece of code. I like it.
What i don't like is the extensive use of goto, other than for error handling.
In the early days in GWBasic or BasicA there was some enhancement called GOSUB.
You can still use it in your VBA code:
Code: 
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: GoSub FlashFull
        Case acLabel: GoSub FlashFull
        Case acListBox: GoSub FlashFull
        Case acTextBox: GoSub FlashFull
        Case acBoundObjectFrame: GoSub FlashBack
        Case acImage: GoSub FlashBack
        Case acObjectFrame: GoSub FlashBack
        Case acRectangle: GoSub FlashBack
        Case acCommandButton: GoSub FlashForward
        Case acToggleButton: GoSub FlashForward
        Case Else: 'Do Nothing
    End Select

    Exit Sub

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
        Return

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
        Return
        
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
        Return

End Sub
I would use three separate subs. FlashFull, FlashBack and FlashForward.
But the above solution works fine.

Thanks for your contribution!
 
@Guus2005:
Thank you!

I didn't even know GoSub | Return existed as an option.
 
As Guus said, the use of GoTo is generally disapproved. It can make it difficult to follow the logic within a lengthy procedure. But I don't see any real benefit in swopping to the use of GoSub in this code. The layout remains the same

However, I agree totally about moving all of FlashForward/FlashBack/FlashFull into three separate procedures.

It would also be a good idea to group all control types with the same result in the same statement.
For example, the first four all use FlashFull so put them together
This would make the code both more concise and possibly faster
 
It also seems to work in A2013 but don't quote me on that. Thanks for the post I can think of a few areas I need to add this when a user enters an invalid value etc
 
Status
Not open for further replies.

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom