Le titre parle de lui-même je pense. Si toutefois, vous avez des questions n'hésitez pas à me les poser.
Créer un usercontrol et copier le code ci-dessous dans le user control. Bon amusement!
Source / Exemple :
Option Explicit
' ****************************************************************************
' *** CONTROLE IconLabel ******************************************* v1.00 ***
' ****************************************************************************
' *** DESCRIPTION: ***
' ***----------------------------------------------------------------------***
' *** Label avec icône (comme dans Outlook). ***
' ****************************************************************************
' *** PROPRIETES: ***
' ***----------------------------------------------------------------------***
' *** [RW] BackColor ***
' *** [RW] BorderSize ***
' *** [RW] Caption ***
' *** [RW] CaptionAlignment ***
' *** [RW] Enabled ***
' *** [RW] Font ***
' *** [RW] ForeColor ***
' *** [RW] Icon ***
' *** [RW] IconAlignment ***
' *** [RW] IconStretch ***
' ****************************************************************************
' *** EVENEMENTS: ***
' ***----------------------------------------------------------------------***
' *** -= C'est un label ... =- ***
' ****************************************************************************
' *** 1.00: Première version. ***
' ****************************************************************************
' *** (c) 2000 FlyKiller. All Rights Reserved. Can Be Distributed Freely. ***
' ****************************************************************************
Private Const P_BC As String = "BackColor"
Private Const P_BS As String = "BorderSize"
Private Const P_C As String = "Caption"
Private Const P_CA As String = "CaptionAlignment"
Private Const P_F As String = "Font"
Private Const P_FC As String = "ForeColor"
Private Const P_I As String = "Icon"
Private Const P_IA As String = "IconAlignment"
Private Const P_IS As String = "IconStretch"
Public Enum ilIconAlignments
iliaLeft = 0
iliaRight = 1
End Enum
Public Enum ilCaptionAlignments
ilcaLeft = 0
ilcaCenter = 1
ilcaRight = 2
End Enum
Private mBS As Integer ' Propriété BorderSize
Private mC As String ' Propriété Caption
Private mCA As ilCaptionAlignments ' Propriété CaptionAlignment
Private mI As IPictureDisp ' Propriété Icon
Private mIA As ilIconAlignments ' Propriété IconAlignment
Private mIS As Boolean ' Propriété IconStretch
' ****************************************************************************
' *** PROPRIETE BackColor ****************************************************
' ****************************************************************************
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal RHS As OLE_COLOR)
UserControl.BackColor = RHS
UserControl.PropertyChanged P_BC
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE BorderSize ***************************************************
' ****************************************************************************
Public Property Get BorderSize() As Integer
BorderSize = mBS
End Property
Public Property Let BorderSize(ByVal RHS As Integer)
mBS = RHS
UserControl.PropertyChanged P_BS
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE Caption ******************************************************
' ****************************************************************************
Public Property Get Caption() As String
Caption = mC
End Property
Public Property Let Caption(ByVal RHS As String)
mC = RHS
UserControl.PropertyChanged P_C
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE CaptionAlignment *********************************************
' ****************************************************************************
Public Property Get CaptionAlignment() As ilCaptionAlignments
CaptionAlignment = mCA
End Property
Public Property Let CaptionAlignment(ByVal RHS As ilCaptionAlignments)
mCA = RHS
UserControl.PropertyChanged P_CA
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE Font *********************************************************
' ****************************************************************************
Public Property Get Font() As IFontDisp
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal RHS As IFontDisp)
Set UserControl.Font = RHS
UserControl.PropertyChanged P_F
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE ForeColor ****************************************************
' ****************************************************************************
Public Property Get ForeColor() As OLE_COLOR
ForeColor = UserControl.ForeColor
End Property
Public Property Let ForeColor(ByVal RHS As OLE_COLOR)
UserControl.ForeColor = RHS
UserControl.PropertyChanged P_FC
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE Icon *********************************************************
' ****************************************************************************
Public Property Get Icon() As IPictureDisp
Set Icon = mI
End Property
Public Property Set Icon(ByVal RHS As IPictureDisp)
Set mI = RHS
UserControl.PropertyChanged P_I
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE IconAlignment ************************************************
' ****************************************************************************
Public Property Get IconAlignment() As ilIconAlignments
IconAlignment = mIA
End Property
Public Property Let IconAlignment(ByVal RHS As ilIconAlignments)
mIA = RHS
UserControl.PropertyChanged P_IA
UserControl.Refresh
End Property
' ****************************************************************************
' *** PROPRIETE IconStretch **************************************************
' ****************************************************************************
Public Property Get IconStretch() As Boolean
IconStretch = mIS
End Property
Public Property Let IconStretch(ByVal RHS As Boolean)
mIS = RHS
UserControl.PropertyChanged P_IS
UserControl.Refresh
End Property
' ****************************************************************************
' *** SUB InitProperties *****************************************************
' ****************************************************************************
Private Sub UserControl_InitProperties()
' UserControl.BackColor = .ReadProperty(P_BC, UserControl.BackColor)
mBS = 2
mC = ""
mCA = ilCaptionAlignments.ilcaLeft
' Set UserControl.Font = .ReadProperty(P_F, UserControl.Font)
' UserControl.ForeColor = .ReadProperty(P_FC, UserControl.ForeColor)
Set mI = Nothing
mIA = ilIconAlignments.iliaLeft
mIS = True
End Sub
' ****************************************************************************
' *** SUB Paint **************************************************************
' ****************************************************************************
Private Sub UserControl_Paint()
Dim SH As Single ' UserControl - ScaleHeight
Dim SW As Single ' UserControl - ScaleWidth
Dim IL As Single ' Icon - Left
Dim IT As Single ' Icon - Top
Dim IW As Single ' Icon - Width
Dim IH As Single ' Icon - Height
Dim ZF As Single ' Zoom Factor: si IH < UC.ScaleHeight + (MBS*2)
Dim CL As Single ' Caption - Left
Dim CT As Single ' Caption - Top
Dim CW As Single ' Caption - Width
Dim CH As Single ' Caption - Height
With UserControl
SH = .ScaleHeight
SW = .ScaleWidth
' ==========================================================================
' === Dessiner l'icône =====================================================
' ==========================================================================
If Not (mI Is Nothing) Then
IW = .ScaleX(mI.Width, vbHimetric, .ScaleMode)
IH = .ScaleY(mI.Height, vbHimetric, .ScaleMode)
If ((SH - (mBS * 2)) < IH) And (mIS = True) Then
ZF = (SH - (mBS * 2)) / IH
IH = IH * ZF
IW = IW * ZF
IT = mBS
Else
IT = (SH - IH) / 2
End If
If mIA = iliaLeft Then
IL = mBS
Else
IL = SW - (IW + mBS)
End If
.PaintPicture mI, IL, IT, IW, IH
End If
' ========================================================================
' === Dessiner le texte ==================================================
' ========================================================================
If Len(mC) > 0 Then
CW = .TextWidth(mC)
CH = .TextHeight(mC)
CT = (SH - CH) / 2
If mCA = ilcaLeft Then
If mIA = iliaLeft Then
CL = IL + IW + mBS
Else
CL = mBS
End If
ElseIf mCA = ilcaCenter Then
CL = (SW - CW) / 2
Else
If mIA = iliaRight Then
CL = SW - (IW + CW + mBS * 2)
Else
CL = SW - (CW + mBS)
End If
End If
.CurrentX = CL
.CurrentY = CT
Print mC
End If
End With
End Sub
' ****************************************************************************
' *** SUB ReadProperties *****************************************************
' ****************************************************************************
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
UserControl.BackColor = .ReadProperty(P_BC, UserControl.BackColor)
mBS = .ReadProperty(P_BS, 2)
mC = .ReadProperty(P_C, "")
mCA = .ReadProperty(P_CA, ilCaptionAlignments.ilcaLeft)
Set UserControl.Font = .ReadProperty(P_F, UserControl.Font)
UserControl.ForeColor = .ReadProperty(P_FC, UserControl.ForeColor)
Set mI = .ReadProperty(P_I, Nothing)
mIA = .ReadProperty(P_IA, ilIconAlignments.iliaLeft)
mIS = .ReadProperty(P_IS, True)
End With
End Sub
' ****************************************************************************
' *** SUB WriteProperties ****************************************************
' ****************************************************************************
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
.WriteProperty P_BC, UserControl.BackColor
.WriteProperty P_BS, mBS
.WriteProperty P_C, mC
.WriteProperty P_CA, mCA
.WriteProperty P_F, UserControl.Font
.WriteProperty P_FC, UserControl.ForeColor
.WriteProperty P_I, mI
.WriteProperty P_IA, mIA
.WriteProperty P_IS, mIS
End With
End Sub
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.