Continuing on my previous article
Let us now explore taking the code we developed and create a Class Module we can use to subclass our forms with to greatly simplify our live!
Form SubClassing To Add Custom Nagiation To Any Form
Now the previous approach, using a form and putting all the code directly in it, is great, but you don’t want to have to add this code to every single form in which you wish to implement your custom navigation in!
What happens if you need to perform a change?!!!
So the best way to manage this is to create a Class Module and subclass your form(s). This way you can drop the Navigation buttons into any form and simply add 3-4 lines of code and have everything fully functional!
So how do we do that exactly?
The Class Module
Below is the complete code required for the Class Module. I named mine ‘Cls_Navigation’
Option Compare Database
Option Explicit
'Form
Private WithEvents oForm As Access.Form
'Navigation
Private oLblRecNavHeader As Access.Label
Private oOptGrpRecNav As Access.OptionGroup
'Private WithEvents oBtnRecNavDelete As Access.CommandButton
Private WithEvents oBtnRecNavNew As Access.CommandButton
Private WithEvents oBtnRecNavFirst As Access.CommandButton
Private WithEvents oBtnRecNavPrevious As Access.CommandButton
Private WithEvents oBtnRecNavNext As Access.CommandButton
Private WithEvents oBtnRecNavLast As Access.CommandButton
Private oTxtRecNavCounter As Access.TextBox
Const EventProcedure = "[Event Procedure]"
Public Property Set p_Form(ByRef oMyForm As Access.Form)
Set oForm = oMyForm
End Property
Public Sub Class_init(ByRef oMyForm As Access.Form)
Dim ctrl As Control
Dim sCtrlSrc As String
Dim sFormat As String
Dim arrRGB As Variant
Dim lForeColor As Long
Dim iR As Integer, iG As Integer, iB As Integer
Dim aRecNavBtns() As Variant
Dim i As Byte
'Const ColorScheme = "blue"
'Const ColorScheme = "green"
Const ColorScheme = "black"
Const BackStyle_Normal = 1
Const BackStyle_Transparent = 0
Const BorderStyle_Transparent = 0
Const BorderStyle_Solid = 1
' Const BorderStyle_Dashes = 2
Const SpecialEffect_Flat = 0
'Const PictureType_Embedded = 0
Const PictureType_Linked = 1
'Const PictureType_Shared = 2
' *******************************
' Form Module Variable Initializations
' **************************************************************
'Form
Set p_Form = oMyForm
'Navigation
Set oLblRecNavHeader = oForm.lbl_RecNav_Header
Set oOptGrpRecNav = oForm.optGrp_RecNav
'Set oBtnRecNavDelete = oForm.cmd_RecNav_Delete
Set oBtnRecNavNew = oForm.cmd_RecNav_New
Set oBtnRecNavFirst = oForm.cmd_RecNav_First
Set oBtnRecNavPrevious = oForm.cmd_RecNav_Previous
Set oBtnRecNavNext = oForm.cmd_RecNav_Next
Set oBtnRecNavLast = oForm.cmd_RecNav_Last
Set oTxtRecNavCounter = oForm.txt_RecNav_Counter
' *******************************
' Form Setup/Formatting
' **************************************************************
oForm.NavigationButtons = False
'Form Events
oForm.OnCurrent = EventProcedure
oForm.AfterUpdate = EventProcedure
' *******************************
' Navigation Setup/Formatting
' **************************************************************
Call OLEtoRGB(oForm.Section(oLblRecNavHeader.Section).BackColor, iR, iG, iB)
If iR + iG + iB > 330 Then
'Light color
lForeColor = vbBlack
Else
'Darker color
lForeColor = vbWhite
End If
oLblRecNavHeader.BackColor = oForm.Section(oLblRecNavHeader.Section).BackColor
oLblRecNavHeader.BackStyle = BackStyle_Normal
oLblRecNavHeader.ForeColor = lForeColor
oOptGrpRecNav.BorderStyle = BorderStyle_Solid
oOptGrpRecNav.SpecialEffect = SpecialEffect_Flat 'Critical for the BorderWidth to work!
oOptGrpRecNav.BorderWidth = 0 'under 3 and it doesn't work?!
oOptGrpRecNav.BorderColor = lForeColor
oOptGrpRecNav.BackColor = oForm.Section(oLblRecNavHeader.Section).BackColor
oOptGrpRecNav.BackStyle = BackStyle_Normal
oTxtRecNavCounter.BackStyle = BackStyle_Transparent
oTxtRecNavCounter.ForeColor = lForeColor
oTxtRecNavCounter.Enabled = False
oTxtRecNavCounter.Locked = True
With oBtnRecNavNew
'oBtnRecNavDelete.Top = .Top
oBtnRecNavFirst.Top = .Top
oBtnRecNavPrevious.Top = .Top
oBtnRecNavNext.Top = .Top
oBtnRecNavLast.Top = .Top
End With
'Change the navigation button captions ...
'aRecNavBtns = Array(oBtnRecNavDelete, oBtnRecNavNew, oBtnRecNavFirst, oBtnRecNavPrevious, oBtnRecNavNext, oBtnRecNavLast)
aRecNavBtns = Array(oBtnRecNavNew, oBtnRecNavFirst, oBtnRecNavPrevious, oBtnRecNavNext, oBtnRecNavLast)
'For i = 0 To 5
For i = 0 To 4
aRecNavBtns(i).OnClick = EventProcedure
aRecNavBtns(i).BackStyle = BackStyle_Transparent
aRecNavBtns(i).CursorOnHover = acCursorOnHoverHyperlinkHand
aRecNavBtns(i).PictureType = PictureType_Linked 'To avoid bloating!
Next
'oBtnRecNavDelete.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\delete.png"
'oBtnRecNavDelete.ControlTipText = "Delete the current record"
oBtnRecNavNew.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\new.png"
oBtnRecNavNew.ControlTipText = "Create a new record"
oBtnRecNavFirst.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\first.png"
oBtnRecNavFirst.ControlTipText = "Goto the 1st record"
oBtnRecNavPrevious.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\previous.png"
oBtnRecNavPrevious.ControlTipText = "Go back to the previous record"
oBtnRecNavNext.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\next.png"
oBtnRecNavNext.ControlTipText = "Go forward to the next record"
oBtnRecNavLast.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\last.png"
oBtnRecNavLast.ControlTipText = "Goto the last record"
End Sub
Private Sub Class_Terminate()
Set oForm = Nothing
End Sub
' *******************************
' Form Events
' **************************************************************
Private Sub oForm_AfterUpdate()
Call SetupNav
End Sub
Private Sub oForm_Current()
Call SetupNav
End Sub
' *******************************
' Control Events
' **************************************************************
Private Sub oBtnRecNavDelete_Click()
If MsgBox("Are you sure you want to delete this record?" & vbCrLf & _
"This will permanently delete the record.", vbYesNo, "Delete Confirmation") = vbYes Then
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdDeleteRecord
DoCmd.SetWarnings True
End If
End Sub
Private Sub oBtnRecNavNew_Click()
RunCommand acCmdRecordsGoToNew
End Sub
Private Sub oBtnRecNavPrevious_Click()
RunCommand acCmdRecordsGoToPrevious
End Sub
Private Sub oBtnRecNavNext_Click()
RunCommand acCmdRecordsGoToNext
End Sub
Private Sub oBtnRecNavLast_Click()
RunCommand acCmdRecordsGoToLast
End Sub
Private Sub oBtnRecNavFirst_Click()
RunCommand acCmdRecordsGoToFirst
End Sub
' *******************************
' General Helper Procs
' **************************************************************
Public Sub SetupNav()
Dim rs As DAO.Recordset
Dim lCurrentRecord As Long
Dim lRecordCount As Long
lCurrentRecord = oForm.CurrentRecord
Set rs = oForm.RecordsetClone
rs.MoveLast
lRecordCount = rs.RecordCount
'Hide all the buttons
'oBtnRecNavDelete.Enabled = False
oBtnRecNavNew.Enabled = False
oBtnRecNavFirst.Enabled = False
oBtnRecNavPrevious.Enabled = False
oBtnRecNavNext.Enabled = False
oBtnRecNavLast.Enabled = False
'Show button depending on the case
If lCurrentRecord > lRecordCount Then
'On a new entry
If lRecordCount <> 0 Then
'There are other records available (so not the 1st entry)
oBtnRecNavFirst.Enabled = True
oBtnRecNavPrevious.Enabled = True
oBtnRecNavLast.Enabled = True
End If
ElseIf lCurrentRecord = lRecordCount Then
'On the last available record
'oBtnRecNavDelete.Enabled = (oForm.AllowDeletions And oForm.RecordsetType <> 2)
oBtnRecNavNew.Enabled = (oForm.AllowAdditions And oForm.RecordsetType <> 2)
If oForm.RecordsetClone.RecordCount > 1 Then
oBtnRecNavFirst.Enabled = True
oBtnRecNavPrevious.Enabled = True
End If
ElseIf lCurrentRecord = 1 And lRecordCount > 1 Then
'On the 1st record and there are multiple records for the form
'oBtnRecNavDelete.Enabled = (oForm.AllowDeletions And oForm.RecordsetType <> 2)
oBtnRecNavNew.Enabled = (oForm.AllowAdditions And oForm.RecordsetType <> 2)
oBtnRecNavNext.Enabled = True
oBtnRecNavLast.Enabled = True
Else
'oBtnRecNavDelete.Enabled = (oForm.AllowDeletions And oForm.RecordsetType <> 2)
oBtnRecNavNew.Enabled = (oForm.AllowAdditions And oForm.RecordsetType <> 2)
oBtnRecNavFirst.Enabled = True
oBtnRecNavPrevious.Enabled = True
oBtnRecNavNext.Enabled = True
oBtnRecNavLast.Enabled = True
End If
'Update record counter control
oTxtRecNavCounter.ControlSource = "=""Record " & lCurrentRecord & " Of " & lRecordCount & """"
Set rs = Nothing
End Sub
In the code you will notice several commented out lines relating to ‘oBtnRecNavDelete’, that is in case you wish to add a ‘Delete’ button to your Custom Navigation. this way the code is already available for you to exploit by simply uncommenting those lines.
Code Rundown
We start by declaring Module level variables representing the form and each of the navigation components.
Next we create a property to be able to set our module level form variable so we have to work with throughout the rest of our module.
Then, we build our initialization procedure that we call from our form to do all the setup. In it, we set all the variables. Assign ‘Event Procedure’ to the various required form events. After, I apply formatting to all the Navigation components, setting color, background styles, font colors, … Then, we assign ‘Event Procedure’ to each button so the to will run code when clicked. Lastly, I assign an image and Tip Text to each button.
We then create a Class Terminate event to perform any necessary cleanup when the class is terminated.
After that, we create the actual form events followed by each of the control events.
And to wrap things up, we create the Procedure called in the Form Events to update the button statuses and text displayed.
In the above example, I am populating each command button with an image by doing:
oBtnRecNavNew.Picture = Application.CurrentProject.Path & "\icons\" & ColorScheme & "\new.png"
where I’ve create an ‘icons’ sub-directory with a series of theme sub-directories. As such, I can (or the user because it can be a user setting if so desired), switch the value of the ‘ColorScheme’ variable to instantaneously change the buttons used for the entire navigation system.
Form Code
Below is the required Form code to instantiate the Class to Sub Class the form.
Option Compare Database
Option Explicit
Private listener As New Cls_Navigation
Private Sub Form_Close()
Set listener = Nothing
End Sub
Private Sub Form_Open(Cancel As Integer)
Call listener.Class_init(Me)
End Sub
As we’ve seen in my previous articles regarding sub classing, we only need to use the Open event to initialize the Class and then use the Close event to clean things up when we close the form, everything else is done via the Class Module.
Implementation
So now, once we have our Class Module in place, you need only copy over the various controls that comprise your navigation system and add the ‘Form Code’ to your form and you’re done! Now 7 lines of code provide you the full functionality that previously took hundreds of lines and you benefit from a single code base for updating things moving forward!
Per the usual, I’d highly encourage you to add proper error handling throughout the code. It is omitted here to keep the code simplified, but should always be included for production.
Demo Database
Feel free to download a 100% unlocked copy of the sample database (tested on Win10/Acc365 & Win10/Acc2013). This sample provides multiple variations to illustrate textual button, button using symbols or images. I provide both the standard implementation and the Sub Classing of forms.
Download “Custom Navigation Buttons” Form_SubClassing-Navigation.zip – Downloaded 7589 times – 257.40 KBNotice About Content/Downloads/Demos
Disclaimer/Notes:
If you do not have Microsoft Access, simply download and install the freely available runtime version (this permits running MS Access databases, but not modifying their design):Microsoft Access 2010 Runtime
Microsoft Access 2013 Runtime
Microsoft Access 2016 Runtime
Microsoft 365 Access Runtime
In no event will Devhut.net or CARDA Consultants Inc. be liable to the client/end-user or any third party for any damages, including any lost profits, lost savings or other incidental, consequential or special damages arising out of the operation of or inability to operate the software which CARDA Consultants Inc. has provided, even if CARDA Consultants Inc. has been advised of the possibility of such damages.
What Else Can We Do?
In my sample, I’m displaying images, but you can choose to display text or symbols instead. I chose to illustrate the most complex case for educational purposes.
Another great thing to do with Class Modules and such subclassing techniques is apply security routines and/or dynamic translations (if you are doing so at runtime).
Page History
| Date | Summary of Changes |
|---|---|
| 2024-02-29 | Initial Release |
