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

 

[patricktoulon1]

I can't wait to see the final result

 

[Dan_W]

That's as far as I've managed to get so far, I'm afraid. I just did some quick checking online, and I think the problem is not limited to InkCollector - trying to get the hwnd fo the dropdown listbox component is apparently quite universal. From the little I've been able to find out thus far, it is apparently possible to get the hwnd through FindWindowEx, which might be useful. If this issue can be solved, it seems like a erasonably robust option.

 

[patricktoulon1]

my method to know if the window handle below the cursor is scrollable

the class is
F3 mdc PoPup xxxxxxx : for the combobox
F3 server : for then frame,multipage,listbox,etc......

Function IsScrollable(control) As Boolean
    Dim class$, handle, Handleparent, pos As POINTAPI
    GetCursorPos pos
    If Not ActualControl Is Nothing Then If Not TypeOf ActualControl Is ComboBox Then py = 15 Else py = 0
    #If Win64 Then
        handle = WindowFromPoint(PointApiToLong(pos))
    #Else
        handle = WindowFromPoint(pos.X, pos.Y + 15)
    #End If
    class = Space$(255)
    Handleparent = GetParent(handle)
    GetClassName Handleparent, class, 255
    'F3 MdcPopup 6ca50000   'ClasseName de sous fenêtre de combobox
    'F3 Server 6ca50000     'classeName de fenêtre listbox et frame
    'EXCEL7                 'classeName capté uniquement quand la combo est developpée
    [l1] = class
    Select Case True
        ' la classe"EXCEL7" qui est (en fait)la partie visible de la range avec les heading  est donné lors du passage de la souris
        ' et click sur le dropbutton de la combo ou si elle est developpée
        ' sinon c'est la class XLDESK  qui est donné qui est l'application excel
        ' sans doute a cause d'une histoire de focus alors on l'utilise
        ' le scroll est alors utilisable même si le curseur se trouve encore en haut de la combo
        ' mais me permet de cliquer le dropbutton de la combo sans lanser le do/loop avant qu'elle soit développée
        Case class Like "F3 MdcPopup*" _
                         Or class Like "F3 Server*" _
                         Or (class Like "EXCEL7*" And TypeName(control) = "ComboBox" _
                         Or class Like "F3 MdcPopup*" _
                         Or class Like "ThunderDFrame*")
            
            IsScrollable = True
    End Select
    class = ""
End Function

 

[Jaafar Tribak]

Hi Dan,

This is a wonderful find. The library also exposes many other useful libraries.

I discovered a couple if issues when I carried out a small test:
1- The event only fires when at least one control inside the immediate parent container has the focus. Whe I say parent container, I mean the UserForm, a frame or a multipage. In other words, at least one control has to have the focus for this to work.
2- Asscociating the form client hwnd doesn't work for controls inside frames or inside mutipages when they have the focus.

 

[Dan_W]

Hi Dan,

This is a wonderful find. The library also exposes many other useful libraries.

I discovered a couple if issues when I carried out a small test:
1- The event only fires when at least one control inside the immediate parent container has the focus. Whe I say parent container, I mean the UserForm, a frame or a multipage. In other words, at least one control has to have the focus for this to work.
2- Asscociating the form client hwnd doesn't work for controls inside frames or inside mutipages when they have the focus.

Thank you both. As I said, I hadn't considered the combobox, and so foolishly hadn't given it any thought before now. I will do some testing.

As I sadi, I have done a fair bit more testing on this, and I am trying to get something more concrete together, and I hope to soon. But in answer to your points, Jaafar, I'm not sure that's correct re: the SetFocus point. Here's another screen capture:

I will write an explanation but thought I should post this first.

 

[Dan_W]

So on this userform, you see (starting top left and going right):
1. a listbox
2. a frame with labels in it
3. a multipage control - 6 pages, each with several textboxes/fields

Next row, there is another frame (I like frames) with more labels inside. Here, note the label saying hover over me. That's a label that is getting bigger and smaller based on the mouse wheel only when the cursor is over it. This is a demonstration of the container controller method we've explored already.

Then, there is a textbox with a red border. That is actually a textbox in a frame container. The frame container backcolor is green. There are 4 red labels within the frame control that make up the border. There if a reason for this that I will explain below.

THen at the bottom there is a scrollbar. This is also in a frame control. That frame control also has a green backcolor.

One more important point. I have set the mouse pointer to a hand icon using the Ink Controller. This is a visual clue for us that the InkController has connected.

 

[Dan_W]

You will see that the first time the cursor goes into the textbox region, that the Ibeam pointer appears and not the hand. This means that the InkCollector has not engaged, even though I have connected tit to the textboxes container, the frame. Why? It seems that the curcor has to 'visibily' (?) pass over the windowed container control. Meaning that the frame has to 'see' the cursor move into its domain. That's why I have the label borders. in place. Until one of them is made invisible, revealing the partial frame container beneath it, the InkCollector does not appear to conenct.

It's all very difficult to explain, and I think I really need to upload my various userforms so you can get a feel for what I'm talking about.

But the whole thing has been really fascinating. I cannot find any evidence that anyone else anywhere has ever used the InkCollector like this. I had never even heard of this thing until I found it, and that was by accident when I was trying to work out how to work out the zoom on teh InkEdit control. The InkPicture control also has a MouseWheel event, interestingly. There is also an InkOverlay class that does similar things to the InkCollector, but it isn't entirely clear to me what it's actual role is. I'm still researching it.

But I'm glad that you both seem to find it as intriguing as I do! I will try and upload some more tonight/tomorrow and keep you updated.

 

[Dan_W]

But in answer to your points, Jaafar, I'm not sure that's correct re: the SetFocus point. Here's another screen capture:

I forgot to expand on this - what I mean by this is that - as you can see in the GIF above, I am able to scroll though all these different controls, but, save for one or two times, at no stage do these controls actually have the focus. I am able to control them purely by the cursors location over the relevant hwnd. I think that's right, anyway.

 

[Jaafar Tribak]

Dan,
Using your demo workbook on Github: EZPZMouseController_Demo.xlsm.
I just added a textbox below the frame, nothing else ... As you can see in the gif blelow, once I set the focus to the textbox that is outside the Frame, the scrolling stops! I need to click again inside the frame area or on any of the labels in order to restore the scrolling functionality.

The weird thing is that this issue only happens in excel 2016 x64bit. Works fine in Excel x32bit.

 

[patricktoulon1]

HELLO @Jaafar Tribak and @Dan_W

my method


the object InkCOLLECTOR is created at the mouse move of control and is dectruct when the cursor leaves the control

for the combobox it's a little more complicated you have to grab the handle of the popup "class F3 PoPup xxxxx"
so I integrated my function designed for that and I give the focus.
the handle is captured with getcursorpos and a 2d test with pos.y+25
if the class is good it returns the handle to me
in the setupMousewheel I give the focus to the control OR!! to the handle
and that's work

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'methode de scrolling de control avec l'object InkCollector
'auteur: patricktoulon
'version:1.0

Private WithEvents IC As MSINKAUTLib.InkCollector
Public mycontrol As control
Private Type POINTAPI: X As Long: Y As Long: End Type
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
#If Win64 Then
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongLong) As LongPtr
    Private Type t8: L As LongLong: End Type
Private Function PointApiToLong(point As POINTAPI) As LongLong
    Dim T As t8
    LSet T = point
    PointApiToLong = T.L
End Function
#Else
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
#End If


Function handlecombo(control) As Long
    Dim class$, handle As LongPtr, Handleparent As LongPtr, pos As POINTAPI, Q&
    GetCursorPos pos
re:
    #If Win64 Then
        handle = WindowFromPoint(PointApiToLong(pos))
    #Else
        handle = WindowFromPoint(pos.X, pos.Y)
    #End If
    class = Space$(255)
    Handleparent = GetParent(handle)
    GetClassName Handleparent, class, 255
    If Q = 0 And Not class Like "F3 MdcPopup*" Then pos.Y = pos.Y + 25: Q = 1: GoTo re

    If class Like "F3 MdcPopup*" Then handlecombo = Handleparent
End Function


'creation de l'object InkCollertor pour piloter le scroll
Private Sub SetupMouseWheel(Ctrl As control, Optional handl As Long = 0)
    Set IC = New MSINKAUTLib.InkCollector
    If handl <> 0 Then SetFocus handl Else Ctrl.SetFocus
    Set mycontrol = Ctrl
    On Error Resume Next
    With IC
        If handl <> 0 Then .hwnd = handl Else .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 Label2_Click()

End Sub

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
  'THE DESTRUCTION OF THE OBJECT ic IN THE MOVE OF THE USERFORM IS TEMPORARY. I WILL ADD MY RECTANGLE FUNCTIONS TO IT SO THAT IT IS AUTOMATIC.

  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 MultiPage1_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    SetupMouseWheel MultiPage1
End Sub

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    Dim h As LongPtr
    h = handlecombo(ComboBox1)
    Label2.Caption = "combobox1" & vbCrLf & " handle : " & h
      If h <> 0 Then
           SetupMouseWheel ComboBox1, h
    End If
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
            CallByName mycontrol, "ScrollTop", VbLet, IIf(Delta > 0, Application.Max(mycontrol.ScrollTop - 8, 0), mycontrol.ScrollTop + 8)
            
        Case TypeName(mycontrol) = "ListBox" Or TypeOf mycontrol Is ComboBox
            CallByName mycontrol, "TopIndex", VbLet, IIf(Delta > 0, Application.Max(mycontrol.TopIndex - 1, 0), mycontrol.TopIndex + 1)
            
        Case TypeOf mycontrol Is MultiPage
            CallByName mycontrol.Pages(mycontrol.Value), "ScrollTop", VbLet, IIf(Delta > 0, _
                                                          Application.Max(mycontrol.Pages(mycontrol.Value).ScrollTop - 8, 0), _
                                                          mycontrol.Pages(mycontrol.Value).ScrollTop + 8)
            
    End Select
End Sub