C# と VB.NET の質問掲示板

VBでTrackBarを使っていて、
TrackBar上をクリックした時に、
そのクリックした位置にスライダーが移動するようにしたいと考えています。


http://www.ramanet.net/89/vb-net-trackbar%E3%81%A7%E3%82%AF%E3%83%AA%E3%83%83%E3%82%AF%E3%81%97%E3%81%9F%E4%BD%8D%E7%BD%AE%E3%81%AB%E7%A7%BB%E5%8B%95.html


ここにコードが掲載されているのですが、
この方法だと、マウスをアップした時に移動する仕様になっています。
マウスをダウンした時に移動させたいため、
以下のように修正しました。

これでクリックした位置に移動することはできるのですが、
なぜかクリックした時
TrackBar1_ValueChanged
が2回実行されてしまいます。

例えば、TrackBar1.Valueが1の状態で200の位置をクリックしたとすると、

TrackBar1_ValueChanged　　　TrackBar1.Value = 8  が実行
TrackBar1_MouseDown　　　　　TrackBar1.Value = 200 に設定
TrackBar1_ValueChanged　　　TrackBar1.Value = 200  が実行

というようなかたちです。
なぜ、MouseDown　よりも前に　ValueChangedが実行されるのでしょうか？
これを阻止するにはどうすれば良いですか？



    Private Sub TrackBar1_ValueChanged(sender As Object, e As EventArgs) Handles TrackBar1.ValueChanged

		' 計算処理

    End Sub

    Private Sub TrackBar1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles TrackBar1.MouseDown

        If e.Button <> Windows.Forms.MouseButtons.Left _
            OrElse e.X < 0 OrElse e.X > TrackBar1.Width OrElse e.Y < 0 OrElse e.Y > TrackBar1.Height Then
            Exit Sub
        End If

        If e.X < 8 Then
            TrackBar1.Value = TrackBar1.Minimum
        ElseIf e.X > TrackBar1.Width - 8 Then
            TrackBar1.Value = TrackBar1.Maximum
        Else
            Dim seekWidth As Double = TrackBar1.Width - 16
            Dim ticWidth As Double = seekWidth / (TrackBar1.Maximum - TrackBar1.Minimum)
            TrackBar1.Value = CInt((e.X - 8) / ticWidth) + TrackBar1.Minimum
        End If


    End Sub

2019/11/16(Sat) 00:35:14 編集(投稿者)

■No93031 (小次郎 さん) に返信

こんなカスタムコントロールを作ってログを取ってみると

Public Class TrackBarEx
    Inherits TrackBar

    Private nestCount As Integer

    Protected Overrides Sub WndProc(ByRef m As Message)
        Debug.Print("{0}+ {1}", New String(" "c, nestCount), m)
        nestCount += 1
        MyBase.WndProc(m)
        nestCount -= 1
        Debug.Print("{0}- {1}", New String(" "c, nestCount), m)
    End Sub

    Protected Overrides Sub OnValueChanged(e As EventArgs)
        Debug.Print("■ OnValueChanged")
        MyBase.OnValueChanged(e)
    End Sub

    Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
        Debug.Print("■ OnMouseDown")
        MyBase.OnMouseDown(e)
    End Sub

End Class

+ msg=0x201 (WM_LBUTTONDOWN) hwnd=0x192448 wparam=0x1 lparam=0xf00c7 result=0x0
 + msg=0xf (WM_PAINT) hwnd=0x192448 wparam=0x0 lparam=0x0 result=0x0
  + msg=0x204e (WM_REFLECT + WM_NOTIFY) hwnd=0x192448 wparam=0x192448 lparam=0xafe38c result=0x0
  - msg=0x204e (WM_REFLECT + WM_NOTIFY) hwnd=0x192448 wparam=0x192448 lparam=0xafe38c result=0x0
 - msg=0xf (WM_PAINT) hwnd=0x192448 wparam=0x0 lparam=0x0 result=0x0
 + msg=0x2114 (WM_REFLECT + WM_HSCROLL) hwnd=0x192448 wparam=0x3 lparam=0x192448 result=0x0
  + msg=0x400 (WM_USER) hwnd=0x192448 wparam=0x0 lparam=0x0 result=0x0
  - msg=0x400 (WM_USER) hwnd=0x192448 wparam=0x0 lparam=0x0 result=0x5
■ OnValueChanged
 - msg=0x2114 (WM_REFLECT + WM_HSCROLL) hwnd=0x192448 wparam=0x3 lparam=0x192448 result=0x0
■ OnMouseDown
- msg=0x201 (WM_LBUTTONDOWN) hwnd=0x192448 wparam=0x1 lparam=0xf00c7 result=0x0

となったので、WM_LBUTTONDOWN を捕まえて MyBase.WndProc(m) の前に処理を入れれば良さそうです。

ありがとうございます。

以前、どこかで見かけたコードを参考にして以下のように作ってみました。

クリックを抑制することには成功したのですが、
肝心のクリックでスライダーを動かす機能も死んでしまいました
どうすれば良いですか？


                Me.m_Window2 = New TrackBarClickMove(TrackBar1)



    Class TrackBarClickMove

        Inherits NativeWindow
        Public Sub New(ByVal ctrl As Control)
            Me.AssignHandle(ctrl.Handle)
        End Sub

        Protected Overrides Sub WndProc(ByRef m As Message)
            If m.Msg = &H201 Then ' WM_LBUTTONDOWN
                m.Result = IntPtr.Zero
                Return
            End If
            MyBase.WndProc(m)
        End Sub

    End Class


    Private m_Window2 As TrackBarClickMove

■No93033 (小次郎 さん) に返信

1つ前のTrackBar1.ValueをPrivate変数で保持しておいてMouseDownイベント内で値に変化があったら
TrackBar1_ValueChangedメソッド実行という流れでどうでしょう？
目盛のパディングを8で決め打ちにされていますが、これはまずいと思います。
TBM_GETCHANNELRECTをSendMessageすることで、目盛領域を得られるので、そこから計算するのが良いと思います。

以下でどうでしょう？

Imports System.Runtime.InteropServices
Public Class Form1
    Private oldValue As Integer
    Private channel As Rectangle
    Private Structure RECT
        Public left, top, right, bottom As Integer
    End Structure
    <DllImport("user32.dll", EntryPoint:="SendMessage")>
    Private Shared Function SendMessageRect(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByRef lp As RECT) As IntPtr
    End Function
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        oldValue = TrackBar1.Minimum
        TrackBar1.Value = TrackBar1.Minimum
        channel = GetChanelRectangle(TrackBar1)
    End Sub
    Private Sub TrackBar1_ValueChanged()
        ' 計算処理
        MsgBox($"ValueChanged: {TrackBar1.Value}")
    End Sub
    Private Function GetChanelRectangle(trackbar As TrackBar) As Rectangle
        Const TBM_GETCHANNELRECT As Integer = &H400 + 26
        Dim rc As RECT = New RECT()
        SendMessageRect(trackbar.Handle, TBM_GETCHANNELRECT, IntPtr.Zero, rc)
        Return New Rectangle(rc.left, rc.top, rc.right - rc.left, rc.bottom - rc.top)
    End Function
    Private Sub TrackBar1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles TrackBar1.MouseDown
        If e.X < channel.Left Then
            TrackBar1.Value = TrackBar1.Minimum
        ElseIf e.X > channel.Right Then
            TrackBar1.Value = TrackBar1.Maximum
        Else
            Dim ticWidth As Double = channel.Width / (TrackBar1.Maximum - TrackBar1.Minimum)
            TrackBar1.Value = CInt((e.X - channel.Left) / ticWidth) + TrackBar1.Minimum
        End If
        If oldValue <> TrackBar1.Value Then
            TrackBar1_ValueChanged()
        End If
        oldValue = TrackBar1.Value
    End Sub
End Class

■No93034 (mayo さん) に返信

↑ではキーボード操作で値に変化があった場合、ダメですね。
キーボード操作も考慮するなら以下を追加してください。

 Private Sub TrackBar1_KeyUp(sender As Object, e As KeyEventArgs) Handles TrackBar1.KeyUp
        If oldValue <> TrackBar1.Value Then
            TrackBarValueChanged()
        End If
        oldValue = TrackBar1.Value
    End Sub

2019/11/16(Sat) 12:35:32 編集(投稿者)

■No93033 (小次郎 さん) に返信
> 肝心のクリックでスライダーを動かす機能も死んでしまいました
> どうすれば良いですか？

マウスの座標が LParam に入ってくるので

Public Function SignedHIWORD(ByVal n As IntPtr) As Integer
    Return SignedHIWORD(CInt(CLng(n)))
End Function

Public Function SignedHIWORD(ByVal n As Integer) As Integer
    Return CShort((n >> 16 And 65535))
End Function

Public Function SignedLOWORD(ByVal n As IntPtr) As Integer
    Return SignedLOWORD(CInt(CLng(n)))
End Function

Public Function SignedLOWORD(ByVal n As Integer) As Integer
    Return CShort((n And 65535))
End Function

Dim x As Integer = SignedLOWORD(m.LParam)
Dim y As Integer = SignedHIWORD(m.LParam)

で座標を取得して、つまみ部分なら通常の処理、それ以外は無視するようにします。

つまみの範囲はは TBM_GETTHUMBRECT で取得できるようです。

「TBM_GETTHUMBRECT」
https://docs.microsoft.com/en-us/windows/win32/controls/tbm-getthumbrect

途中まで作りましたがこんな感じでしょうか？


    Class TrackBarClickMove

        Inherits NativeWindow
        Public Sub New(ByVal ctrl As Control)
            Me.AssignHandle(ctrl.Handle)
        End Sub

        Protected Overrides Sub WndProc(ByRef m As Message)
            If m.Msg = &H201 Then ' WM_LBUTTONDOWN


                Dim x As Integer = SignedLOWORD(m.LParam)
                Dim y As Integer = SignedHIWORD(m.LParam)

                Dim channel As Rectangle = GetChanelRectangle()

                If x < 0 OrElse x > channel.Width OrElse y < 0 OrElse y > channel.Height Then
                    Exit Sub
                End If

                If x < 8 Then
                    TrackBar1.Value = TrackBar1.Minimum
                ElseIf X > TrackBar1.Width - 8 Then
                    TrackBar1.Value = TrackBar1.Maximum
                Else
                    Dim seekWidth As Double = channel.Width - 16
                    Dim ticWidth As Double = seekWidth / (TrackBar1.Maximum - TrackBar1.Minimum)
                    TrackBar1.Value = CInt((x - 8) / ticWidth) + TrackBar1.Minimum
                End If


                m.Result = IntPtr.Zero
                Return
            End If
            MyBase.WndProc(m)
        End Sub


        Public Function SignedHIWORD(ByVal n As IntPtr) As Integer
            Return SignedHIWORD(CInt(CLng(n)))
        End Function

        Public Function SignedHIWORD(ByVal n As Integer) As Integer
            Return CShort((n >> 16 And 65535))
        End Function

        Public Function SignedLOWORD(ByVal n As IntPtr) As Integer
            Return SignedLOWORD(CInt(CLng(n)))
        End Function

        Public Function SignedLOWORD(ByVal n As Integer) As Integer
            Return CShort((n And 65535))
        End Function

        Private Function GetChanelRectangle() As Rectangle
            Const TBM_GETCHANNELRECT As Integer = &H400 + 26
            Dim rc As RECT = New RECT()
            SendMessageRect(Me.Handle, TBM_GETCHANNELRECT, IntPtr.Zero, rc)
            Return New Rectangle(rc.left, rc.top, rc.right - rc.left, rc.bottom - rc.top)
        End Function


        Private Structure RECT
            Public left, top, right, bottom As Integer
        End Structure

        <DllImport("user32.dll", EntryPoint:="SendMessage")>
        Private Shared Function SendMessageRect(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByRef lp As RECT) As IntPtr
        End Function


    End Class

実際にはtrackbarのHeightは34あるにも拘わらず
 Dim channel As Rectangleで取得できる値は4になってしまっているのですが、
これはなぜでしょうか？

あと、

                    Dim ticWidth As Double = seekWidth / (TrackBar1.Maximum - TrackBar1.Minimum)
                    TrackBar1.Value = CInt((x - 8) / ticWidth) + TrackBar1.Minimum

のあたりはどのようにすれば良いですか？

値の変更の仕方やMinimum、Maximumの取得の仕方が分からないのですが。。。

2019/11/16(Sat) 22:17:50 編集(投稿者)

<pre><pre>■No93046 (小次郎 さん) に返信

No93034とほぼ同じですが、継承コントロールとして実装してみました。
WndProcをOverridesしてメッセージを自前で処理するというような事は、
今回の場合は必要ないと思います。

【追記】-----------------------------------------------------------
OrientationプロパティがVerticalの場合やRightToLeftプロパティがYesは考慮していません。
これらも考慮するなら、OnMouseDownメソッド内で目盛領域を取得して、
座標の大小判定を場合分けすれば良いと思います。
-------------------------------------------------------------------

Public Class TrackBarEx
    Inherits TrackBar
    Private oldValue As Integer
    Private channel As Rectangle
    Private Structure RECT
        Public left, top, right, bottom As Integer
    End Structure
    <DllImport("user32.dll", EntryPoint:="SendMessage")>
    Private Shared Function SendMessageRect(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByRef lp As RECT) As IntPtr
    End Function
    Private Function GetChanelRectangle() As Rectangle
        Const TBM_GETCHANNELRECT As Integer = &H400 + 26
        Dim rc As RECT = New RECT()
        SendMessageRect(Handle, TBM_GETCHANNELRECT, IntPtr.Zero, rc)
        Return New Rectangle(rc.left, rc.top, rc.right - rc.left, rc.bottom - rc.top)
    End Function
    Protected Overrides Sub OnHandleCreated(e As EventArgs)
        MyBase.OnHandleCreated(e)
        oldValue = Minimum
        Value = Minimum
        channel = GetChanelRectangle()
    End Sub
    Private Sub TrackBarValueCheck()
        If oldValue <> Value Then
            MyBase.OnValueChanged(New EventArgs)
            oldValue = Value
        End If
    End Sub
    Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
        If e.X < channel.Left Then
            Value = Minimum
        ElseIf e.X > channel.Right Then
            Value = Maximum
        Else
            Dim ticWidth As Double = channel.Width / (Maximum - Minimum)
            Value = CInt((e.X - channel.Left) / ticWidth) + Minimum
        End If
    End Sub
    Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
        TrackBarValueCheck()
    End Sub
    Protected Overrides Sub OnKeyUp(e As KeyEventArgs)
        TrackBarValueCheck()
    End Sub
    Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
        TrackBarValueCheck()
    End Sub
    Protected Overrides Sub OnValueChanged(e As EventArgs)
    End Sub
End Class

呼び出し側では
 　Private Sub TrackBarEx1_ValueChanged(sender As Object, e As EventArgs) Handles TrackBarEx1.ValueChanged
        Debug.WriteLine($"ValueChanged: Value=【{TrackBarEx1.Value}】")
' 計算処理
    End Sub
</pre></pre>

返答がないので間違いだけ修正。

VB の既定の設定では整数オーバーフローのチェックが入っているので

    Public Function SignedHIWORD(ByVal n As IntPtr) As Integer
        Dim tmp As Byte() = BitConverter.GetBytes(n.ToInt64())
        Return SignedHIWORD(BitConverter.ToInt32(tmp, 0))
    End Function

    Public Function SignedHIWORD(ByVal n As Integer) As Integer
        Dim tmp As Byte() = BitConverter.GetBytes(n >> 16 And &HFFFF)
        Return BitConverter.ToInt16(tmp, 0)
    End Function

    Public Function SignedLOWORD(ByVal n As IntPtr) As Integer
        Dim tmp As Byte() = BitConverter.GetBytes(n.ToInt64())
        Return SignedLOWORD(BitConverter.ToInt32(tmp, 0))
    End Function

    Public Function SignedLOWORD(ByVal n As Integer) As Integer
        Dim tmp As Byte() = BitConverter.GetBytes(n And &HFFFF)
        Return BitConverter.ToInt16(tmp, 0)
    End Function

のようにしないとダメっぽいです。

ありがとうございます。


SignedHIWORDに関してですが、元のコードでも動作していますが、
何が違いますか？


いまのところ、以下のコードで動作しています。


        Protected Overrides Sub WndProc(ByRef m As Message)

            If m.Msg = WM_LBUTTONDOWN Then

                Dim x As Integer = SignedLOWORD(m.LParam)
                Dim y As Integer = SignedHIWORD(m.LParam)


                Dim channel As Rectangle = GetChanelRectangle()

                Dim TrackBar1_Maximum As Integer = GetRangeMax()
                Dim TrackBar1_Minimum As Integer = GetRangeMin()

                If x < channel.Left Then

                    Call SetSliderPosi(TrackBar1_Minimum)

                ElseIf x > channel.Right Then

                    Call SetSliderPosi(TrackBar1_Maximum)

                Else

                    Dim ticWidth As Double = channel.Width / (TrackBar1_Maximum - TrackBar1_Minimum)
                    Dim SetPosi As Integer = CInt((x - channel.Left) / ticWidth) + TrackBar1_Minimum
                    Call SetSliderPosi(SetPosi)

                End If

                Call frm.TrackBar1_ValueChanged(frm.TrackBar1, Nothing)


                m.Result = IntPtr.Zero
                Return
            ElseIf m.Msg = WM_LBUTTONUP Then

                Dim ggg = 0


            ElseIf m.Msg = WM_MOUSEMOVE Then


                If (Control.MouseButtons And MouseButtons.Left) = MouseButtons.Left Then

                Else

                    m.Result = IntPtr.Zero
                    Return

                End If

            End If
            MyBase.WndProc(m)
        End Sub



ただ、問題は、スライダーをドラッグ操作できないことです。

マウスボタンが押されたとき、押された位置がつまみなら普通の処理、
そうでなければ上記のコードを実行したいのですが、
つまみの上かどうかはどのようにして判定したら良いですか？

地道に、現在位置のつまみの位置を求めて、現在のつまみの位置と比較するしかないですか？
Tickの刻みが細かい場合には良いですが
荒い場合には、ずれてしまうと思うのですが。


あと、別の質問ページでも質問させていただきましたが、

    Private Sub TrackBar1_ValueChanged(sender As Object, e As EventArgs) Handles TrackBar1.ValueChanged

		' 計算処理

    End Sub

のところで、処理が重い場合に、
マウスをアップしたとしても
ElseIf m.Msg = WM_LBUTTONUP Then
が実行されない場合がある現象が起きています。

つまり、マウスから手を離していてもドラッグしていると認識されて、スライダーがマウスカーソルにひっついてきます。

そのため、対症療法的ですが、
            ElseIf m.Msg = WM_MOUSEMOVE Then


                If (Control.MouseButtons And MouseButtons.Left) = MouseButtons.Left Then

                Else

                    m.Result = IntPtr.Zero
                    Return

                End If

で対処しているのですが、
 If m.Msg = WM_LBUTTONDOWN Then

を実行した後に、マウスアップを自分で実行するにはどうしたら良いですか？

全てのコードを書くなら以下も必要です。

        Private Sub SetSliderPosi(Posi%)
            SendMessage(Me.Handle, TBM_SETPOS, 1, Posi)
        End Sub



        Private Function GetRangeMax() As Integer
            Return CInt(SendMessage(Me.Handle, TBM_GETRANGEMAX, Nothing, Nothing))
        End Function


        Private Function GetRangeMin() As Integer
            Return CInt(SendMessage(Me.Handle, TBM_GETRANGEMIN, Nothing, Nothing))
        End Function