Contrôle de texte défilant avec étapes de créations (tutorial ocx)

Télécharger le projet
Commenter

Description

J'ai fait ce contrôle comme exemple pour expliquer comment en fabriquer, le zip contient le contrôle et la source, pour avoir le tutorial de création du contrôle, il suffit d'aller à la page http://membres.lycos.fr/cedric7/basic/index2.html
ou
http://www.chez.com/cedricvan/basic/index2.html

TOUT est expliqué, de A à Z pour créer le contrôle , avec l'explication du code, les étapes de création...

Pour créer le contrôle à partir du code ci-dessous, insérez
-un label (NAME) = "DText"
-un timer (NAME) = "DTimer" avec Interval = 100
Puis mettre le code ci-dessous

Source / Exemple : 


Public Direction As String  'Direction est une chaine de caractère donc String
Public Speed As Integer     'Speed est un nombre de point, donc Integer
Event Click() 'L'événement Click ne demande pas d'argument
Event DblClick() 'L'événement DblClick ne demande pas d'argument
Event KeyDown(KeyCode As Integer, Shift As Integer) 'L'événement KeyDown donne la touche enfoncée et Shift
Event KeyPress(KeyAscii As Integer) 'L'événement KeyPress donne la touche utilisée
Event KeyUp(KeyCode As Integer, Shift As Integer) 'L'événement KeyUp donne la touche relevée et Shift
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  'L'événement MouseDown donne le bouton enfoncé, Shift, la position horizontale du pointeur et sa position vertical
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)  'L'événement MouseMove donne le bouton enfoncé, Shift, la position horizontale du pointeur et sa position vertical
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)    'L'événement MouseUp donne le bouton enfoncé, Shift, la position horizontale du pointeur et sa position vertical
Event Resize()  'L'événement Resize ne demande pas d'argument
Event Sort(Cote As String) 'L'événement Sort donne le côté où est sorti le DText

Private Sub UserControl_Resize()
'Si AutoSize est activé
If DText.AutoSize = True Then
    'La largeur du contrôle devient la largeur du Dtext
    UserControl.Width = DText.Width
    'La hauteur du contrôle devient la heuteur du Dtext
    UserControl.Height = DText.Height
'Fin de la condition
End If
End Sub

Private Sub DTimer_Timer()
'Si la direction vaut right (droite)
If Direction = "right" Then
    'On place le curseur en haut du contrôle
    DText.Top = 0
    'On décale Dtext de Speed vers la droite
    DText.Left = DText.Left + Speed
    'Si Dtext sort de l'écran, on le remet à droite de l'écran
    If DText.Left > UserControl.Width Then DText.Left = -DText.Width: RaiseEvent Sort("right")
'Si la direction vaut left (gauche)
ElseIf Direction = "left" Then
    'On place le curseur en haut du contrôle
    DText.Top = 0
    'On décale Dtext de Speed vers la gauche
    DText.Left = DText.Left - Speed
    'Si Dtext sort de l'écran, on le remet à gauche de l'écran
    If DText.Left + DText.Width < 0 Then DText.Left = UserControl.Width: RaiseEvent Sort("left")
'Si la direction vaut top (haut)
ElseIf Direction = "top" Then
    'On place le curseur à gauche du contrôle
    DText.Left = 0
    'On décale Dtext de Speed vers le haut
    DText.Top = DText.Top - Speed
    'Si Dtext sort de l'écran, on le remet en bas de l'écran
    If DText.Top + DText.Height < 0 Then DText.Top = UserControl.Height: RaiseEvent Sort("top")
'Si la direction vaut bottom (bas)
ElseIf Direction = "bottom" Then
    'On place le curseur à gauche du contrôle
    DText.Left = 0
    'On décale Dtext de Speed vers le bas
    DText.Top = DText.Top + Speed
    'Si Dtext sort de l'écran, on le remet en haut de l'écran
    If DText.Top > UserControl.Height Then DText.Top = -DText.Height: RaiseEvent Sort("bottom")
End If
End Sub

Public Property Get Text() As String
'Text renvoie le caption du Dtext
Text = DText.Caption
End Property

Public Property Let Text(ByVal New_text As String)
'DText prend la caption que l'utilisateur envoie
DText.Caption = New_text
'Pour que le label prenne la taille du texte on le met pendant un instant en AutoSize = True
'Puis on remet la valeur d'origine à AutoSize
avant = DText.AutoSize: DText.AutoSize = True: DText.AutoSize = avant
'On indique le changement au programme
PropertyChanged "text"
End Property

'Pour BackColor
Public Property Get BackColor() As OLE_COLOR
BackColor = DText.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
DText.BackColor = New_BackColor
UserControl.BackColor = New_BackColor
PropertyChanged "BackColor"
End Property

'Pour ForeColor
Public Property Get ForeColor() As OLE_COLOR
ForeColor = DText.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
DText.ForeColor = New_ForeColor
PropertyChanged "ForeColor"
End Property

'Pour ToolTipText
Public Property Get ToolTipText() As String
ToolTipText = DText.ToolTipText
End Property

Public Property Let ToolTipText(ByVal New_ToolTipText As String)
DText.ToolTipText = New_ToolTipText
PropertyChanged "ToolTipText"
End Property

'Pour AutoSize
Public Property Get AutoSize() As Boolean
    AutoSize = DText.AutoSize
End Property

Public Property Let AutoSize(ByVal New_AutoSize As Boolean)
    DText.AutoSize = New_AutoSize
    PropertyChanged " AutoSize "
End Property

'Pour Font
Public Property Get Font() As Font
    Set Font = DText.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set DText.Font = New_Font
    PropertyChanged "Font"
End Property

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'On utilise le sac de propriétés PropBag et on y enregistre les propriétés et leurs valeurs
    Call PropBag.WriteProperty("Direction", Direction, "right")
    Call PropBag.WriteProperty("Speed", Speed, 12)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", DText.ForeColor, &H80000012)
    Call PropBag.WriteProperty("ToolTipText", DText.ToolTipText, "")
    Call PropBag.WriteProperty("Text", DText.Caption, "")
    Call PropBag.WriteProperty("AutoSize", DText.AutoSize, False)
    Call PropBag.WriteProperty("Font", DText.Font, Ambient.Font)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Direction = PropBag.ReadProperty("Direction", "right")
    Speed = PropBag.ReadProperty("Speed", 12)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    DText.BackColor = UserControl.BackColor
    DText.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    DText.ToolTipText = PropBag.ReadProperty("ToolTipText", "")
    DText.Caption = PropBag.ReadProperty("Text", "")
    DText.AutoSize = PropBag.ReadProperty("AutoSize", False)
    Set DText.Font = PropBag.ReadProperty("Font", Ambient.Font)
    'Pour que le label prenne la taille du texte on le met pendant un instant en AutoSize = True
    'Puis on remet la valeur d'origine à AutoSize
    avant = DText.AutoSize: DText.AutoSize = True: DText.AutoSize = avant
End Sub

Public Sub Command(AExecuter As String)
'La méthode Command demande un argument, "AExecuter"
'Si cet argument vaut start alors on lance le DTimer
If LCase(AExecuter) = "start" Then DTimer.Enabled = True
'Si l'argument vaut stop on stop le DTimer
If LCase(AExecuter) = "stop" Then DTimer.Enabled = False
'''''REMARQUES: LCase sert à mettre en minuscule l'argument pour que Start
'''''soit autant valable que sTaRt car cela devient start et start = start!!
End Sub

Public Function Execute(AExecut As String) As Boolean
'On place la valeur par défaut de Execute sur True
Execute = True
'La méthode Command demande un argument, "AExecut"
'Si cet argument vaut start alors on lance le Dtimer
If LCase(AExecut) = "start" Then
DTimer.Enabled = True
'Si l'argument vaut stop on stop le DTimer
ElseIf LCase(AExecut) = "stop" Then
   DTimer.Enabled = False
'Si rien n'a été fait Execute devient False
Else
    Execute = False
End If
'''''REMARQUES: LCase sert à mettre en minuscule l'argument pour que Start
'''''soit autant valable que sTaRt car cela devient start et start = start!!
End Function

Private Sub UserControl_Click()
    'On appelle Click quand l'utilisateur clique sur le contrôle
    RaiseEvent Click
End Sub

Private Sub DText_Click()
    'On appelle Click quand l'utilisateur clique sur le DText
    RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
    'On appelle DblClick quand l'utilisateur double-clique sur le contrôle
    RaiseEvent DblClick
End Sub

Private Sub DText_DblClick()
    'On appelle DblClick quand l'utilisateur double-clique sur le DText
    RaiseEvent DblClick
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
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)
End Sub

Conclusion :


Voilà, donnez votre avis et une note peut-être ;-)
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 (DHKold)