Supralabel (label avec son ombre ocx)

Télécharger le projet
Commenter

Description

J'ai vu il y a quelque jour une personne ayant fait cela, et j'ai trouver son idée sympatique mais son prog n'était pas vraiment exploitable donc j'ai bosser ca ce midi. Je n'utilise pas de label, juste l'UserContrôl.

Caption est le texte
AlignementH est l'Alignement Horizontal du texte
AlignementV est l'Alignement Vertical du texte
Font est la police(Nom,Style,taille,effet)
FontColor est la couleur de la police
OmbreColor est la couleur de l'Ombre
BackColor est la couleur d'arrière plan
OmbreH est la distance horizontale entre le text et son ombre
OmbreV est la distance verticale entre le text et son ombre
Ombre permet d'afficher ou pas l'ombre
ClickMove permet de faire un effet lors du clique

Code a coller dans un contrôl activx
Ou il y a le zip bien sure

Source / Exemple : 


'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

Conclusion :


Voila mon code n'est pas trés commenter mais il est relativement simple a comprendre si on a déjà fais des contrôles utilisateur.
Si vous trouver des bugs, questions, remarques...
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 (SupraDolph)