1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Formulaire
  5. Griser les onglets en vb.net

Griser les onglets en vb.net

Soyez le premier à donner votre avis sur cette source.

Vue 6 003 fois - Téléchargée 384 fois

Télécharger le projet
Commenter

Description

On ne peut pas griser les onglets dans le framework .Net, alors voilà une classe qui permet de le faire.

Pour l'utiliser, au moment de la création de la fenêtre, créez un l'objet suivant :
TabControl1_Grisage = New GrisageOnglets(TabControl1)

Pour griser un onglet, utilisez l'objet créé :
TabControl1_Grisage.Griser(TabPage1)

Ensuite vous pouvez griser les onglets. Si vous voulez désactiver le grisage, vous pouvez alors effectuer :
TabControl1_Grisage.Dispose()
TabControl1_Grisage = Nothing

Source / Exemple : 


Imports System.Runtime.InteropServices

Public Class GrisageOnglets
    Implements IDisposable

    Private Const Erreur_OngletActif As String = "L'onglet actif ne peut pas être grisé"
    Private Const Erreur_Personnalisé As String = "L'affichage des onglets est déjà personnalisé"

    Public TexteOngletNormal As Brush = SystemBrushes.ControlText
    Public TexteOngletSélectionné As Brush = SystemBrushes.ControlText
    Public TexteOngletGrisé As Brush = SystemBrushes.GrayText

    Dim oOnglets As TabControl
    Dim oOngletsGrisés As New List(Of TabPage)

    Private StringFormatSansBug As StringFormat = StringFormat.GenericTypographic

    Sub New(ByVal Onglets As TabControl)
        If Onglets.DrawMode = TabDrawMode.OwnerDrawFixed Then
            Throw New Exception(Erreur_Personnalisé)
        End If
        oOnglets = Onglets
        AddHandler Onglets.Selecting, AddressOf TabControl_Selecting
        AddHandler Onglets.DrawItem, AddressOf TabControl_DrawItem
        Onglets.DrawMode = TabDrawMode.OwnerDrawFixed
    End Sub

    Private Sub TabControl_Selecting(ByVal sender As System.Object, ByVal e As System.Windows.Forms.TabControlCancelEventArgs)
        If e.Action = TabControlAction.Selecting And oOngletsGrisés.Contains(e.TabPage) Then
            e.Cancel = True
        End If
    End Sub

    Private Sub TabControl_DrawItem(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DrawItemEventArgs)
        Dim Onglet As TabPage = oOnglets.TabPages(e.Index)
        Dim Texte As String = Onglet.Text
        Dim TailleTexte As SizeF = e.Graphics.MeasureString(Texte, e.Font, New PointF(e.Bounds.Left, e.Bounds.Top), StringFormatSansBug)
        Dim Icône As Image = oOnglets.ImageList.Images(Onglet.ImageKey)
        Dim LargeurImage As Integer
        If Icône Is Nothing Then LargeurImage = 0 Else LargeurImage = Icône.Width
        Dim Départ As PointF = New Point(e.Bounds.Left + LargeurImage + (e.Bounds.Width - LargeurImage - TailleTexte.Width) / 2, e.Bounds.Top + 3)
        Dim DépartImage As PointF = New Point(Départ.X - LargeurImage - 3, Départ.Y)
        If Icône IsNot Nothing Then
            If Icône.Height > TailleTexte.Height Then
                Départ.Y = Départ.Y + (Icône.Height - TailleTexte.Height) / 2
                DépartImage.Y = e.Bounds.Top + 2
            ElseIf Icône.Height < TailleTexte.Height Then
                DépartImage.Y = DépartImage.Y + (TailleTexte.Height - Icône.Height) / 2
            End If
        End If

        If e.State And DrawItemState.Selected = DrawItemState.Selected Then
            e.Graphics.DrawImage(Icône, DépartImage)
            e.Graphics.DrawString(Texte, e.Font, TexteOngletSélectionné, Départ, StringFormatSansBug)
            e.Graphics.DrawLine(SystemPens.Control, e.Bounds.Left, e.Bounds.Bottom - 2, e.Bounds.Right, e.Bounds.Bottom - 2)
        ElseIf oOngletsGrisés.Contains(Onglet) Then
            Dim ImageGrisée As Bitmap = GriserImage(Icône)
            e.Graphics.DrawImage(ImageGrisée, DépartImage)
            ImageGrisée.Dispose()
            e.Graphics.DrawString(Texte, e.Font, TexteOngletGrisé, Départ, StringFormatSansBug)
        Else
            e.Graphics.DrawImage(Icône, DépartImage)
            e.Graphics.DrawString(Texte, e.Font, TexteOngletNormal, Départ, StringFormatSansBug)
        End If

    End Sub

    Sub Griser(ByVal Page As TabPage)
        If Not oOngletsGrisés.Contains(Page) Then
            If Page Is oOnglets.SelectedTab Then
                Throw New Exception(Erreur_OngletActif)
            End If
            oOngletsGrisés.Add(Page)
            oOnglets.Invalidate()
        End If
    End Sub

    Sub Dégriser(ByVal Page As TabPage)
        If oOngletsGrisés.Contains(Page) Then
            oOngletsGrisés.Remove(Page)
            oOnglets.Invalidate()
        End If
    End Sub

    Sub Inverser(ByVal Page As TabPage)
        If oOngletsGrisés.Contains(Page) Then
            Dégriser(Page)
        Else
            Griser(Page)
        End If
    End Sub

    Property EstGrisé(ByVal Page As TabPage) As Boolean
        Get
            Return oOngletsGrisés.Contains(Page)
        End Get
        Set(ByVal value As Boolean)
            If value Then
                Griser(Page)
            Else
                Dégriser(Page)
            End If
        End Set
    End Property

    ''' <summary>
    ''' Grise une image avec transparence. Merci à tkfe.
    ''' </summary>
    Shared Function GriserImage(ByVal UneImage As Image) As Bitmap
        Dim bitmap As Bitmap = New Bitmap(UneImage)

        Dim width As Integer = bitmap.Width
        Dim height As Integer = bitmap.Height

        'Lockbits des images initial et résultat
        Dim bmpData As Imaging.BitmapData = bitmap.LockBits(New Rectangle(0, 0, width, height) _
        , System.Drawing.Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppArgb)

        'Copie des pixels dans un tableau contenant tous les composantes Bleu, vert, rouge, alpha
        Dim Pixel(width * height - 1) As Integer '4 octets = 4 composantes = 1 pixel
        Marshal.Copy(bmpData.Scan0, Pixel, 0, Pixel.Length)

        Dim loc, x, y, gray As Integer

        'tables de precalcul des multiplications pour le calcul de localisation des pixels
        'de l'ancienne image et de la nouvelle.
        Dim multi(height - 1) As Integer

        For y = 0 To height - 1
            multi(y) = width * y
        Next

        'tables de precalcul des multiplications pour le calcul du niveau de gris
        Dim tabBleu(255) As Integer
        Dim tabVert(255) As Integer
        Dim tabRouge(255) As Integer

        'Initialisation
        For y = 0 To 255
            tabBleu(y) = 76 * y
            tabVert(y) = 151 * y
            tabRouge(y) = 28 * y
        Next

        For y = 0 To height - 1

            For x = 0 To width - 1
                'calcul de la localisation du pixel
                loc = multi(y) + x
                'on calcule le niveau de gris sur 255
                'Formule ci-dessous en commentaires, à éviter car coûteuse
                'CByte(0.3 * oldPixel(loc) + 0.59 * oldPixel(loc + 1) + 0.11 * oldPixel(loc + 2))

                'on affecte le niveau de gris au pixel dans la nouvelle image
                gray = (tabBleu(Pixel(loc) And &HFF) + tabVert((Pixel(loc) And &HFF00) >> 8) + tabRouge((Pixel(loc) And &HFF0000) >> 16)) >> 8
                Pixel(loc) = gray + (gray << 8) + (gray << 16) + ((Pixel(loc) >> 1) And &H7F000000)
            Next

        Next

        'on recopie notre nouveau tableau dans la nouvelle image
        Marshal.Copy(Pixel, 0, bmpData.Scan0, Pixel.Length)
        bitmap.UnlockBits(bmpData)
        Return bitmap
    End Function

    Private disposedValue As Boolean = False        ' Pour détecter les appels redondants

    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                ' TODO : libérez des ressources managées en cas d'appel explicite
            End If

            ' TODO : libérez des ressources non managées partagées
            RemoveHandler oOnglets.Selecting, AddressOf TabControl_Selecting
            RemoveHandler oOnglets.DrawItem, AddressOf TabControl_DrawItem
            oOnglets.DrawMode = TabDrawMode.Normal
            oOnglets.Invalidate()
            oOnglets = Nothing
        End If
        Me.disposedValue = True
    End Sub

#Region " IDisposable Support "
    ' Ce code a été ajouté par Visual Basic pour permettre l'implémentation correcte du modèle pouvant être supprimé.
    Public Sub Dispose() Implements IDisposable.Dispose
        ' Ne modifiez pas ce code. Ajoutez du code de nettoyage dans Dispose(ByVal disposing As Boolean) ci-dessus.
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
#End Region

End Class

Conclusion :


Le résultat est satisfaisant. Cela dit, lorsque l'on met les onglets en mode dessin personnalisé, le rendu se fait à la mode Windows 95.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (circular)