giovedì 3 novembre 2011

[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.



2 commenti:

Lorenzo ha detto...

Salve questo è quello che mi serviva per il mio proggetto, la mia unica difficolta, dato che sono alle prime armi, sta nel capire cosa devo fare con questo codice, dove va inserito.

Se mi puo contattare via email mi farebbe un'enorme piacere. La mia mail è: l.santoro@live.it

MarcoGG ha detto...

Ciao Lorenzo. Rispondo volentieri con chiarimenti e approfondimenti sulla mia Pagina FaceBook :
https://www.facebook.com/pages/MarcoGG/176216775722284
Basta una semplice registrazione ( anche "anonima" ) e un Click su "Mi Piace". Rispondere in privato ad ogni utente nella sua rispettiva Mail, o su Skype, o quant'altro, NON è nello spirito di questo Blog. :)

Posta un commento

 
Design by Free WordPress Themes Modificato da MarcoGG