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