trying to scroll listbox with two commandbutton

[patricktoulon1]

hello i'me trying to scroll a listbox with a commandbutton but that dont work

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                              (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
                              lParam As Any) As Long

Private Const WM_VSCROLL = &H115
Const SB_LINEDOWN = 1
Const SB_LINEUP = 0

'event mouseUp for then button  because i need  a listbox focused

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ListBox1.SetFocus
   SendMessage ListBox1.[_GethWnd], WM_VSCROLL, SB_LINEUP, ByVal 0&

End Sub

Private Sub CommandButton2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ListBox1.SetFocus
   SendMessage ListBox1.[_GethWnd], WM_VSCROLL, SB_LINEDOWN, ByVal 0&

End Sub

Private Sub UserForm_Activate()
ListBox1.List = Evaluate("row(1:30)")
End Sub

can you help me please

 

[Jurassic Pork]

I have updated the file example with the necessary corrections : ScrollTextBox_V1.xlsm

Hello,
Thanks Jaafar, with your new workbook it is OK for my Excel 2021 64 bits.
Friendly, J.P

 

[Jaafar Tribak]

Glad it is now working accross all platforms and thanks for the feedback

 

[patricktoulon1]

As we continue discussing scrollable multiline textboxes, I am curious whether there is a programmatic approach to hide the vertical scrollbar once it has been displayed.

Well the problem is that if we hide it it is no longer clickable unless the sendinput still works unlike mouse_event
with jump curline method it's work whithout scrollbar but in authers method i dont know
but it's interesting

 

[Jaafar Tribak]

Well the problem is that if we hide it it is no longer clickable unless the sendinput still works unlike mouse_event
with jump curline method it's work whithout scrollbar but in authers method i dont know
but it's interesting

Neither SendInput, SendMessage, nor PostMessage will work if the scrollbar is not currently visible; however, this shouldn't pose an issue since the scrollbar appears as soon as the textbox receives focus.

I am asking this question out of pure curiosity: It seems that once a textbox gains focus and its scrollbar becomes visible, there is no way to hide it, either through the user interface or programmatically. Perhaps I should post this question in a separate thread.

 

[Dan_W]

I actually gave an example with command buttons, but it will actually be done through VBA via API with PeekMessage.
So, yes, for combo boxes, it's top index for frames, scrolltop, etc.
But I'm looking to integrate it for textboxs as well, and they don't have a scroll function.
I already have a working module managing scrolling for list boxes, combo boxes, frames, multipages, and UserForms with the wheel.WITHOUT HOOKING !!!
I just want to add textboxs management in my module
But since the textbox don't have top index or scrolltop, etc., I want to do it with sendmessageA,

and why not also replace those for the controls already managed to reduce my code

While I can't claim to solve this requirement to scroll through a textbox without using CurLine, I have stumbled across a way of accessing the MouseWheel without APIs/subclasssing/hooking. It doesn't crash and it's reliable. You may find it of use, if not for this project.

It relies on the InkCollector object - which is found in the MS Tablet PC Type Library, and I am informed that this is part of the standard Windows installation these days. As luck would have it, I just recently wrote about it here, but the code short so there's no problem setting it out here too:

• Go to Tools > References....
• Scroll down and check Microsoft Tablet PC Type Library 1.0 (or similar version).
• If not listed, click Browse... and navigate to C:\Program Files (x86)\Common Files\Microsoft Shared\ink\InkObj.dll (adjust path if needed). Click OK.

Create a new userform, add a frame (Frame1) and a command button (CommandButton1) within the frame. Add the following code into the UserForm, and then run the code. You will be able to move the command button around the frame with the mousebutton (and the shift button for horizontal movement). It's a silly example, and it isn't a complete answer to your problem, but I thought it might be of interest.

Private WithEvents IC As MSINKAUTLib.InkCollector

Private Sub UserForm_Initialize()
  SetupMouseWheel
End Sub

Private Sub SetupMouseWheel()
  Set IC = New MSINKAUTLib.InkCollector
   With IC
    .hWnd = Me.Frame1.[_GethWnd] ' The InkCollector requires an 'anchor' hWnd
    .SetEventInterest ICEI_MouseWheel, True         ' This sets event that you want to listen for
    .MousePointer = IMP_Arrow ' If this is not set, the mouse pointer disappears
    .DynamicRendering = False                       ' I suggest turning this off
    .DefaultDrawingAttributes.Transparency = 255    ' And making the drawing fullly transparent
    .Enabled = True                                 ' This must be set last
  End With
End Sub

Private Sub IC_MouseWheel(ByVal Button As MSINKAUTLib.InkMouseButton, ByVal Shift As MSINKAUTLib.InkShiftKeyModifierFlags, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)
  Dim TargetProperty As String, CurrentValue As Long
  If Shift Then TargetProperty = "Left" Else TargetProperty = "Top"
  CurrentValue = CallByName(CommandButton1, TargetProperty, VbGet)
  CallByName CommandButton1, TargetProperty, VbLet, IIf(Delta > 0, CurrentValue - 5, CurrentValue + 5)
End Sub

 

[patricktoulon1]

hello Dan_W
Wouahwh!!!!!
It works perfectly for a frame, I can't believe my eyes.
Bravo for this find.
but you use the redraw of commandButton in your example
you can use simply then mousewhell engine of IC and for each control and realy scrolling controls
that work for frame and listbox but i can't do working with combobox and i dont know why

Private WithEvents IC As MSINKAUTLib.InkCollector
Public mycontrol As Control
Dim handle As Long

Private Sub UserForm_Activate()
    ListBox1.List = Evaluate("row(1:30)")
    ComboBox1.List = Evaluate("row(1:30)")
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'stop the scrolling when you leaves control
    ' destruction of object IC
    Set IC = Nothing
End Sub

'I CAN TAKE A FRAME1 HANDLE FOR ALL CONTROLS
'THE HANDLE IS JUST A REFERENCE  FOR THE IC OBJECT
 'handle = Frame1.[_GethWnd]'is the firstchild with handle  of userform
 

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    handle = Frame1.[_GethWnd] 'it take a handle of frame because combobox has not disponible handle
    Set mycontrol = ComboBox1
    mycontrol.SetFocus
   SetupMouseWheel
End Sub

Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
handle = Frame1.[_GethWnd]
    Set mycontrol = Frame1
    mycontrol.SetFocus
    SetupMouseWheel
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    handle = Frame1.[_GethWnd] 'handle = ListBox1.[_GethWnd]' this two can work
    Set mycontrol = ListBox1
    mycontrol.SetFocus
    SetupMouseWheel
End Sub

Private Sub SetupMouseWheel()
    Set IC = New MSINKAUTLib.InkCollector
    With IC
        .hwnd = handle ' The InkCollector requires an 'anchor' hWnd
        .SetEventInterest ICEI_MouseWheel, True ' This sets event that you want to listen for
        .MousePointer = IMP_Arrow ' If this is not set, the mouse pointer disappears
        .DynamicRendering = False ' I suggest turning this off
        .DefaultDrawingAttributes.Transparency = 255 ' And making the drawing fullly transparent
        .Enabled = True ' This must be set last
    End With
End Sub

Private Sub IC_MouseWheel(ByVal Button As MSINKAUTLib.InkMouseButton, ByVal Shift As MSINKAUTLib.InkShiftKeyModifierFlags, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)
    Select Case True
        Case TypeOf mycontrol Is Frame
            If Delta > 0 Then
                Frame1.ScrollTop = Application.Max(0, Frame1.ScrollTop - 5)
            Else
                Frame1.ScrollTop = Application.Min(Frame1.ScrollHeight, Frame1.ScrollTop + 5)
            End If
          
        Case TypeName(mycontrol) = "ListBox"
            If Delta > 0 Then
                ListBox1.TopIndex = Application.Max(ListBox1.TopIndex - 1, 0)
            Else
                ListBox1.TopIndex = Application.Min(ListBox1.TopIndex + 1, ListBox1.ListCount - 1)
            End If
          
        Case TypeName(mycontrol) = "ComboBox"
            If Delta > 0 Then
                ComboBox1.TopIndex = Application.Max(ComboBox1.TopIndex - 1, 0)
            Else
                ComboBox1.TopIndex = Application.Min(ComboBox1.TopIndex + 1, ComboBox1.ListCount - 1)
            End If
    End Select
End Sub

 

[Dan_W]

Thank you - I stumbled across it by accident a month or so ago as I was investigating the InkEdit control and trying to work out how to zoom with the mouse wheel. I've been using it a lot since then, and it really is a very straightforward option. I've actually done a lot mroe work on this InkCollector than my Github repo might suggest - I"m in the process of creating a class to manage all the different controls, etc. and standard scrolling behaviour for each. There are some quirks to it, though, and they need to be properly understood (for example, the documented values for the Shift buttons are wrong). That said, I'm actually not sure about how to handle the combobox control. Frankly, I completely forgot about the combobox.

To give you a sense of where I'm currently at, here is the class MouseWheel event code:

  Private Sub IC_MouseWheel(ByVal Button As MSINKAUTLib.InkMouseButton, ByVal Shift As MSINKAUTLib.InkShiftKeyModifierFlags, ByVal Delta As Long, ByVal x As Long, ByVal y As Long, Cancel As Boolean)
      
      ' The action triggered by the MouseWheel event can be customised, and the default actions bypassed, by setting the
      ' Cancel flag to true in the corresponding Ueerform event.
      
      On Error GoTo ErrHandler
      If Shift = 8 Then
        Dim MouseWheelDirection As ZoomDirection
        MouseWheelDirection = IIf(Delta > 0, ZoomIn, ZoomOut)
        RaiseEvent Zoom(MouseWheelDirection)
      End If
      RaiseEvent MouseWheel(This.TargetControl.Name, Button, Shift, Delta, x, y, Cancel)
      If Cancel Then Exit Sub
      
      If Not This.TargetControl Is Nothing Then
        Dim CurrentValue As Long, NewValue As Long, ControlMin As Single, ControlMax As Single
        ControlMin = 0
        
        Select Case TypeName(This.TargetControl)
          Case "Frame", "MultiPage", "Page", This.UserFormName
            This.PropertyName = "ScrollTop"
            ControlMax = CallByName(This.TargetControl, "ScrollHeight", VbGet)
            
          Case "ListBox"
            This.PropertyName = "TopIndex"
            ControlMax = CallByName(This.TargetControl, "ListCount", VbGet)
            
          Case "ProgressBar2", "Slider2", "ScrollBar", "SpinButton"
            This.PropertyName = "Value"
            ControlMin = CallByName(This.TargetControl, "Min", VbGet)
            ControlMax = CallByName(This.TargetControl, "Max", VbGet)
            
          Case Else
            ' TODO - TreeView4? ListView4? ComboBox?
        End Select
        
        ' Store the current value of the control's property
        CurrentValue = CallByName(This.TargetControl, This.PropertyName, VbGet)
        
        ' The new value for this property is calulated by adding the the
        ' positive or negative value (depending on the delta) of the StepSize
        ' variable to the above CurrentValue.
        NewValue = IIf(Delta > 0, -This.stepSize, This.stepSize) + CurrentValue
        
        ' Checks to make sure the value does not go out-of-bounds
        If NewValue < ControlMin Then NewValue = ControlMin
        If NewValue > ControlMax Then NewValue = ControlMax
        
        ' Change the value of the given property
        Call CallByName(This.TargetControl, This.PropertyName, VbLet, NewValue)
      End If
ErrHandler:
  End Sub

Jaafar knows far more about this than I do, so I defer to him, but my understanding is that the ComboBox is actually two controls - a textbox and a listbox, and the hwnd that the IC would need here is that of the ListBox The problem, though, is thta the hwnd does not seem to come into existence until the listbox part of the combobox appears. I think I've seen other implementations of the using the mousewheel that constantly test for the hwnd under the cursor, which I suppose might work.

Alternatively, it may be possible to simply bind the InkCollector to the Userform, and then when the mouse is over the combobox (triggered by the MouseMove event), but I would need to test that.

 

[patricktoulon1]

no it's not working with handle of userform i'me already tested
for the moment i use the inkcollector like that

Private WithEvents IC As MSINKAUTLib.InkCollector
Public mycontrol As Control

'creation de l'object InkCollertor pour piloter le scroll
Private Sub SetupMouseWheel(Ctrl As Control)
    Set IC = New MSINKAUTLib.InkCollector
    Ctrl.SetFocus
    Set mycontrol = Ctrl
    With IC
        .hwnd = Ctrl.[_GethWnd] ' The InkCollector requires an 'anchor' hWnd
        .SetEventInterest ICEI_MouseWheel, True ' This sets event that you want to listen for
        .MousePointer = IMP_Arrow ' If this is not set, the mouse pointer disappears
        .DynamicRendering = False ' I suggest turning this off
        .DefaultDrawingAttributes.Transparency = 255 ' And making the drawing fullly transparent
        .Enabled = True ' This must be set last
    End With
End Sub

Private Sub UserForm_Activate()
    ListBox1.List = Evaluate("row(1:30)")
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'stop the scrolling when you leaves control
    ' destruction of object IC
    Set IC = Nothing
    'provisoire  je vais lui ajouter la fonction rectangle sans api pour sortir
End Sub


Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    SetupMouseWheel Frame1
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    SetupMouseWheel ListBox1
End Sub


Private Sub IC_MouseWheel(ByVal Button As MSINKAUTLib.InkMouseButton, ByVal Shift As MSINKAUTLib.InkShiftKeyModifierFlags, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)
    Select Case True
        Case TypeOf mycontrol Is Frame
            If Delta > 0 Then
                Frame1.ScrollTop = Application.Max(0, Frame1.ScrollTop - 5)
            Else
                Frame1.ScrollTop = Application.Min(Frame1.ScrollHeight, Frame1.ScrollTop + 5)
            End If
          
        Case TypeName(mycontrol) = "ListBox"
            If Delta > 0 Then
                ListBox1.TopIndex = Application.Max(ListBox1.TopIndex - 1, 0)
            Else
                ListBox1.TopIndex = Application.Min(ListBox1.TopIndex + 1, ListBox1.ListCount - 1)
            End If
          
        Case TypeOf mycontrol Is ComboBox
            On Error Resume Next
            If Delta > 0 Then
                ComboBox1.TopIndex = Application.Max(ComboBox1.TopIndex - 1, 0)
            Else
                ComboBox1.TopIndex = Application.Min(ComboBox1.TopIndex + 1, ComboBox1.ListCount - 1)
            End If
    End Select
End Sub

There are two possible methods.
Method 1: You initially launch a setupmousewheel, and the control changes when you hover over it.

Method 2: When you hover over it, you launch a new setupmousewheel with the control handle,of control hovered as in the example above.
I prefer method 2 because with method 1 if there's an error, you have to return to give focus to the master handle. else then scroll is not operational
even if the error is handled


but this méthode is limited by handle for the combobox and with handle window child it's not worked i'me already tested too

 

[Dan_W]

When you say the 'handle of the userform', how are you getting that? I ask because it's actually the handle of the client area of the UserForm that you need. So I don't know if you've seen the workbook I uploaded but it has an example of it with windowless controls. Basically, to attach the InkCollector to the UserForm, you need something like:

#If VBA7 Then
  Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#Else
  Private Enum LongPtr
  [_]
  End Enum
  Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
  Private Declare Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
#End If

Private WithEvents IC As MSINKAUTLib.InkCollector

Private Sub SetupMouseWheel()
  Dim hWnd As LongPtr, TemphWnd As LongPtr
  Call IUnknown_GetWindow(Me, VarPtr(hWnd))
  Const GW_CHILD = 5
  TemphWnd = GetWindow(hWnd, GW_CHILD)
  Set IC = New MSINKAUTLib.InkCollector
  With IC
    .hWnd = TemphWnd                                ' The InkCollector requires an 'anchor' hWnd
    .SetEventInterest ICEI_MouseWheel, True         ' This sets event that you want to listen for
    .MousePointer = IMP_Arrow                       ' If this is not set, the mouse pointer disappears
    .DynamicRendering = False                       ' I suggest turning this off = less overhead
    .DefaultDrawingAttributes.Transparency = 255    ' And making the drawing fullly transparent
    .Enabled = True                                 ' This must be set last
  End With
End Sub

It does actually tecnically work - I will record a screen capture and explain, but I still haven't fully managed to solve this issue. I will upload my screen capture somehow later today.

 

[Dan_W]

So this is a quick mockup I managed to tack onto the existing Windowless controls demo. What you can see in the demo is how I use the mousewheel while hovering over various windowless controls - first a label control, then a textbox. Finally the combobox.

First, I go and select a value, cause the dropdown box to appear. It isn't until I am hovering back over the texbox component that, presumably, the InkCollector reinitiates because I'm back in the 'userform hwnd' area (if I'm making any sense). Here, you can see that the mousewheel does in fact work with the combbox by using that TopIndex property. However, when I move BACK to the listbox component of the combobox, I'm still using the mousewheel, but it isn't moving. What I think is happening is that InkCollector disconnects from its previously hwnd binding when it enters the 'domain' of another hwnd. The reason that this particular 'useform method' works on windowless controls is precisely because they ARE windowless, and so there is nothing to cause the InkCollector to diconnect. The listbox part of the combobox, however, does have a hwnd, and so unless there is a way of finding out what that hwnd is and connecting to it, I'm llittle bit stuck at the moment.

Then you can see that I close the downdown compoent and I try and use the mousewheel over the combobox again. This then causes the error message you see - because there is now no long any TopIndex for VBA to work with.

That's what I GUESS is happening.