[AccessD] need ideas

John W. Colby jcolby at colbyconsulting.com
Tue Feb 18 17:40:00 CST 2003


John,

The following code implements what you are trying to do as a class.  First I
will show the class code, then the form's code.  This is tested and
functions.  I have a test mdb which I will send to you offline.  If anyone
else wishes to see the mdb, email me and I will send it to you.

I just built a test form, dragged and dropped two option groups out.  I did
not apply any naming convention to the resulting controls so if you just do
that, build two radio buttons, with a yes and no radio button, values 1 and
2, it should just work.  If not check that the names of the radio buttons
and groups are called the same thing in your form as they are called in the
form's open event.

**********
class code
**********
'.
'.=========================================================================
'.Copyright    : © Some Developer 2003.  All rights reserved.
'.E-mail       : me at SomeCompany.com
'.=========================================================================
' DO NOT DELETE THE COMMENTS ABOVE.  All other comments in this module
' may be deleted from production code, but lines above must remain.
'--------------------------------------------------------------------------
'.Description  : Implements the instantiated class for: GroupYN
'.Written By   : John W. Colby
'.Date Created : 02/18/2003
'.Rev. History :
'.Comments     :
'.-------------------------------------------------------------------------
'.
' ADDITIONAL NOTES:
'
' BEHAVIORS:
'
'LABEL COLOR.  The label for a control is discovered and a pointer set to
the label in the control class'
'init().  Once it is found (if one exists), the label back color can be used
for informational purposes.
'I use the back color of a combo to indicate to the user that a combo is
"dbl-clickable", i.e. that
'dbl-clicking the control will open a form for editing the data behind the
combo.  Other uses are possible
'as well.
'
'In this class, we set the label's back color when a control that is part of
an option group is clicked.
'

'*+ Class constant declaration
'*- Class constant declaration

'*+ Class variables declarations
'*- Class variables declarations

'*+ custom constants declaration
'*- custom constants declaration

'*+ custom variables declarations
'
'Dimming the option group withevents tells this class
'and Visual Basic that we expect to sink events for the
'option group.
'
Private WithEvents mfra As OptionGroup
'
'Radio buttons that are part of an option group
'apparently cannot be dimensioned Withevents in a class
'so I opted to use the click event of the option group instead
'thus no Withevents in the dim statement for these controls
'
Private moptYes As Access.OptionButton
Private moptNo As Access.OptionButton
'
'We will find the label for the radio buttons and save a pointer to them
'this allows us to directly set the label back color
'
Private mlblYes As Label
Private mlblNo As Label
'
'We need to store the lable's original back color so that we can get back
there
'
Private mlngLblYesBackColor As Long
Private mlngLblNoBackColor As Long
'
'And finally, we need to store the new color that the label will turn
'when the radio button is clicked.
'
Private mlngNewYesBackColor As Long
Private mlngNewNoBackColor As Long

'*- custom variables declarations
'*+ Private Init/Terminate interface
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
    'make sure that if this class closes for any reason, it cleans up behind
itself
    Term
End Sub
'*- Private Init/Terminate interface
'*+ Public Init/Term interface
Public Sub Init(ByRef lfra As OptionGroup, _
                ByRef loptYes As Access.OptionButton, _
                ByRef loptNo As Access.OptionButton, _
                llngNewYesBackColor As Long, _
                llngNewNoBackColor As Long)
On Error GoTo Err_Init

    'Store a pointer to the option group
    Set mfra = lfra
    
    'Store a pointer to the two opt button controls
    Set moptYes = loptYes
    Set moptNo = loptNo
    
    'Store the new back colors passed in
    mlngNewYesBackColor = llngNewYesBackColor
    mlngNewNoBackColor = llngNewNoBackColor

    'Set the OnClick property of the frame so that the event will fire
    mfra.OnClick = "[Event Procedure]"

    Set mlblYes = CtlLbl(moptYes)           'Get a pointer to the label
    mlngLblYesBackColor = mlblYes.BackColor 'Save the initial back color

    Set mlblNo = CtlLbl(moptNo)             'Get a pointer to the label
    mlngLblNoBackColor = mlblNo.BackColor   'Save the initial back color

    mfra_Click
Exit_Init:
    On Error Resume Next
Exit Sub
Err_Init:
        MsgBox Err.Description, , "Error in Sub dclsCtlCbo.Init"
        Resume Exit_Init
    Resume 0    '.FOR TROUBLESHOOTING
End Sub
'CLEAN UP ALL OF THE CLASS POINTERS
Public Sub Term()
    On Error Resume Next
    'Store a pointer to the two opt box controls
    Set moptYes = Nothing
    Set moptNo = Nothing
    'and the option group
    Set mfra = Nothing
End Sub
'*- Public Init/Terminate interface
'
'This is the click event for the frame or option group control
'
'When the user clicks on the radio button in the option group
'this code will start running, because we dimmed the option group
'Withevents in this class' header.
'
Sub mfra_Click()
    Select Case mfra.Value
    Case 1
        mlblYes.BackColor = mlngNewYesBackColor
        mlblNo.BackColor = mlngLblNoBackColor
    Case 2
        mlblYes.BackColor = mlngLblYesBackColor
        mlblNo.BackColor = mlngNewNoBackColor
    End Select
End Sub
'.Comments  :
'.Parameters:
'.Sets      :
'.Returns   :
'.Created by: John W. Colby
'.Created   : 6/17/02 11:22:19 AM
'
'Finds the label that "belongs to" any given control.
'
Function CtlLbl(ctlFindLbl As Control) As Label
On Error GoTo Err_CtlLbl
Dim ctl As Control
    For Each ctl In ctlFindLbl.Controls
        If ctl.ControlType = acLabel Then
            Set CtlLbl = ctl
        End If
    Next ctl
Exit_CtlLbl:
Exit Function
Err_CtlLbl:
    Select Case Err
    Case 0      '.insert Errors you wish to ignore here
        Resume Next
    Case Else   '.All other errors will trap
        Beep
        MsgBox Err.Description, , "Error in Function Utils.CtlLbl"
        Resume Exit_CtlLbl
    End Select
    Resume 0    '.FOR TROUBLESHOOTING
End Function

**********
form code
**********

'dim two class variables
Private ldclsYesNoGrp1 As dclsYesNoGrp
Private ldclsYesNoGrp2 As dclsYesNoGrp

'set constants to the colors
Const clngGreen = 65280
Const clngRed = 255
Private Sub Form_Open(Cancel As Integer)
    'Instantiate the classes
    Set ldclsYesNoGrp1 = New dclsYesNoGrp
    Set ldclsYesNoGrp2 = New dclsYesNoGrp
    
    'Initialize the class variables, passing in a pointer to the frame,
    'the check boxes, and the color constants
    ldclsYesNoGrp1.Init Frame0, Option3, Option5, clngGreen, clngRed
    ldclsYesNoGrp2.Init Frame7, Option9, Option11, clngGreen, clngRed
End Sub
Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click

    DoCmd.Close

Exit_cmdClose_Click:
    Exit Sub

Err_cmdClose_Click:
    MsgBox Err.Description
    Resume Exit_cmdClose_Click
    
End Sub



John W. Colby
Colby Consulting
www.ColbyConsulting.com

-----Original Message-----
From: accessd-admin at databaseadvisors.com
[mailto:accessd-admin at databaseadvisors.com]On Behalf Of John Bartow
Sent: Tuesday, February 18, 2003 11:40 AM
To: AccessD
Subject: [AccessD] need ideas


I'm involved in an app where the color of the associated label for radio
buttons in a frame should change once its selected.

The frames are all the same and have radio buttons with "Yes" and "No" as
labels. They would like the NO to be red when selected and YES to be green
when selected.

I was thinking of trying a class but this seems like it would be a bit more
complicated than the text box background color changing class that we've
discussed before.

Any ideas or suggestions?

JB


_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



----------------------------------------------------
Is email taking over your day?  Manage your time with eMailBoss.  
Try it free!  http://www.eMailBoss.com
-------------- next part --------------
A non-text attachment was scrubbed...
Name: winmail.dat
Type: application/ms-tnef
Size: 5284 bytes
Desc: not available
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20030218/784a2bb6/attachment-0002.bin>


More information about the AccessD mailing list