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

わんくま同盟

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

■100126 / 2階層)  タブコントロールに閉じるボタン
□投稿者/ KOZ (256回)-(2022/07/05(Tue) 16:44:30)
No100124 (KOZ) に返信
> 面倒すぎるのでサンプルを書く気にはなりません。ごめんなさい。

とは書きましたが、Alignment = Top 固定の手抜き実装で書いてみました。
マウスのトラッキングはしていないのですが、意外にスムーズに見えます。

Imports System.ComponentModel
Imports System.Runtime.InteropServices

Public Class TabControlEx
    Inherits TabControl

    Protected ButtonFont As New Font("Marlett", 6)
    Protected CloseButtonChar As String = "r"

    Protected Overrides Sub Dispose(disposing As Boolean)
        MyBase.Dispose(disposing)
        ButtonFont.Dispose()
    End Sub

    ' Alignment プロパティを隠す
    <Browsable(False)>
    <EditorBrowsable(False)>
    <DesignerSerializationVisibility(False)>
    Public Shadows Property Alignment As TabAlignment

    ' ボタンの枠を求める
    Protected Overridable Function GetTabButtonRect(index As Integer) As Rectangle
        ' 小さいキャプション ボタンのサイズと TabItem の高さでサイズを調整
        Dim tmpSize As Size = SystemInformation.ToolWindowCaptionButtonSize
        Dim itemHeight As Integer = ((ItemSize.Height - 5) \ 2) * 2
        If tmpSize.Height < itemHeight Then
            itemHeight = tmpSize.Height
        End If
        Dim buttonSize As New Size(itemHeight, itemHeight)
        ' 位置を調整
        Dim tabRect As Rectangle = GetTabRect(index)
        Dim buttonLeft As Integer = tabRect.Right - buttonSize.Width - 2
        Dim buttonTop As Integer = (tabRect.Height - buttonSize.Height) \ 2
        ' 選択されていないタブはちょっと小さい
        If index <> SelectedIndex Then
            buttonLeft -= 2
            buttonTop += 2
        End If
        Return New Rectangle(New Point(buttonLeft, buttonTop), buttonSize)
    End Function

    ' ボタンを描画
    Protected Overridable Sub DrawButton(g As Graphics, index As Integer)
        Dim buttonRect As Rectangle = GetTabButtonRect(index)
        g.FillRectangle(Brushes.Red, buttonRect)
        Dim fmt As New StringFormat With {
            .FormatFlags = StringFormatFlags.NoClip,
            .Alignment = StringAlignment.Center,
            .LineAlignment = StringAlignment.Center
        }
        g.DrawString(CloseButtonChar, ButtonFont, Brushes.White, buttonRect, fmt)
    End Sub

    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 g As Graphics = Graphics.FromImage(bmp)
                        ' コントロールを Bitmap に描画
                        Dim dc As IntPtr = g.GetHdc()
                        Dim msg As Message = Message.Create(m.HWnd, m.Msg, dc, m.LParam)
                        MyBase.WndProc(msg)
                        g.ReleaseHdc(dc)

                        ' Bitmap にボタンを上書き
                        For index As Integer = 0 To TabCount - 1
                            Dim mouseClientPos As Point = PointToClient(MousePosition)
                            Dim tabRect As Rectangle = GetTabRect(index)
                            ' アクティブな TabPage またはマウス下の TabPage に描画する
                            If index = SelectedIndex OrElse tabRect.Contains(mouseClientPos) Then
                                DrawButton(g, index)
                            End If
                        Next
                    End Using

                    If m.WParam = IntPtr.Zero Then
                        ' コントロールに描画
                        Dim ps As New PAINTSTRUCT()
                        Dim hdc As IntPtr = BeginPaint(m.HWnd, ps)
                        Using g As Graphics = Graphics.FromHdc(hdc)
                            g.DrawImage(bmp, Point.Empty)
                        End Using
                        EndPaint(m.HWnd, ps)
                    Else
                        ' WParam に渡された hdc に描画
                        Using g As Graphics = Graphics.FromHdc(m.WParam)
                            g.DrawImage(bmp, Point.Empty)
                        End Using
                    End If
                End Using
            Case Else
                MyBase.WndProc(m)
        End Select
    End Sub

    Protected Overrides Sub OnClick(e As EventArgs)
        MyBase.OnClick(e)
        ' マウスの位置がボタン上なら、そのタブを消す
        Dim mouseClientPos As Point = PointToClient(MousePosition)
        For index As Integer = 0 To TabCount - 1
            Dim btnRect As Rectangle = GetTabButtonRect(index)
            If btnRect.Contains(mouseClientPos) Then
                TabPages.RemoveAt(index)
                Exit For
            End If
        Next
    End Sub

    Private Const WM_PAINT As Integer = &HF

    <StructLayout(LayoutKind.Sequential)>
    Private Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=4)>
    Private Structure PAINTSTRUCT
        Public hdc As IntPtr
        Public fErase As Integer
        Public rcPaint As RECT
        Public fRestore As Integer
        Public fIncUpdate As Integer
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)>
        Public rgbReserved As Byte()
    End Structure

    <DllImport("user32.dll")>
    Private Shared Function BeginPaint(ByVal hwnd As IntPtr, <Out()> ByRef lpPaint As PAINTSTRUCT) As IntPtr
    End Function

    <DllImport("user32.dll")>
    Private Shared Function EndPaint(ByVal hwnd As IntPtr, <[In]()> ByRef lpPaint As PAINTSTRUCT) As IntPtr
    End Function

End Class

編集キー/

前の記事(元になった記事) 次の記事(この記事の返信)
←Re[1]: タブコントロールに閉じるボタン /KOZ →Re[3]: タブコントロールに閉じるボタン /ガンダーラ
 
上記関連ツリー

タブコントロールに閉じるボタン / ガンダーラ (22/07/05(Tue) 00:03) #100121
Re[1]: タブコントロールに閉じるボタン / くま (22/07/05(Tue) 01:26) #100122
Re[1]: タブコントロールに閉じるボタン / KOZ (22/07/05(Tue) 05:10) #100124
  └ タブコントロールに閉じるボタン / KOZ (22/07/05(Tue) 16:44) #100126 ←Now
    └ Re[3]: タブコントロールに閉じるボタン / ガンダーラ (22/07/07(Thu) 06:48) #100144
      └ Re[4]: タブコントロールに閉じるボタン / KOZ (22/07/07(Thu) 08:30) #100147 解決済み

上記ツリーを一括表示 / 上記ツリーをトピック表示
 
上記の記事へ返信