[VB.NET] Controllo TabControl Personalizzato

Descrizione :
Un mio TabControl personalizzato che include un pulsante di chiusura rapida su ogni TabPage esistente o creata ex-novo, e la possibilità di colorare come si desidera le "linguette" delle schede e i relativi titoli, distinguendo tra scheda selezionata e non.

+ Articolo :

1. La Classe GTabControl.vb :

Public Class GTabControl
    Inherits TabControl

#Region "Membri Interni"

    'Membri Interni N.A.
    Private m_bmpw As Integer = 16
    Private m_bmph As Integer = 16
    Private m_bmpfocuson As Bitmap 'Bitmap chiusura su TabPage attiva
    Private m_bmpfocusoff As Bitmap 'Bitmap chiusura su TabPage NON attiva
    Private m_bmpmover As Bitmap 'Bitmap chiusura su TabPage attiva + MouseOver
    Private m_coordbmp As New Point(20, 5)
    Private m_paddingtitolo As Integer = 5
    Private m_coloretpdefault As Color = Color.FromKnownColor(KnownColor.Control)

    'Membri Interni Properties
    Private m_coloretestotitoloon As Color = Color.Black
    Private m_coloretestotitolooff As Color = Color.DimGray
    Private m_coloresfondotitoloon As Color = Color.White
    Private m_coloresfondotitolooff As Color = Color.LightGray

#End Region

#Region "Proprietà"

    Public Property ColoreTestoTitoloOn() As Color
        Get
            Return m_coloretestotitoloon
        End Get
        Set(ByVal value As Color)
            m_coloretestotitoloon = value
            Me.Refresh()
        End Set
    End Property

    Public Property ColoreTestoTitoloOff() As Color
        Get
            Return m_coloretestotitolooff
        End Get
        Set(ByVal value As Color)
            m_coloretestotitolooff = value
            Me.Refresh()
        End Set
    End Property

    Public Property ColoreSfondoTitoloOn() As Color
        Get
            Return m_coloresfondotitoloon
        End Get
        Set(ByVal value As Color)
            m_coloresfondotitoloon = value
            Me.Refresh()
        End Set
    End Property

    Public Property ColoreSfondoTitoloOff() As Color
        Get
            Return m_coloresfondotitolooff
        End Get
        Set(ByVal value As Color)
            m_coloresfondotitolooff = value
            Me.Refresh()
        End Set
    End Property

    Public Overrides Property Font() As System.Drawing.Font
        Get
            Return MyBase.Font
        End Get
        Set(ByVal value As System.Drawing.Font)
            MyBase.Font = value
            RidimensionaTitoli()
        End Set
    End Property

#End Region

    Public Sub New()

        'DrawMode / SizeMode per ridisegno / ridimensionamento personalizzati
        Me.DrawMode = TabDrawMode.OwnerDrawFixed
        Me.SizeMode = TabSizeMode.Fixed
        RidimensionaTitoli()
        'Handler per ridisegno delle TabPages con TabDrawMode.OwnerDrawFixed
        AddHandler Me.DrawItem, AddressOf Ridisegna

        'Creazione Bitmap pulsanti chiusura
        CreaBmpChiusura()

        'Colore TabPages Default
        For Each TP As TabPage In Me.TabPages
            TP.BackColor = m_coloretpdefault
        Next

    End Sub

#Region "Metodi"

    Private Sub RidimensionaTitoli()

        Dim titoloWMax As Integer = 0
        Dim titoloHMax As Integer = 0
        Dim szfTitolo As SizeF
        For Each TP As TabPage In Me.TabPages
            szfTitolo = TP.CreateGraphics.MeasureString(TP.Text, Me.Font)
            If titoloWMax < szfTitolo.Width Then titoloWMax = szfTitolo.Width
            If titoloHMax < szfTitolo.Height Then titoloHMax = szfTitolo.Height
        Next
        titoloWMax += m_bmpw + m_paddingtitolo * 2
        titoloHMax += m_paddingtitolo * 2
        Me.ItemSize = New Size(titoloWMax, titoloHMax)

    End Sub

    Private Sub Ridisegna(ByVal sender As Object, ByVal e As System.Windows.Forms.DrawItemEventArgs)

        'Disegno Titoli
        Dim brushTitoloOn As Brush = New SolidBrush(m_coloretestotitoloon)
        Dim brushTitoloOff As Brush = New SolidBrush(m_coloretestotitolooff)
        Dim brushSfondoOn As Brush = New SolidBrush(m_coloresfondotitoloon)
        Dim brushSfondoOff As Brush = New SolidBrush(m_coloresfondotitolooff)
        Dim R As Rectangle = Me.GetTabRect(e.Index)
        Dim titoloTP As String = Me.TabPages(e.Index).Text
        If e.State = DrawItemState.Selected Then
            e.Graphics.FillRectangle(brushSfondoOn, R)
            e.Graphics.DrawString(titoloTP, Me.Font, brushTitoloOn, New PointF(R.X + m_paddingtitolo, R.Y + m_paddingtitolo))
        Else
            e.Graphics.FillRectangle(brushSfondoOff, R)
            e.Graphics.DrawString(titoloTP, Me.Font, brushTitoloOff, New PointF(R.X + m_paddingtitolo, R.Y + m_paddingtitolo))
        End If

        'Disegno Bmp Chiusura
        If e.State = DrawItemState.Selected Then
            e.Graphics.DrawImage(m_bmpfocuson, New Point(R.X + R.Width - m_coordbmp.X, m_coordbmp.Y))
        Else
            e.Graphics.DrawImage(m_bmpfocusoff, New Point(R.X + R.Width - m_coordbmp.X, m_coordbmp.Y))
        End If

    End Sub

    Private Sub CreaBmpChiusura()

        'Creazione Bitmap pulsanti chiusura
        'bmpfocuson + bmpfocusoff + bmpmover
        Dim penBordo As New Pen(Color.Black, 1)
        m_bmpfocuson = New Bitmap(m_bmpw, m_bmph)
        m_bmpfocusoff = New Bitmap(m_bmpw, m_bmph)
        m_bmpmover = New Bitmap(m_bmpw, m_bmph)
        Dim P1 As New Point(penBordo.Width + 1, penBordo.Width + 1)
        Dim P2 As New Point(m_bmpw - penBordo.Width - 2, penBordo.Width + 1)
        Dim P3 As New Point(m_bmpw - penBordo.Width - 2, m_bmph - penBordo.Width - 2)
        Dim P4 As New Point(penBordo.Width + 1, m_bmph - penBordo.Width - 2)

        'bmpfocuson
        Dim brushSfondoFocusOn As Brush = Brushes.White
        Dim penFocusOn As New Pen(Color.Red, 2)
        Using G As Graphics = Graphics.FromImage(m_bmpfocuson)
            'Sfondo
            G.FillRectangle(brushSfondoFocusOn, m_bmpfocuson.GetBounds(GraphicsUnit.Pixel))
            'Contorno
            G.DrawRectangle(penBordo, 0, 0, m_bmpw - penBordo.Width, m_bmph - penBordo.Width)
            'Simbolo X
            G.DrawLine(penFocusOn, P1, P3)
            G.DrawLine(penFocusOn, P2, P4)
        End Using

        'bmpfocusoff
        Dim brushSfondoFocusOff As Brush = Brushes.LightGray
        Dim penFocusOff As New Pen(Color.DimGray, 2)
        Using G As Graphics = Graphics.FromImage(m_bmpfocusoff)
            G.FillRectangle(brushSfondoFocusOff, m_bmpfocusoff.GetBounds(GraphicsUnit.Pixel))
            G.DrawRectangle(penBordo, 0, 0, m_bmpw - penBordo.Width, m_bmph - penBordo.Width)
            G.DrawLine(penFocusOff, P1, P3)
            G.DrawLine(penFocusOff, P2, P4)
        End Using

        'bmpmover
        Dim brushSfondoMover As Brush = Brushes.Red
        Dim penMover As New Pen(Color.White, 2)
        Using G As Graphics = Graphics.FromImage(m_bmpmover)
            G.FillRectangle(brushSfondoMover, m_bmpmover.GetBounds(GraphicsUnit.Pixel))
            G.DrawRectangle(penBordo, 0, 0, m_bmpw - penBordo.Width, m_bmph - penBordo.Width)
            G.DrawLine(penMover, P1, P3)
            G.DrawLine(penMover, P2, P4)
        End Using

    End Sub

    Protected Overrides Sub OnMouseClick(ByVal e As System.Windows.Forms.MouseEventArgs)

        Dim R As Rectangle = Me.GetTabRect(Me.SelectedIndex)
        Dim rectBmp As New Rectangle(New Point(R.X + R.Width - m_coordbmp.X, m_coordbmp.Y), New Size(m_bmpw, m_bmph))
        If rectBmp.Contains(e.Location) Then
            Dim TP As TabPage = DirectCast(Me.TabPages.Item(Me.SelectedIndex), TabPage)
            Me.TabPages.Remove(TP)
            TP.Dispose()
            RidimensionaTitoli()
        End If

    End Sub

    Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)

        Try
            Dim R As Rectangle = Me.GetTabRect(Me.SelectedIndex)
            Dim rectBmp As New Rectangle(New Point(R.X + R.Width - m_coordbmp.X, m_coordbmp.Y), New Size(m_bmpw, m_bmph))
            If rectBmp.Contains(e.Location) Then
                Me.CreateGraphics.DrawImage(m_bmpmover, New Point(R.X + R.Width - m_coordbmp.X, m_coordbmp.Y))
            Else
                Me.CreateGraphics.DrawImage(m_bmpfocuson, New Point(R.X + R.Width - m_coordbmp.X, m_coordbmp.Y))
            End If
        Catch ex As Exception
        End Try

    End Sub

    Protected Overrides Sub OnControlAdded(ByVal e As System.Windows.Forms.ControlEventArgs)

        e.Control.BackColor = m_coloretpdefault
        MyBase.OnControlAdded(e)
        RidimensionaTitoli()

    End Sub

#End Region

End Class

Ho commentato abbastanza chiaramente il codice della Classe, perciò non credo ci sia bisogno di ulteriori spiegazioni.
Aggiungo solo che, come è evidente, le 3 Bitmap di chiusura vengono disegnate sul Controllo in automatico, perciò non c'è alcun bisogno di caricarle da file esterni.
Inoltre una volta compilato, è possibile aggiungere come al solito il Controllo a Design, e le 4 proprietà che impostano i colori sono già disponibili in fase di progettazione.

2. Form di Test :
Allego anche il codice della Form di Test che ho usato io in progettazione.
La notazione è già abbastanza esplicativa, e sono evidenti i controlli utilizzati, perciò evito di farne una lista : suffissi cmd_ per i Button / lbl_ per le Label / txt_ per la TextBox.

--> Codice per FormTest.vb :

Public Class FormTest

    Private Sub FormTest_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        lbl_clrtbselez.BackColor = GTabControl1.ColoreSfondoTitoloOn
        lbl_clrtbnonselez.BackColor = GTabControl1.ColoreSfondoTitoloOff
        lbl_clrttlselez.BackColor = GTabControl1.ColoreTestoTitoloOn
        lbl_clrttlnonselez.BackColor = GTabControl1.ColoreTestoTitoloOff

    End Sub

    Private Sub cmd_sceglifont_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd_sceglifont.Click

        Dim FD As New FontDialog()
        FD.Font = GTabControl1.Font
        Try
            If FD.ShowDialog() = DialogResult.OK Then GTabControl1.Font = FD.Font
        Catch ex As Exception
            MessageBox.Show("Font non valido.", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        End Try

    End Sub

    Private Sub cmd_nuovatp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd_nuovatp.Click

        Try
            GTabControl1.TabPages.Add(txt_titolonuovatp.Text)
        Catch ex As Exception
            MessageBox.Show("Titolo TabPage non valido.", "Errore", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        End Try

    End Sub

    Private Sub lbl_clrtbselez_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl_clrtbselez.Click

        Dim CD As New ColorDialog
        CD.Color = GTabControl1.ColoreSfondoTitoloOn
        If CD.ShowDialog() = DialogResult.OK Then
            lbl_clrtbselez.BackColor = CD.Color
            GTabControl1.ColoreSfondoTitoloOn = CD.Color
        End If

    End Sub

    Private Sub lbl_clrtbnonselez_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl_clrtbnonselez.Click

        Dim CD As New ColorDialog
        CD.Color = GTabControl1.ColoreSfondoTitoloOff
        If CD.ShowDialog() = DialogResult.OK Then
            lbl_clrtbnonselez.BackColor = CD.Color
            GTabControl1.ColoreSfondoTitoloOff = CD.Color
        End If

    End Sub

    Private Sub lbl_clrttlselez_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl_clrttlselez.Click

        Dim CD As New ColorDialog
        CD.Color = GTabControl1.ColoreTestoTitoloOn
        If CD.ShowDialog() = DialogResult.OK Then
            lbl_clrttlselez.BackColor = CD.Color
            GTabControl1.ColoreTestoTitoloOn = CD.Color
        End If

    End Sub

    Private Sub lbl_clrttlnonselez_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl_clrttlnonselez.Click

        Dim CD As New ColorDialog
        CD.Color = GTabControl1.ColoreTestoTitoloOff
        If CD.ShowDialog() = DialogResult.OK Then
            lbl_clrttlnonselez.BackColor = CD.Color
            GTabControl1.ColoreTestoTitoloOff = CD.Color
        End If

    End Sub

End Class

L'Applicazione di Test permette di valutare il comportamento di GTabControl, e in particolare di come il dimensionamento delle parti avvenga automaticamente al cambiare del testo :

Il dimensionamento delle "linguette" è automatico : tutte le TabPages si adattano alla dimensione di quella con ingombro massimo, e il box di chiusura si sposta, mantenendo sempre una posizione Top-Right, rispetto alla scheda.

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Posted in: VB.NET