| ■No96251 (KOZ) に返信
> TrackBar で動作するか未確認ですが、
> 「WM_PAINTでTextBoxがちらつく」
> https://social.msdn.microsoft.com/Forums/ja-JP/d5ac1426-1082-43a1-a02f-677dad1ee3ca/wmpaint12391textbox1236412385124251238812367?forum=csharpgeneralja
> のように、ビットマップから hdc を作成し、WM_PAINT の WPARAM にセットしてやるとコントロールが描画をしてくれるので、それを加工して表示する、といった方法が使えるかもしれません。
うまくいったかも。
Imports System.Runtime.InteropServices
Public Class TrackBarEx
Inherits TrackBar
Private Const WM_PAINT As Integer = &HF
Private Const WM_ERASEBKGND As Integer = &H14
Private Const WM_USER As Integer = &H400
Private Const TBM_GETPOS As Integer = WM_USER 'スライダーの位置を取得
Private Const TBM_GETRANGEMIN As Integer = WM_USER + 1 'スライダーの位置の最小位置の取得
Private Const TBM_GETRANGEMAX As Integer = WM_USER + 2 'スライダーの位置の最大位置の取得
Private Const TBM_GETTIC As Integer = WM_USER + 3 '特定のチックマークの位置を取得
Private Const TBM_SETTIC As Integer = WM_USER + 4 '特定のチックマークの位置を設定
Private Const TBM_SETPOS As Integer = WM_USER + 5 'スライダーの位置を設定
Private Const TBM_SETRANGE As Integer = WM_USER + 6 'スライダー位置の可変範囲の設定
Private Const TBM_SETRANGEMIN As Integer = WM_USER + 7 'スライダー位置の可変範囲の最小値の設定
Private Const TBM_SETRANGEMAX As Integer = WM_USER + 8 'スライダー位置の可変範囲の最大値の設定
Private Const TBM_CLEARTICS As Integer = WM_USER + 9 '現在のチックマークを削除
Private Const TBM_SETSEL As Integer = WM_USER + 10 'チックマークの選択範囲の設定
Private Const TBM_SETSELSTART As Integer = WM_USER + 11 'チックマークの選択範囲の終了値の設定
Private Const TBM_SETSELEND As Integer = WM_USER + 12 'チックマークの選択範囲の開始値の設定
Private Const TBM_GETPTICS As Integer = WM_USER + 14 'チックマーク位置を示す配列を指すポインタの取得
Private Const TBM_GETTICPOS As Integer = WM_USER + 15 'チックマークの物理位置の取得
Private Const TBM_GETNUMTICS As Integer = WM_USER + 16 'チックマークの数の取得
Private Const TBM_GETSELSTART As Integer = WM_USER + 17 '選択範囲の開始位置の取得
Private Const TBM_GETSELEND As Integer = WM_USER + 18 '選択範囲の終了位置の取得
Private Const TBM_CLEARSEL As Integer = WM_USER + 19 '選択範囲の解除
Private Const TBM_SETTICFREQ As Integer = WM_USER + 20 'チックマークの間隔の設定
Private Const TBM_SETPAGESIZE As Integer = WM_USER + 21 'ページサイズの設定
Private Const TBM_GETPAGESIZE As Integer = WM_USER + 22 'ページサイズの取得
Private Const TBM_SETLINESIZE As Integer = WM_USER + 23 'ラインサイズの設定
Private Const TBM_GETLINESIZE As Integer = WM_USER + 24 'ラインサイズの取得
Private Const TBM_GETTHUMBRECT As Integer = WM_USER + 25 'つまみの境界矩形の取得
Private Const TBM_GETCHANNELRECT As Integer = WM_USER + 26 'スライダーが動くチャンネルの境界矩形の取得
Private Const TBM_SETTHUMBLENGTH As Integer = WM_USER + 27 'つまみの長さの設定
Private Const TBM_GETTHUMBLENGTH As Integer = WM_USER + 28 'つまみの長さの取得
Private Structure RECT
Public Left, Top, Right, Bottom As Integer
Public ReadOnly Property Width As Integer
Get
Return Right - Left
End Get
End Property
Public ReadOnly Property Height As Integer
Get
Return Bottom - Top
End Get
End Property
Public Shared Widening Operator CType(ByVal r As RECT) As Rectangle
Return Rectangle.FromLTRB(r.Left, r.Top, r.Right, r.Bottom)
End Operator
End Structure
<StructLayout(LayoutKind.Sequential)>
Private Structure PAINTSTRUCT
Public hdc As IntPtr
Public fErase As Boolean
Public rcPaint As RECT
Public fRestore As Boolean
Public fIncUpdate As Boolean
Public reserved1 As Integer
Public reserved2 As Integer
Public reserved3 As Integer
Public reserved4 As Integer
Public reserved5 As Integer
Public reserved6 As Integer
Public reserved7 As Integer
Public reserved8 As Integer
End Structure
<DllImport("user32.dll")>
Private Shared Function BeginPaint(ByVal hWnd As HandleRef,
ByRef lpPaint As PAINTSTRUCT) As IntPtr
End Function
<DllImport("user32.dll")>
Private Shared Function EndPaint(ByVal hWnd As HandleRef,
ByRef lpPaint As PAINTSTRUCT) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Shared Function SendMessage(ByVal hWnd As HandleRef,
ByVal Msg As Integer,
ByVal wParam As IntPtr,
ByRef rect As RECT) As IntPtr
End Function
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_PAINT
Using bmp As New Bitmap(ClientSize.Width, ClientSize.Height)
Using bmpGraphics = Graphics.FromImage(bmp)
Dim bmphdc = bmpGraphics.GetHdc()
Dim msg = Message.Create(m.HWnd, WM_PAINT, bmphdc, IntPtr.Zero)
MyBase.WndProc(msg)
bmpGraphics.ReleaseHdc()
Using pe As New PaintEventArgs(bmpGraphics, ClientRectangle)
CustomDraw(pe)
End Using
End Using
If m.WParam = IntPtr.Zero Then
Dim hWnd As New HandleRef(Me, m.HWnd)
Dim ps As New PAINTSTRUCT()
Dim controlHdc = BeginPaint(hWnd, ps)
Using controlGraphics = Graphics.FromHdc(controlHdc)
controlGraphics.DrawImage(bmp, 0, 0)
End Using
EndPaint(hWnd, ps)
Else
Using controlGraphics = Graphics.FromHdc(m.WParam)
controlGraphics.DrawImage(bmp, 0, 0)
End Using
End If
End Using
Case WM_ERASEBKGND
'無視
Case Else
MyBase.WndProc(m)
End Select
End Sub
Protected Overridable Sub CustomDraw(e As PaintEventArgs)
'チャネルおよびつまみの領域を取得
Dim channel As New RECT()
Dim thumb As New RECT()
Dim hWnd As New HandleRef(Me, Me.Handle)
SendMessage(hWnd, TBM_GETCHANNELRECT, IntPtr.Zero, channel)
SendMessage(hWnd, TBM_GETTHUMBRECT, IntPtr.Zero, thumb)
' チャネルおよびつまみの領域を背景色で塗りつぶす
Using b As New SolidBrush(BackColor)
e.Graphics.FillRectangle(b, New Rectangle(channel.Left, thumb.Top, channel.Width, thumb.Height))
End Using
'チャネルを描く
e.Graphics.FillRectangle(Brushes.Black, channel)
If thumb.Left > channel.Left Then
'つまみの左側を塗りつぶす
Dim leftchannel As New Rectangle(channel.Left, channel.Top, thumb.Left - channel.Left, channel.Height)
e.Graphics.FillRectangle(Brushes.Red, leftchannel)
End If
e.Graphics.DrawRectangle(Pens.White, channel)
'つまみを描く
e.Graphics.FillEllipse(Brushes.White, thumb)
e.Graphics.DrawEllipse(Pens.Black, thumb)
End Sub
Protected Overrides Sub OnValueChanged(e As EventArgs)
MyBase.OnValueChanged(e)
MyBase.Invalidate()
End Sub
End Class
|