Top / .NET備忘録 / 99.小ネタ / 20.TabControlのタブに色をつける

TabControl のタブに色を付けたい、というときは、DrawMode プロパティをTabDrawMode.OwnerDrawFixed にして DrawItem イベントで描画するといいのですが、枠などが 3D っぽくなって、いまいちキレイでありません。

しょうがないので SSTab の互換コントロールを作った時には、すべてオーナードローしてしまったのですが、もうちょっと簡単にならないかなーと考えてみたのがこちら。

TabPage の Text プロパティにはスペースをセットして(タブ幅設定のため)描画したあと、 文字のみあとから描画します。

Option Strict On
Imports System.Runtime.InteropServices

Public Class TabPainter
    Inherits NativeWindow

    Private ReadOnly _owner As TabControl

    Public Sub New(owner As TabControl)
        _owner = owner
        AddHandler owner.HandleCreated, AddressOf Owner_HandleCreated
        If owner.IsHandleCreated Then
        End If
        For i As Integer = 0 To owner.TabPages.Count - 1
            ' TabPage の Text プロパティを Tag プロパティにセット
            ' Text プロパティは同幅以上になるスペースをセット
            Dim page As TabPage = owner.TabPages(i)
            Dim tabText As String = page.Text
            Dim tabSize As SizeF = TextRenderer.MeasureText(tabText, owner.Font)
            Dim spacer As New Text.StringBuilder()
                Dim spacerSize As SizeF = TextRenderer.MeasureText(spacer.ToString(), owner.Font)
                If spacerSize.Width >= tabSize.Width Then Exit Do
                spacer.Append(" "c)
            page.Tag = tabText
            page.Text = spacer.ToString()
    End Sub

    Private Sub Owner_HandleCreated(sender As Object, e As EventArgs)
        AssignHandle(DirectCast(sender, Control).Handle)
    End Sub

    Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case NativeMethods.WM_NCDESTROY
            Case NativeMethods.WM_PAINT
            Case Else
        End Select
    End Sub

    Private Sub WmPaint(ByRef m As Message)
        Dim cs As Size = _owner.ClientSize
        If cs.Width > 0 AndAlso cs.Height > 0 Then
            Using bmp As New Bitmap(cs.Width, cs.Height)
                Using g As Graphics = Graphics.FromImage(bmp)
                    ' bitmap に描画してもらう
                    Dim bmphdc As IntPtr = g.GetHdc()
                    Dim msg As Message = Message.Create(m.HWnd, NativeMethods.WM_PAINT, bmphdc, IntPtr.Zero)
                    ' Tab のテキストを Tag プロパティから描画
                    For i As Integer = 0 To _owner.TabPages.Count - 1
                        Dim rect As Rectangle = _owner.GetTabRect(i)
                        Dim page As TabPage = _owner.TabPages(i)
                        Dim tabText As String = page.Tag?.ToString()
                        Dim foreColor As Color = If(page.Enabled, page.ForeColor, SystemColors.ControlDark)
                        Dim flags As TextFormatFlags =
                                                TextFormatFlags.HorizontalCenter Or
                        TextRenderer.DrawText(g, tabText, _owner.Font, rect, foreColor, flags)
                End Using
                If m.WParam = IntPtr.Zero Then
                    ' コントロールに Bitmap を描画
                    Dim ps As New NativeMethods.PAINTSTRUCT()
                    Dim hdc As IntPtr = NativeMethods.BeginPaint(m.HWnd, ps)
                    Using g As Graphics = Graphics.FromHdc(hdc)
                        g.DrawImage(bmp, 0, 0)
                    End Using
                    NativeMethods.EndPaint(m.HWnd, ps)
                    ' WParam に渡された HDC に Bitmap を描画
                    Using g As Graphics = Graphics.FromHdc(m.WParam)
                        g.DrawImage(bmp, 0, 0)
                    End Using
                End If
            End Using
        End If
    End Sub

    Friend Class NativeMethods

        Private Sub New()
        End Sub

        Public Const WM_PAINT As Integer = &HF
        Public Const WM_NCDESTROY As Integer = &H82

        Public Structure PAINTSTRUCT
            Public hdc As IntPtr
            Public rcPaint_left As Integer
            Public rcPaint_top As Integer
            Public rcPaint_right As Integer
            Public rcPaint_bottom As Integer
            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

        Public Shared Function BeginPaint(hwnd As IntPtr, ByRef ps As PAINTSTRUCT) As IntPtr
        End Function

        Public Shared Function EndPaint(hwnd As IntPtr, ByRef ps As PAINTSTRUCT) As IntPtr
        End Function

    End Class

End Class


Public Class Form1

    Private painter As TabPainter

    Public Sub New()

        Dim tabCtrl As New TabControl
        tabCtrl.Dock = DockStyle.Fill
        For i As Integer = 1 To 3
            Dim page As New TabPage()
            Select Case i
                Case 1
                    page.ForeColor = Color.Red
                Case 2
                    page.Enabled = False
                Case 3
                    page.ForeColor = Color.Blue
            End Select
            page.Text = "TabPage" & i.ToString()
            page.UseVisualStyleBackColor = True
        painter = New TabPainter(tabCtrl)
    End Sub

End Class

表示する文字を Tab プロパティに保持していますが、List(Of String) に格納したほうがよかったかも。

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2019-07-23 (火) 14:56:47 (352d)