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

Soyez le premier à donner votre avis sur cette source.

Vue 4 905 fois - Téléchargée 690 fois

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 ;-)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
125
Date d'inscription
mardi 21 septembre 2004
Statut
Membre
Dernière intervention
9 décembre 2006

une petite question, cest un peux vedj et cosmetique mais je trouve pas comment tu a mi ico.bmp comme icone de ton activex...

tu peux m'expliquer?

mon control est terminer il me manque que ce petit detail...
Messages postés
256
Date d'inscription
jeudi 23 octobre 2003
Statut
Membre
Dernière intervention
20 mars 2013
1
Très bien,

J'aimerais juste savoir comment faire pour pouvoir mettre des valeurs par défaut dans la variable direction ex: Droite, Gauche, Haut et Bas ?

Merci,

Bonne prog !

Olivier
Messages postés
153
Date d'inscription
vendredi 6 décembre 2002
Statut
Membre
Dernière intervention
29 mai 2005
2
Non, loin de là, je suis étudiant (15 ans). Je me suis contenté d'expliquer pas à pas la démarche à suivre, enfin je vais peut-être faire une petite mise à jour car j'ai oublié de montrer les variables à choix prédéfinis (Enum).
@+
Messages postés
17
Date d'inscription
vendredi 13 septembre 2002
Statut
Membre
Dernière intervention
21 janvier 2003

Merci à toi pour ce petit chef d'oeuvre, notamment pour ceux qui débutent et qui comprennent pas grand chose...

Tu serai pas prof par HAZARD ???
Messages postés
21
Date d'inscription
jeudi 27 décembre 2001
Statut
Membre
Dernière intervention
22 décembre 2008

Bravo, c'est vraiment un bon tutorial
Merci
Afficher les 6 commentaires

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.