Follow up to Transparency Forms
Renaud posted some comments to the previous post about transparency forms and made some really cool enhancements to the code, along with a note about using a class module to make it easier to use. This is how I use transparency forms in my own implementations so let's update the post to show how you can do this with a class. I've incorporated Renaud's changes to the API code which adds the following functionality:
- Disable transparency when Access is running under Remote Desktop
- Cover the entire screen or just the Access window
The class module shown here will make this easier to use by adding properties and methods that:
- Control the opacity
- Set the back color of the lightbox form
- Display the lightbox form
Here's how you can create this functionality using a class module. Incidentally, class modules are one of my favorite features in VBA. They're really great for this sort of thing.
Create the LightboxForm class
The bulk of the work is going to be done in a new class module called LightboxForm. The class will subclass the Access Form object using the WithEvents keyword so that we can handle the Form_Resize event directly in the LightboxForm class.
Declarations
Start by adding the API declarations as before. There are a few new ones this time as well: IsZoomed, GetWindowRect, and MoveWindow. Also shown here are the private data, constants, and types.
' API declarations, types, and constants
Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hWnd As Long, _
rectangle As RECT) As Long
Private Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal width As Long, _
ByVal height As Long, _
ByVal repaint As Boolean) As Long
Private Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Private Const LWA_ALPHA As Long = &H2
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_EX_LAYERED As Long = &H80000
' Access event property string
Private Const CON_EVENT_PROC As String = "[Event Procedure]"
' name of the lightbox form
Private Const CON_LIGHTBOX_FORM As String = "frmLightbox"
' Private data
Private m_sngOpacity As Single
Private m_lngBackColor As Long
Private WithEvents m_objForm As Form
Helper Routines
There is one helper routine in the class to add the event hook. Access forms, reports, and controls will not respond to events unless the event property is set to the string "[Event Procedure]". This routine sets the event property for a given form to this string.
Private Sub AddEventHook(strEventProperty As String)
m_objForm.Properties(strEventProperty) = CON_EVENT_PROC
End Sub
Properties
The LightboxForm class makes transparency a little easier and more flexible by adding properties for opacity and back color. There's also a property which determines whether Access is running under Remote Desktop.
Public Property Get OpenInRemoteDesktop() As Boolean
OpenInRemoteDesktop = (Environ$("SESSIONNAME") Like "RDP*")
End Property
Public Property Get Opacity() As Single
Opacity = m_sngOpacity
End Property
Public Property Let Opacity(sngOpacity As Single)
' make sure opacity is between 0 and 1
If (sngOpacity < 0 Or sngOpacity > 1) Then
Err.Raise vbObjectError + 513, TypeName(Me), "Invalid value for opacity"
Exit Property
End If
m_sngOpacity = sngOpacity
End Property
Public Property Get BackColor() As Long
BackColor = m_lngBackColor
End Property
Public Property Let BackColor(lngBackColor As Long)
m_lngBackColor = lngBackColor
End Property
Form Property
The Form property of the LightboxForm class is the property which binds frmLightbox to the LightboxForm class. This property ensures that the form is in the correct state by setting other properties such as ScrollBars, RecordSelectors, and NavigationButtons. It also changes the color of the Detail section to enable different colors to be used for the transparency.
Public Property Get Form() As Form
Set Form = m_objForm
End Property
Public Property Set Form(objForm As Form)
' make sure there is a valid object
If (objForm Is Nothing) Then
Err.Raise vbObjectError + 514, TypeName(Me), "Form object is Nothing"
Exit Property
End If
Set m_objForm = objForm
' hook the Resize event
AddEventHook "OnResize"
' set properties of the form
m_objForm.RecordSelectors = False
m_objForm.NavigationButtons = False
m_objForm.ScrollBars = 0 ' Neither
m_objForm.Section(acDetail).BackColor = m_lngBackColor
End Property
Show Method
The Show method in the class is used to display the frmLightbox form.
Public Sub Show()
On Error GoTo ShowErrorHandler
With DoCmd
.Echo False
.OpenForm CON_LIGHTBOX_FORM
End With
ShowExit:
DoCmd.Echo True
Exit Sub
ShowErrorHandler:
If (Err = 2501) Then
Resume ShowExit
Else
' return to the error
Resume
End If
End Sub
Resize Event
In the previous post, we used the Resize event of the form to set the opacity. Since we're handling this event from the LightboxForm class, we'll add this code here. This code also includes Renaud's updates to enable you to choose whether to cover the entire screen or just the Access window. I've modified this only slightly to maximize the lightbox form if the Access window is maximized (as determined by the IsZoomed API). If Access is not maximized, then we'll position the lightbox form to cover the Access window using the MoveWindow API.
Private Sub m_objForm_Resize()
Dim lngStyle As Long
Dim r As RECT
' disable screen updates
m_objForm.Painting = False
' If the Access window is maximized, then maximize the lightbox form.
' If the Access window is not maximized, then
' position the lightbox form so that it covers the Access window
If IsZoomed(hWndAccessApp()) Then
DoCmd.Maximize
Else
GetWindowRect Application.hWndAccessApp(), r
MoveWindow m_objForm.hWnd, r.x1, r.y1, (r.x2 - r.x1), (r.y2 - r.y1), True
End If
' get the current window style, then set transparency
lngStyle = GetWindowLong(m_objForm.hWnd, GWL_EXSTYLE)
SetWindowLong m_objForm.hWnd, GWL_EXSTYLE, lngStyle Or WS_EX_LAYERED
SetLayeredWindowAttributes m_objForm.hWnd, 0, (m_sngOpacity * 255), LWA_ALPHA
' enable screen updates
m_objForm.Painting = True
End Sub
Initialization
Lastly, there are a couple defaults we want to set in the class for opacity and back color:
Private Sub Class_Initialize()
m_sngOpacity = 1 ' initialize opacity to 100% (not transparent)
m_lngBackColor = vbBlack ' initialize back color to black
End Sub
Create supporting module
Since we're wrapping most of the functionality in a class module, we need an instance of the class. To do this, create a new standard module with the following code:
Private m_objLightbox As LightboxForm
Public Property Get LightboxForm() As LightboxForm
If (m_objLightbox Is Nothing) Then
Set m_objLightbox = New LightboxForm
End If
Set LightboxForm = m_objLightbox
End Property
To interact with the instance of the LightboxForm class, you'll use this LightboxForm property in the standard module.
Create the Lightbox form
We'll start this time by creating the lightbox form. This is the form that we'll use to display the transparency. Create a new form called frmLightbox and set the following properties:
- AutoCenter = Yes
- Popup = Yes
- BorderStyle = None
The other properties and the back color are managed in the class.
Next, add the following code to the Open event of frmLightbox. This will "bind" the form to the class by setting the Form property of the class.
Private Sub Form_Open(Cancel As Integer)
' if the form is open in a remote desktop window, then
' cancel the lightbox form effect
If (LightboxForm.OpenInRemoteDesktop) Then
Cancel = True
Exit Sub
End If
' bind the lightbox form class
Set LightboxForm.Form = Me
End Sub
Create the Login form
The last thing to do before we try this out is to create the login form. You can create a straight forward dialog form as was created in the previous post. This time however, we've modified the code in the Load and Unload events to use the LightboxForm property created in the previous step.
Create another form called frmLogin as described in the previous post. Add the following code to this form.
Private Sub Form_Load()
LightboxForm.BackColor = vbBlue
LightboxForm.Opacity = 0.5
LightboxForm.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
If (Not LightboxForm.Form Is Nothing) Then
If (CurrentProject.AllForms(LightboxForm.Form.Name).IsLoaded) Then
DoCmd.Close acForm, LightboxForm.Form.Name, acSaveNo
End If
End If
End Sub
Try it out
Try this out by opening the Login dialog. Play around with different values for the .Opacity property and .BackColor property of the class. Here's a screen shot showing a green lightbox with 50% opacity:
Many thanks to Renaud for extending the code and for a great post!
