Go Back   Access World Forums > Microsoft Access Reference > Code Repository

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 10-04-2018, 12:15 PM   #1
Insane_ai
Newly Registered User
 
Join Date: Mar 2009
Location: Cleveland, OH USA
Posts: 219
Thanks: 12
Thanked 22 Times in 19 Posts
Insane_ai is on a distinguished road
Strobe Effect - VBA

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

__________________
I actually know a few things, just not all of them.


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Insane_ai is offline   Reply With Quote
The Following User Says Thank You to Insane_ai For This Useful Post:
Guus2005 (10-05-2018)
Old 10-04-2018, 12:48 PM   #2
isladogs
Part time moderator
 
isladogs's Avatar
 
Join Date: Jan 2017
Location: Somerset, UK
Posts: 6,587
Thanks: 89
Thanked 1,619 Times in 1,508 Posts
isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice
Re: Strobe Effect - VBA

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.
__________________
If this answer has helped, please click the Thanks button and/or click the 'reputation scales' symbol on the left.

Web links:
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.


Colin
Previously known as ridders : Access 2010 32-bit, Access 2016 32-bit & 64-bit, SQL Server Express 2014, Windows 10,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
isladogs is offline   Reply With Quote
Old 10-04-2018, 01:58 PM   #3
Insane_ai
Newly Registered User
 
Join Date: Mar 2009
Location: Cleveland, OH USA
Posts: 219
Thanks: 12
Thanked 22 Times in 19 Posts
Insane_ai is on a distinguished road
Re: Strobe Effect - VBA

Challenge Accepted.

I had to find a color chooser and integrate it
https://stackoverflow.com/questions/...al-basic-6-vb6



Here's a basic interface to make it happen. Open the form and play.
Attached Files
File Type: zip Strobe Example.zip (597.7 KB, 12 views)

__________________
I actually know a few things, just not all of them.


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Insane_ai is offline   Reply With Quote
Old 10-04-2018, 03:19 PM   #4
isladogs
Part time moderator
 
isladogs's Avatar
 
Join Date: Jan 2017
Location: Somerset, UK
Posts: 6,587
Thanks: 89
Thanked 1,619 Times in 1,508 Posts
isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice
Re: Strobe Effect - VBA

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/Fo...orum=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
Attached Files
File Type: zip ColourConverter.zip (55.6 KB, 7 views)
File Type: zip Strobe Example ACCDB.zip (522.7 KB, 10 views)
__________________
If this answer has helped, please click the Thanks button and/or click the 'reputation scales' symbol on the left.

Web links:
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.


Colin
Previously known as ridders : Access 2010 32-bit, Access 2016 32-bit & 64-bit, SQL Server Express 2014, Windows 10,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.

Last edited by isladogs; 10-04-2018 at 03:51 PM.
isladogs is offline   Reply With Quote
The Following User Says Thank You to isladogs For This Useful Post:
Insane_ai (10-05-2018)
Old 10-04-2018, 03:38 PM   #5
Insane_ai
Newly Registered User
 
Join Date: Mar 2009
Location: Cleveland, OH USA
Posts: 219
Thanks: 12
Thanked 22 Times in 19 Posts
Insane_ai is on a distinguished road
Re: Strobe Effect - VBA

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
__________________
I actually know a few things, just not all of them.


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Insane_ai is offline   Reply With Quote
Old 10-04-2018, 04:01 PM   #6
isladogs
Part time moderator
 
isladogs's Avatar
 
Join Date: Jan 2017
Location: Somerset, UK
Posts: 6,587
Thanks: 89
Thanked 1,619 Times in 1,508 Posts
isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice
Re: Strobe Effect - VBA

Ah I see!
It works in A2010 as well
Perhaps a good idea to state that you need to double click on the form....!
__________________
If this answer has helped, please click the Thanks button and/or click the 'reputation scales' symbol on the left.

Web links:
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.


Colin
Previously known as ridders : Access 2010 32-bit, Access 2016 32-bit & 64-bit, SQL Server Express 2014, Windows 10,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
isladogs is offline   Reply With Quote
The Following User Says Thank You to isladogs For This Useful Post:
Insane_ai (10-05-2018)
Old 10-05-2018, 01:03 AM   #7
Guus2005
AWF VIP
 
Guus2005's Avatar
 
Join Date: Jun 2007
Location: The Netherlands
Posts: 2,490
Thanks: 44
Thanked 79 Times in 75 Posts
Guus2005 has a spectacular aura about Guus2005 has a spectacular aura about Guus2005 has a spectacular aura about
Re: Strobe Effect - VBA

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 is offline   Reply With Quote
The Following User Says Thank You to Guus2005 For This Useful Post:
Insane_ai (10-05-2018)
Old 10-05-2018, 01:05 PM   #8
Insane_ai
Newly Registered User
 
Join Date: Mar 2009
Location: Cleveland, OH USA
Posts: 219
Thanks: 12
Thanked 22 Times in 19 Posts
Insane_ai is on a distinguished road
Re: Strobe Effect - VBA

@Guus2005:
Thank you!

I didn't even know GoSub | Return existed as an option.
__________________
I actually know a few things, just not all of them.


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Insane_ai is offline   Reply With Quote
Old 10-06-2018, 05:20 AM   #9
isladogs
Part time moderator
 
isladogs's Avatar
 
Join Date: Jan 2017
Location: Somerset, UK
Posts: 6,587
Thanks: 89
Thanked 1,619 Times in 1,508 Posts
isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice isladogs is just really nice
Re: Strobe Effect - VBA

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

__________________
If this answer has helped, please click the Thanks button and/or click the 'reputation scales' symbol on the left.

Web links:
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.


Colin
Previously known as ridders : Access 2010 32-bit, Access 2016 32-bit & 64-bit, SQL Server Express 2014, Windows 10,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
,
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
isladogs is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Mouse over effect oxicottin General 8 10-25-2014 01:13 AM
Best way to effect Case Gavx Forms 4 08-31-2014 11:11 AM
Calculations Per Row Effect davies107 Forms 11 04-01-2013 11:45 PM
Me.Filter having no effect. 94Sport5sp Modules & VBA 18 11-28-2012 08:16 AM
what effect does a foreign key have? wiklendt Forms 2 03-25-2008 03:13 AM




All times are GMT -8. The time now is 04:05 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Sponsored Links

How to advertise

Media Kit


Powered by vBulletin®
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World