BoundValue timing problem - Xtreme Visual Basic Talk

11-18-2005, 08:45 AM

patfinegan patfinegan is offline

Regular

Join Date: Dec 2003

Location: NYC

Posts: 73

BoundValue timing problem

I've encountered what I believe is a timing problem with the BoundValue property and I'm looking for a workaround.

The first set of code will keep a checkbox at its pre-assigned value, but the second and third will not, and the fourth works only some of the time and requires a goofy wait state.

Code:

Private Sub CheckBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    MsgBox Me.CheckBox1.BoundValue
    Me.CheckBox1.Value = Me.CheckBox1.BoundValue
End Sub

Code:

Private Sub CheckBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Me.CheckBox1.Value = Me.CheckBox1.BoundValue
End Sub

Code:

Private Sub CheckBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Dim v As Variant
    v = Me.CheckBox1.BoundValue
    DoEvents
    Me.CheckBox1.Value = v
End Sub

Code:

Private Sub CheckBox2_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Dim v As Variant
    v = Me.CheckBox2.BoundValue
    Application.Wait Now() + 1 / 60 / 60 / 24
    Me.CheckBox2.Value = v
End Sub

Anyone know how I can get the consistent intended results of the first example without using a message box or other code-halting device.

I need this because I use the MouseDown event to route context-sensitive help calls. See http://www.xtremevbtalk.com/showthread.php?t=244766. Thanks in advance.

11-18-2005, 02:26 PM

herilane

Unashamed geek

Retired Moderator
* Expert *

Join Date: Jul 2003

Location: London, England

Posts: 8,988

I tried this:

Code:

Private Sub CheckBox1_Click()
    Debug.Print "Click: " & Me.CheckBox1.BoundValue
End Sub

Private Sub CheckBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'MsgBox ""
    Debug.Print "Down: " & Me.CheckBox1.BoundValue
End Sub

Private Sub CheckBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Debug.Print "Up: " & Me.CheckBox1.BoundValue
End Sub

Results, without MsgBox:

Code:

Down: False
Up: False
Click: True

Results, with MsgBox:

Code:

Down: False

So the MsgBox interrupts the normal flow of events and the Click event, which is where the value normally gets changed, doesn't fire. Which means that if you have a MsgBox you don't even need to set Value to BoundValue.

One possible solution could be to set a boolean flag in MouseDown. Then in Click check for the flag; if the flag is set, toggle the value (.Value = Not .Value). There will be a little bit of flicker, but it shouldn't be too bad.

11-18-2005, 04:19 PM

patfinegan patfinegan is offline

Regular

Join Date: Dec 2003

Location: NYC

Posts: 73

Thanks for figuring that out. It was driving me crazy.

The good news is that the Change event also occurs after the MouseDown event so I can limit the "post-audit" to those clicks that actually changed a control's value.

CheckBox and ListBox example (part of a context-sensitive help routine -- I put the relevant stuff on top):

Code:

Option Explicit

Private b As Boolean           'flags whether MouseDown/Help event occurred
Private lbVal() As Boolean     'temp list box values
Private v As Variant           'temp scalar values (all other controls)

Private Sub CheckBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    'Call context-sensitive help if appropriate.
    b = CONTEXT_HELP(Me.CheckBox1, Button)
End Sub

Private Sub ListBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    'Call context-sensitive help if appropriate.
    b = CONTEXT_HELP(Me.ListBox1, Button)
End Sub

Private Sub CheckBox1_Change()
    'Restore previous value if changed by Help/MouseDown event.
    If Not IsEmpty(v) Then
        Me.CheckBox1.Value = v
        v = Empty
    End If
End Sub

Private Sub ListBox1_Change()
    'Restore previous values if changed by Help/MouseDown event.
    If Not IsEmpty(v) Then
        Dim i As Integer
        For i = 1 To UBound(lbVal)
            Me.ListBox1.Selected(i - 1) = lbVal(i)
        Next i
        v = Empty
    End If
End Sub

Private Function CONTEXT_HELP(ByRef c As Object, _
ByVal Button As Integer) As Boolean
    'Activate button-specific help or run control-specific macro, 
    'depending on mouse state.
    'Returns True if help activated.
    Dim i As Integer
    CONTEXT_HELP = False
    If Me.MousePointer = fmMousePointerHelp Then
        Me.MousePointer = fmMousePointerDefault
        'Note original values before "click" event.
        Select Case Left(LCase(TypeName(c)), 8)
        Case "userform", "multipag"
            'Do nothing.
        Case "listbox"
            ReDim lbVal(1 To c.ListCount)
            For i = 1 To UBound(lbVal)
                lbVal(i) = c.Selected(i - 1)
            Next i
            v = 0
        Case Else
            v = c.Value
        End Select
        If Button = 1 Then
            'Context-sensitive help if left mouse button clicked.
            Application.Help ThisWorkbook.Path & "\rd.chm", HELP_ID(c)
            CONTEXT_HELP = True
        End If
    End If
End Function

Private Function HELP_ID(ByRef c As Object) as Long
    'Looks up ContexHelpID from worksheet.
    Dim wks As Worksheet
    Dim i As Integer, iMax As Integer
    Set wks = ThisWorkbook.Worksheets(1)
    With wks
        iMax = .Cells(2 ^ 14, 1).End(xlUp).Row
        For i = 1 To iMax
            If StrComp(Me.Name, .Cells(i, 1).Value, 1) = 0 _
            And StrComp(c.Name, .Cells(i, 2).Value, 1) = 0 Then
                HELP_ID = .Cells(i, 3).Value
                Exit For
            End If
        Next i
    End With
End Function

Private Sub Image1_click()
    'Activates help pointer when image clicked
    '(image is a "What's This" help icon).
    Me.MousePointer = fmMousePointerHelp
End Sub

Private Sub CommandButton1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Disable help pointer if escape key pressed.
    'Don't need to assign this procedure to every control, 
    'just one button per form.
    If KeyAscii = 27 And Me.MousePointer = fmMousePointerHelp Then
        Me.MousePointer = fmMousePointerDefault
    End If
End Sub