我正在做一个需要标签的项目。我讨厌默认的 VB.NET tabcontrol 的外观。基本上我想要带有纯色的选项卡控件，并且选项卡标题更大。
所以要求是：
- 选项卡头的高度必须更大，并且
- 选项卡头文本必须有填充（居中）
- 选项卡头必须是纯色并具有纯色悬停颜色。
- 选项卡必须能够隐藏。
现在，我找到了一个自定义选项卡控件。我使用它，但问题是如果文本较大，TabHeads 不会扩展。它们是固定宽度。我想我会使用较小的列标题，这很好。
但是在做了一些工作之后，我意识到这可能不是最好的解决方案，因为它有一个奇怪的背景覆盖了边框，看起来有点奇怪。当文本为粗体时，如果足够长，会触及选项卡的边缘，这看起来很奇怪。最后，我无法隐藏标签。
所以，我想知道你们是否知道我可以 a) 重载当前选项卡控件，并简单地将选项卡标题设为纯色、更宽并带有填充文本。或 b) 找到一个可以完成所有这些的自定义选项卡控件。
这是我到目前为止所拥有的：
Imports System.Drawing.Drawing2D, System.IO
'------------------------------------------------- 'TabControlDesigner ' '创作者：Eprouvez '更新时间：6/ 6/2012 '日期：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
结束区域
结束类
类绽放
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 类继承 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
结束类