地区“例程”

Question

我正在开发一个需要标签的项目。我讨厌默认的VB.NET tabcontrol外观。基本上我希望tabcontrol具有纯色，标签标题更大。

所以要求是：

-Tab头的高度必须更大，并且有 -Tab头文本必须有填充（居中）
-Tab头必须是纯色并具有坚实的悬停颜色 -Tabs必须能够被隐藏。

现在，我找到了一个自定义标签控件。我用它，但问题是如果文本较大，TabHeads不会展开。它们是固定的宽度。我想我会使用较小的列标题，这很好。

但是在做完工作之后，我意识到它可能不是最好的解决方案，因为它有一个覆盖边界的奇怪背景，看起来有点奇怪。当文本为粗体时，如果足够长，则触摸选项卡的边缘，这看起来很奇怪。最后，我无法隐藏标签。

所以，我想知道你们是否知道我可以a）重载当前的标签控件，只需使标签头变成纯色，更宽，并带有填充文本。或b）找到一个自定义选项卡控件，完成所有这些操作。

这是我到目前为止所做的：

enter image description here

Imports System.Drawing.Drawing2D, System.IO

“------------------------------------- “TabControlDesigner “ '创作者：Eprouvez '更新时间：2012年6月6日 '日期：2012年6月5日 '版本：1.1.1 “ '致记： “Aeonhack “mavamaarten “ “更新： '修复了创建控件时ColorHook无法正常工作的错误 “--------------------------------------

MustInherit类TabControlDesigner 继承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

结束地区

结束班

Class Bloom

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

Class BlueTabControl 继承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

结束班

Answer 1

找到完成所有这些操作的自定义标签控件。

以下page包含自定义标签控件的源代码

VB.NET WinForm TabControl

地区“例程”

结束地区

地区“挂钩”

结束地区

区域“属性”

结束地区

地区“财产助手”

结束地区

区域“绘图方法”

结束地区

区域“覆盖方法”

结束地区

1 个答案: