.net - VB.NET WinForm タブ コントロール

Question

タブが必要なプロジェクトに取り組んでいます。デフォルトの VB.NET タブコントロールの外観が嫌いです。基本的に、無地のタブコントロールとタブヘッダーを大きくしたかったのです。

したがって、要件は次のとおりです。

-タブ ヘッドの高さは大きく、-
タブ ヘッドのテキストにはパディングが必要です (中央揃え)
-タブ ヘッドは単色で、ホバー色も単色である必要があります。
-タブは非表示にできる必要があります。

さて、カスタム タブ コントロールを見つけました。使ってみたのですが、文字が大きいとTabHeadsが展開しないのが難点です。それらは固定幅です。小さい列ヘッダーを使用すると考えましたが、それで問題ありません。

しかし、回避策を実行した後、それが最善の解決策ではない可能性があることに気付きました。これは、境界線を覆う奇妙な背景があり、奇妙に見えるからです。テキストが太字の場合、十分に長い場合、タブの端に触れてしまい、奇妙に見えます。最後に、タブを非表示にすることはできません。

だから、私ができることを皆さんが知っているかどうか疑問に思っています。a）現在のタブコントロールをオーバーロードし、タブヘッドを単色で幅が広く、テキストが埋め込まれているようにします。または b) このすべてを実行するカスタム タブ コントロールを見つけます。

これは私がこれまでに持っているものです:

Imports System.Drawing.Drawing2D, System.IO

'-------------------------------------- 'TabControlDesigner' '作成者: Eprouvez' 更新日: 6/ 2012 年 6 月 '日付: 2012 年 6 月 5 日 'バージョン: 1.1.1' 'クレジット: 'Aeonhack 'mavamaarten' '更新: 'コントロールが作成されたときに ColorHook が正しく機能しないバグを修正しました'--- -----------------------------------

MustInherit クラス TabControlDesigner Inherits TabControl

Protected G As Graphics
Protected State As MouseState
Protected Coordinates As Point

Enum MouseState As Integer
    None = 0
    Over = 1
    Down = 2
End Enum

リージョン「ルーチン」

Sub New()
    SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint Or ControlStyles.DoubleBuffer Or ControlStyles.SupportsTransparentBackColor, True)
    DoubleBuffered = True
    SizeMode = TabSizeMode.Fixed
    ItemSize = New Size(250, 26)
End Sub

Sub SetState(ByVal current As MouseState)
    State = current
    Invalidate()
End Sub

エンドリージョン

リージョン " フック "

Protected MustOverride Sub TabPaint(ByVal Index As Integer)

Protected MustOverride Sub ColorHook()
Protected Overridable Sub PaintHook()
End Sub

エンドリージョン

領域 " プロパティ "

Private _InactiveIconOpacity As Integer = 50
Public Property InactiveIconOpacity As Integer
    Get
        Return _InactiveIconOpacity
    End Get
    Set(ByVal value As Integer)
        If IsNothing(value) Then value = 50
        If value < 0 Then value = 0
        If value > 100 Then value = 100
        _InactiveIconOpacity = value
    End Set
End Property

Private _PanelColor As Color
Public Property PanelColor() As Color
    Get
        Return _PanelColor
    End Get
    Set(ByVal value As Color)
        _PanelColor = value
    End Set
End Property

Private Items As New Dictionary(Of String, Color)
Property Colors() As Bloom()
    Get
        Dim T As New List(Of Bloom)
        Dim E As Dictionary(Of String, Color).Enumerator = Items.GetEnumerator

        While E.MoveNext
            T.Add(New Bloom(E.Current.Key, E.Current.Value))
        End While

        Return T.ToArray
    End Get
    Set(ByVal value As Bloom())
        For Each B As Bloom In value
            If Items.ContainsKey(B.Name) Then Items(B.Name) = B.Color
        Next

        InvalidateCustimization()
        ColorHook()
        Invalidate()
    End Set
End Property

Private _Customization As String
Property Customization() As String
    Get
        Return _Customization
    End Get
    Set(ByVal value As String)
        If value = _Customization Then Return

        Dim Data As Byte()
        Dim Items As Bloom() = Colors

        Try
            Data = Convert.FromBase64String(value)
            For I As Integer = 0 To Items.Length - 1
                Items(I).Color = Color.FromArgb(BitConverter.ToInt32(Data, I * 4))
            Next
        Catch
            Return
        End Try

        _Customization = value

        Colors = Items
        ColorHook()
        Invalidate()
    End Set
End Property

エンドリージョン

リージョン " プロパティ ヘルパー "

'Credits to Aeonhack
Protected Function GetPen(ByVal name As String) As Pen
    Return New Pen(Items(name))
End Function
Protected Function GetPen(ByVal name As String, ByVal width As Single) As Pen
    Return New Pen(Items(name), width)
End Function
Protected Function GetBrush(ByVal name As String) As SolidBrush
    Return New SolidBrush(Items(name))
End Function
Protected Function GetColor(ByVal name As String) As Color
    Return Items(name)
End Function
Protected Sub SetColor(ByVal name As String, ByVal value As Color)
    If Items.ContainsKey(name) Then Items(name) = value Else Items.Add(name, value)
End Sub
Protected Sub SetColor(ByVal name As String, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
    SetColor(name, Color.FromArgb(r, g, b))
End Sub
Protected Sub SetColor(ByVal name As String, ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
    SetColor(name, Color.FromArgb(a, r, g, b))
End Sub
Protected Sub SetColor(ByVal name As String, ByVal a As Byte, ByVal value As Color)
    SetColor(name, Color.FromArgb(a, value))
End Sub
Private Sub InvalidateCustimization()
    Dim M As New MemoryStream(Items.Count * 4)

    For Each B As Bloom In Colors
        M.Write(BitConverter.GetBytes(B.Color.ToArgb), 0, 4)
    Next

    M.Close()
    _Customization = Convert.ToBase64String(M.ToArray)
End Sub

エンドリージョン

領域「描画方法」

Function Measure(ByVal Text As String) As SizeF
    Return G.MeasureString(Text, Font)
End Function
Function Measure(ByVal Text As String, ByVal Font As Font) As SizeF
    Return G.MeasureString(Text, Font)
End Function
Function Center(ByVal Text As String, ByVal Area As Rectangle) As Point
    Return Center(Text, Font, Area)
End Function
Function Center(ByVal Text As String, ByVal Font As Font, ByVal Area As Rectangle) As Point
    Return Center(Text, Font, Area, 0, 0)
End Function
Function Center(ByVal Text As String, ByVal Font As Font, ByVal Area As Rectangle, ByVal XOffset As Integer, ByVal YOffset As Integer) As Point
    Dim M = Measure(Text, Font)
    Return New Point(CInt(Area.X + Area.Width / 2 - M.Width / 2) + XOffset, CInt(Area.Y + Area.Height / 2 - M.Height / 2) + YOffset)
End Function
Function ToPen(ByVal color As Color) As Pen
    Return New Pen(color)
End Function
Function ToPen(ByVal color As Color, ByVal width As Single) As Pen
    Return New Pen(color, width)
End Function
Function ToBrush(ByVal color As Color) As Brush
    Return New SolidBrush(color)
End Function
Function RGB(ByVal Red As Integer, ByVal Green As Integer, ByVal Blue As Integer) As Color
    Return Color.FromArgb(Red, Green, Blue)
End Function
Function ARGB(ByVal Alpha As Integer, ByVal color As Color) As Color
    Return color.FromArgb(Alpha, color)
End Function
Function ARGB(ByVal Alpha As Integer, ByVal Red As Integer, ByVal Green As Integer, ByVal Blue As Integer) As Color
    Return Color.FromArgb(Alpha, Red, Green, Blue)
End Function
Function Shrink(ByVal rectangle As Rectangle, ByVal Offset As Integer) As Rectangle
    Return Shrink(rectangle, Offset, True)
End Function
Function Shrink(ByVal rectangle As Rectangle, ByVal Offset As Integer, ByVal CenterPoint As Boolean) As Rectangle
    Dim O = If(CenterPoint = True, Offset, 0)
    Dim R = New Rectangle(rectangle.X + O, rectangle.Y + O, rectangle.Width - Offset * 2, rectangle.Height - Offset * 2)
    Return R
End Function
Function Enlarge(ByVal rectangle As Rectangle, ByVal Offset As Integer) As Rectangle
    Return Enlarge(rectangle, Offset, True)
End Function
Function Enlarge(ByVal rectangle As Rectangle, ByVal Offset As Integer, ByVal CenterPoint As Boolean) As Rectangle
    Dim O = If(CenterPoint = True, Offset, 0)
    Dim R = New Rectangle(rectangle.X - O, rectangle.Y - O, rectangle.Width + Offset * 2, rectangle.Height + Offset * 2)
    Return R
End Function
Function ImageOpacity(ByVal Image As Bitmap, ByVal Opacity As Single) As Image
    Dim Result As New Bitmap(Image.Width, Image.Height, Imaging.PixelFormat.Format32bppArgb)
    With Image
        Opacity = Math.Min(Opacity, 100)
        Using Attributes As New Imaging.ImageAttributes
            Dim Matrix As New Imaging.ColorMatrix
            Matrix.Matrix33 = Opacity / 100.0F
            Attributes.SetColorMatrix(Matrix)
            Dim Points() As PointF = {New Point(0, 0), New Point(.Width, 0), New Point(0, .Height)}
            Using I As Graphics = Graphics.FromImage(Result)
                I.Clear(Color.Transparent)
                I.DrawImage(Image, Points, New RectangleF(Point.Empty, .Size), GraphicsUnit.Pixel, Attributes)
            End Using
        End Using
    End With
    Return Result
End Function

エンドリージョン

リージョン「メソッドのオーバーライド」

Protected Overrides Sub CreateHandle()
    MyBase.CreateHandle()
    MyBase.DoubleBuffered = True
    InvalidateCustimization()
    ColorHook()
    SizeMode = TabSizeMode.Fixed
    SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint Or ControlStyles.DoubleBuffer Or ControlStyles.SupportsTransparentBackColor, True)
End Sub

Protected Overrides Sub OnHandleCreated(ByVal e As System.EventArgs)
    ColorHook()
    MyBase.OnHandleCreated(e)
End Sub

Protected Overrides Sub OnMouseEnter(ByVal e As System.EventArgs)
    SetState(MouseState.Over)
    MyBase.OnMouseHover(e)
End Sub
Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs)
    SetState(MouseState.None)
    For I As Integer = 0 To TabPages.Count - 1
        If TabPages(I).DisplayRectangle.Contains(Coordinates) Then
            MyBase.Invalidate()
            Exit For
        End If
    Next
    MyBase.OnMouseHover(e)
End Sub
Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
    Coordinates = e.Location
    For I As Integer = 0 To TabPages.Count - 1
        If TabPages(I).DisplayRectangle.Contains(Coordinates) Then
            MyBase.Invalidate()
            Exit For
        End If
    Next
    MyBase.OnMouseMove(e)
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
    G = e.Graphics

    If Not IsNothing(_PanelColor) Then G.FillRectangle(ToBrush(_PanelColor), e.ClipRectangle)

    PaintHook()

    For I As Integer = 0 To TabPages.Count - 1
        TabPaint(I)
    Next
End Sub

エンドリージョン

クラス終了

クラスブルーム

Sub New(ByVal Name As String, ByVal Color As Color)
    _Name = Name
    _Value = Color
End Sub
Sub New(ByVal Name As String, ByVal Red As Integer, ByVal Green As Integer, ByVal Blue As Integer)
    _Name = Name
    _Value = Color.FromArgb(Red, Green, Blue)
End Sub
Sub New(ByVal Name As String, ByVal Alpha As Integer, ByVal Red As Integer, ByVal Green As Integer, ByVal Blue As Integer)
    _Name = Name
    _Value = Color.FromArgb(Alpha, Red, Green, Blue)
End Sub

Private _Name As String
Public ReadOnly Property Name() As String
    Get
        Return _Name
    End Get
End Property

Private _Value As Color
Public Property Color() As Color
    Get
        Return _Value
    End Get
    Set(ByVal value As Color)
        _Value = value
    End Set
End Property

クラス終了

System.Drawing.Drawing2D をインポートします

クラス BlueTabControl Inherits TabControlDesigner

Private C1, C2, C3, C4, C5, C6 As Color
Private L1, L2 As LinearGradientBrush

Sub New()
    C1 = Color.WhiteSmoke 'Panel Color
    C2 = RGB(13, 55, 110) 'Line Color
    C3 = RGB(148, 212, 255) 'Highlight
    C4 = RGB(214, 245, 255) 'Unselected Tab #1
    C5 = Color.WhiteSmoke 'Unselected Tab #2
    C6 = RGB(13, 55, 110) 'Tab Line

    Alignment = TabAlignment.Top
    Font = New Font("Verdana", 8S)
    ItemSize = New Size(130, 30)
    PanelColor = Color.Transparent

    For I As Integer = 0 To TabPages.Count - 1
        TabPages(I).BackColor = C1
    Next

End Sub

Protected Overrides Sub TabPaint(ByVal e As Integer)
    Dim Text = TabPages(e).Text
    Dim Tab = GetTabRect(e)
    Dim Temp = New Rectangle(Tab.X + 1, Tab.Y + 1, Tab.Width - 6, Tab.Height + If(SelectedIndex = e, 1, 0))
    Dim Highlight = New Rectangle(Temp.X, Temp.Y, Temp.Width, 10)
    Dim Outline = New Point() {New Point(Temp.X, Temp.Bottom), New Point(Temp.X, Temp.Top), New Point(Temp.Right, Temp.Top), New Point(Temp.Right, Temp.Bottom)}

    L1 = New LinearGradientBrush(Highlight, C3, C3, 90S)
    L2 = New LinearGradientBrush(Temp, C5, C5, 90S)

    If SelectedIndex = e Then
        Try : TabPages(e).BackColor = C1 : Catch : End Try
        G.FillRectangle(ToBrush(C1), Temp)
    ElseIf State = MouseState.Over AndAlso Temp.Contains(Coordinates) Then
        G.FillRectangle(L1, Temp)
    Else
        G.FillRectangle(L2, Temp)
    End If

    G.DrawLines(ToPen(C2), Outline)
    If SelectedIndex = e Then
        G.DrawString(Text, New Font("Verdana", 8S, FontStyle.Bold), Brushes.Black, Center(Text, Font, Temp, 0, 0))
    Else
        G.DrawString(Text, New Font("Verdana", 8S), Brushes.Black, Center(Text, Font, Temp, 0, 0))
    End If

End Sub


Protected Overrides Sub PaintHook()
    Dim Outline = New Point() {New Point(ClientRectangle.X + 3, ClientRectangle.Y + 34), _
                               New Point(ClientRectangle.X + 3, ClientRectangle.Bottom - 4), _
                               New Point(ClientRectangle.Right - 4, ClientRectangle.Bottom - 4), _
                               New Point(ClientRectangle.Right - 4, ClientRectangle.Top + 34)}
    G.DrawLines(ToPen(C6), Outline)
    G.DrawLine(ToPen(C6), 4, 33, Width - 4, 33)
End Sub


Protected Overrides Sub ColorHook()

End Sub

Private Sub InitializeComponent()
    Me.SuspendLayout()
    '
    'BlueTabControl
    '
    Me.Colors = New ResourcesManagement.Bloom(-1) {}
    Me.ResumeLayout(False)

End Sub

クラス終了