SUPRALABEL (LABEL AVEC SON OMBRE OCX)

'Déclaration d'un type d'énumération
Public Enum Horizontal
    Gauche = 1
    Droite = 2
    Centre = 3
End Enum
Public Enum Vertical
    Haut = 1
    Bas = 2
    Centre = 3
End Enum

'Variables
Dim Ctrl_Caption As String          'Texte a écrire
Dim Ctrl_AlignementH As Horizontal  'Alignement Horizontal
Dim Ctrl_AlignementV As Vertical    'Alignement Vertical
Dim Ctrl_Font_Color As OLE_COLOR    'Couleur De La Police
Dim Ctrl_Ombre_Color As OLE_COLOR   'Couleur De l'Ombre
Dim Ctrl_Back_Color As OLE_COLOR    'Couleur De Fond
Dim Ctrl_OmbreH As Integer          'Distance entre le texte et son ombre
Dim Ctrl_OmbreV As Integer          'Distance entre le texte et son ombre
Dim Ctrl_Ombre As Boolean           'Afficher ombre
Dim Ctrl_ClickMove As Boolean       'Effet lors du clique
Dim ClickMoveClk As Boolean         'Clique bas de la sourie

'Constantes
Const Def_Ctrl_AlignementH = 1
Const Def_Ctrl_AlignementV = 1
Const Def_Ctrl_Font_Color = &H80000012
Const Def_Ctrl_Ombre_Color = &HC0C0C0
Const Def_Ctrl_Back_Color = &H8000000F
Const Def_Ctrl_OmbreH = 30
Const Def_Ctrl_OmbreV = 30
Const Def_Ctrl_Ombre = True
Const Def_Ctrl_ClickMove = True

'Evénements
Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Private Sub UserControl_Click()
RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
If Ctrl_ClickMove Then
    ClickMoveClk = True
    Texte
End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
If Ctrl_ClickMove Then
    ClickMoveClk = False
    Texte
End If
End Sub

Private Sub UserControl_InitProperties()
FontBold = True
Ctrl_Caption = Extender.Name
Ctrl_AlignementH = Def_Ctrl_AlignementH
Ctrl_AlignementV = Def_Ctrl_AlignementV
Ctrl_Font_Color = Def_Ctrl_Font_Color
Ctrl_Ombre_Color = Def_Ctrl_Ombre_Color
Ctrl_Back_Color = Def_Ctrl_Back_Color
Ctrl_OmbreH = Def_Ctrl_OmbreH
Ctrl_OmbreV = Def_Ctrl_OmbreV
Ctrl_Ombre = Def_Ctrl_Ombre
Ctrl_ClickMove = Def_Ctrl_ClickMove
End Sub

Private Sub UserControl_Resize()
Texte
End Sub

Private Sub UserControl_Show()
Texte
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
Ctrl_Caption = PropBag.ReadProperty("Caption", Extender.Name)
Ctrl_AlignementH = PropBag.ReadProperty("AlignementH", Def_Ctrl_AlignementH)
Ctrl_AlignementV = PropBag.ReadProperty("Alignementv", Def_Ctrl_AlignementV)
Ctrl_Font_Color = PropBag.ReadProperty("FontColor", Def_Ctrl_Font_Color)
Ctrl_Ombre_Color = PropBag.ReadProperty("OmbreColor", Def_Ctrl_Ombre_Color)
Ctrl_Back_Color = PropBag.ReadProperty("BackColor", Def_Ctrl_Back_Color)
Ctrl_OmbreH = PropBag.ReadProperty("OmbreH", Def_Ctrl_OmbreH)
Ctrl_OmbreV = PropBag.ReadProperty("OmbreV", Def_Ctrl_OmbreV)
Ctrl_Ombre = PropBag.ReadProperty("Ombre", Def_Ctrl_Ombre)
Ctrl_ClickMove = PropBag.ReadProperty("ClickMove", Def_Ctrl_ClickMove)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
Call PropBag.WriteProperty("Caption", Ctrl_Caption, Extender.Name)
Call PropBag.WriteProperty("AlignementH", Ctrl_AlignementH, Def_Ctrl_AlignementH)
Call PropBag.WriteProperty("AlignementV", Ctrl_AlignementV, Def_Ctrl_AlignementV)
Call PropBag.WriteProperty("FontColor", Ctrl_Font_Color, Def_Ctrl_Font_Color)
Call PropBag.WriteProperty("OmbreColor", Ctrl_Ombre_Color, Def_Ctrl_Ombre_Color)
Call PropBag.WriteProperty("BackColor", Ctrl_Back_Color, Def_Ctrl_Back_Color)
Call PropBag.WriteProperty("OmbreH", Ctrl_OmbreH, Def_Ctrl_OmbreH)
Call PropBag.WriteProperty("OmbreV", Ctrl_OmbreV, Def_Ctrl_OmbreV)
Call PropBag.WriteProperty("Ombre", Ctrl_Ombre, Def_Ctrl_Ombre)
Call PropBag.WriteProperty("ClickMove", Ctrl_ClickMove, Def_Ctrl_ClickMove)
End Sub

Private Function Texte()
Dim VCurrentX As Horizontal, VCurrentY As Vertical
Cls
UserControl.BackColor = Ctrl_Back_Color

Select Case Ctrl_AlignementH
    Case 1
        VCurrentX = 0
    Case 2
        VCurrentX = ScaleWidth - TextWidth(Ctrl_Caption)
    Case 3
        VCurrentX = (ScaleWidth - TextWidth(Ctrl_Caption)) / 2
End Select
Select Case Ctrl_AlignementV
    Case 1
        VCurrentY = 0
    Case 2
        VCurrentY = ScaleHeight - TextHeight(Ctrl_Caption)
    Case 3
        VCurrentY = (ScaleHeight - TextHeight(Ctrl_Caption)) / 2
End Select
If ClickMoveClk Then
    ForeColor = Ctrl_Font_Color
    CurrentX = VCurrentX + Ctrl_OmbreH
    CurrentY = VCurrentY + Ctrl_OmbreV
    Print Ctrl_Caption
Else
    If Ctrl_Ombre Then
        ForeColor = Ctrl_Ombre_Color
        CurrentX = VCurrentX + Ctrl_OmbreH
        CurrentY = VCurrentY + Ctrl_OmbreV
        Print Ctrl_Caption
    End If
    ForeColor = Ctrl_Font_Color
    CurrentX = VCurrentX
    CurrentY = VCurrentY
    Print Ctrl_Caption
End If
End Function

Public Property Get Caption() As String
Caption = Ctrl_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
Ctrl_Caption = New_Caption
Texte
PropertyChanged "Caption"
End Property

Public Property Get Font() As Font
Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set UserControl.Font = New_Font
UserControl.FontName = Font.Name
UserControl.FontSize = Font.Size
UserControl.FontBold = Font.Bold
UserControl.FontItalic = Font.Italic
UserControl.FontStrikethru = Font.Strikethrough
UserControl.FontUnderline = Font.Underline
Texte
PropertyChanged "Font"
End Property

Public Property Get AlignementH() As Horizontal
AlignementH = Ctrl_AlignementH
End Property

Public Property Let AlignementH(ByVal New_AlignementH As Horizontal)
Ctrl_AlignementH = New_AlignementH
Texte
PropertyChanged "AlignementH"
End Property

Public Property Get AlignementV() As Vertical
AlignementV = Ctrl_AlignementV
End Property

Public Property Let AlignementV(ByVal New_AlignementV As Vertical)
Ctrl_AlignementV = New_AlignementV
Texte
PropertyChanged "AlignementV"
End Property

Public Property Get FontColor() As OLE_COLOR
FontColor = Ctrl_Font_Color
End Property

Public Property Let FontColor(ByVal New_Font_Color As OLE_COLOR)
Ctrl_Font_Color = New_Font_Color
Texte
PropertyChanged "FontColor"
End Property

Public Property Get OmbreColor() As OLE_COLOR
OmbreColor = Ctrl_Ombre_Color
End Property

Public Property Let OmbreColor(ByVal New_Ombre_Color As OLE_COLOR)
Ctrl_Ombre_Color = New_Ombre_Color
Texte
PropertyChanged "OmbreColor"
End Property

Public Property Get BackColor() As OLE_COLOR
BackColor = Ctrl_Back_Color
End Property

Public Property Let BackColor(ByVal New_Back_Color As OLE_COLOR)
Ctrl_Back_Color = New_Back_Color
Texte
PropertyChanged "BackColor"
End Property

Public Property Get OmbreH() As Integer
OmbreH = Ctrl_OmbreH
End Property

Public Property Let OmbreH(ByVal New_OmbreH As Integer)
Ctrl_OmbreH = New_OmbreH
Texte
PropertyChanged "OmbreH"
End Property

Public Property Get OmbreV() As Integer
OmbreV = Ctrl_OmbreV
End Property

Public Property Let OmbreV(ByVal New_OmbreV As Integer)
Ctrl_OmbreV = New_OmbreV
Texte
PropertyChanged "OmbreV"
End Property

Public Property Get Ombre() As Boolean
Ombre = Ctrl_Ombre
End Property

Public Property Let Ombre(ByVal New_Ombre As Boolean)
Ctrl_Ombre = New_Ombre
Texte
PropertyChanged "Ombre"
End Property

Public Property Get ClickMove() As Boolean
ClickMove = Ctrl_ClickMove
End Property

Public Property Let ClickMove(ByVal New_ClickMove As Boolean)
Ctrl_ClickMove = New_ClickMove
Texte
PropertyChanged "ClickMove"
End Property

Télécharger le zip