Slider Control Behavior

[Code Doc]

I notice that when the Slider control is oriented horizontally and scrolled using the scroll wheel on the mouse, forward rotation moves the pointer to the left and backward rotation moves it to the right.

Is there any way to reverse the action so that forward rotation of the scroll wheel moves the pointer to the right and backward rotation moves it to the left?

I want to use this control to adjust speaker volume using the scroll wheel, and all media player volume controls that I am aware of increase level by going left to right.

[Siddharth Rout]

The problem is that it doesn't have any property which will let you do that... However there is a dirty trick that you can use...

Right click on the slider and click on properties, under the "Appearance" tab , select orientation as vertical... now if you move the mouse it works as you want it... Now all you need to do is code it in reverse way so that when the application starts the value of the slider is at max (which is at bottom) and the value of volume should be 0

Hope I am clear...

[Edgemeal]

What if you hook the control so when the mousewheel is detected you can set the slider value, an upward wheel rotation adds value and downward rotation subtracts value.

' FORM

Option Explicit

Public Sub MouseWheel(RotateDirection As Long)
    Dim NewVal As Long
    NewVal = Slider1.Value
    If RotateDirection < 0 Then
        NewVal = NewVal - 1
    Else
        NewVal = NewVal + 1
    End If
    If NewVal < Slider1.Min Then NewVal = Slider1.Min
    If NewVal > Slider1.Max Then NewVal = Slider1.Max
    Slider1.Value = NewVal
End Sub

Private Sub Form_Load()
    Hook Slider1.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unhook Slider1.hWnd
End Sub

Private Sub Slider1_Change()
    Debug.Print Slider1.Value
End Sub

' MODULE

Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
Private PrevWin As Long

Public Sub Unhook(handle As Long)
    If PrevWin Then
        Call SetWindowLong(handle, GWL_WNDPROC, PrevWin)
        PrevWin = 0
    End If
End Sub

Public Sub Hook(handle As Long)
    If PrevWin = 0 Then
        PrevWin = SetWindowLong(handle, GWL_WNDPROC, AddressOf Form1_Slider1)
    End If
End Sub

Private Function Form1_Slider1(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_MOUSEWHEEL Then  ' the mouse wheel rotated
        Form1.MouseWheel wParam / 65536
        Form1_Slider1 = 0
    Else
        Form1_Slider1 = CallWindowProc(PrevWin, hWnd, Msg, wParam, lParam)
    End If
End Function

[Siddharth Rout]

Kool Code Edge

[Code Doc]

Thanks, guys. Now I think I know why the mouse scroll wheel doesn't even work with the horizontal volume control on Windows Media Player.

Koolsid, I tried your idea earlier (reverse coding) and it still fails because the wheel's forward rotation always sends the slider left. What we want is the slider to slide right on a forward wheel rotation. After that, the volume coding is a piece of cake.

What Edgemeal appears to have done rather miraculously is redefined the control with extensive code. As you can see, it's somewhat of a mess, but I'll give it a shot. Changing control behavior is always a PITA.

Then there is also other standards involved. The slider is also used on speaker balance controls. The forward wheel roll always slides the balance to the left. So, we may be rocking the boat. Thus even though we can recode the control, it may not be wise to do so. Perhaps a few other senior members could intervene on this.

[Siddharth Rout]

Koolsid, I tried your idea earlier (reverse coding) and it still fails because the wheel's forward rotation always sends the slider left. What we want is the slider to slide right on a forward wheel rotation. After that, the volume coding is a piece of cake.

But did you change the way slider is placed? Vertically instead of horizontly? It will work as you wanted...

Edit

See example.. Doesn't have any code though... just compares the Vertical to Horz way of displaying...

[Edgemeal]

Then there is also other standards involved. The slider is also used on speaker balance controls. The forward wheel roll always slides the balance to the left. So, we may be rocking the boat. Thus even though we can recode the control, it may not be wise to do so. Perhaps a few other senior members could intervene on this.

Well if you can't find an easier solution and have more then one horizontal slider to control (so the mouse wheel works in the opposite direction) we could set the hook to the slider that got focus.
This example uses an array of sliders.

' FORM

Option Explicit

Public Sub MouseWheel(RotateDirection As Long, VBSlider As Slider)
    Dim NewVal As Long
    NewVal = VBSlider.Value
    
    If RotateDirection < 0 Then
        NewVal = NewVal - 1
    Else
        NewVal = NewVal + 1
    End If
    If NewVal < VBSlider.Min Then NewVal = VBSlider.Min
    If NewVal > VBSlider.Max Then NewVal = VBSlider.Max
    
    VBSlider.Value = NewVal
    Debug.Print VBSlider.Name & "(" & VBSlider.Index & ").Value = " & VBSlider.Value
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unhook ' Remove last hook set!
End Sub

Private Sub Slider1_GotFocus(Index As Integer)
   Hook Slider1(Index) ' hook current selected slider.
End Sub

' MODULE

Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
Private PrevWin As Long
Private SliderUsed As Slider

Public Sub Unhook()
    If PrevWin Then
        Call SetWindowLong(SliderUsed.hWnd, GWL_WNDPROC, PrevWin)
        PrevWin = 0
        Set SliderUsed = Nothing
    End If
End Sub

Public Sub Hook(VBSlider As Slider)
    Unhook ' First remove the old hook if it exists.
    Set SliderUsed = VBSlider ' set to slider in use.
    PrevWin = SetWindowLong(VBSlider.hWnd, GWL_WNDPROC, AddressOf Form1_Sliders) ' set hook
End Sub

Private Function Form1_Sliders(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_MOUSEWHEEL Then  ' the mouse wheel rotated
        Form1.MouseWheel wParam / 65536, SliderUsed ' direction, slider in use.
    Else
        Form1_Sliders = CallWindowProc(PrevWin, hWnd, Msg, wParam, lParam)
    End If
End Function

[Code Doc]

Edgemeal, you are incredible.

Actually, I was referring to other horizontal sliders on other Apps rather than mine, including the standard Windows XP balance controls (after double clicking on the speaker cone icon). There are dozens of them all over the place.

All have one thing in common--they move left on a forward wheel rotation and right on a backward. If we reverse the behavior on my App, we suddenly could be causing confusion. That's what I meant about rocking the boat (or perhaps I should have said, "going against the flow.")

On the other hand, both right-hand threads and left-hand threads are used by mechanical engineers all the time. The standard is right-hand threads, but on occasion, a left-hand thread is the only solution.