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.