1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Control
  5. Un label hyperlink (ocx)

Un label hyperlink (ocx)

5/5 (3 avis)

Vue 6 170 fois - Téléchargée 508 fois

Télécharger le projet
Commenter

Description

un contrôle Label,contenant un hyperlien : lorsque l'on clique dessus le navigateur s'ouvre sur le lien......

Source / Exemple : 


'#######################################################################################################

' HYPERLINK CONTROL   RAFF 1998

'#######################################################################################################
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Const SW_SHOWNORMAL = 1
'Déclarations d'événements:
Event HyperlinkStarted() ' click sur l'hyperlink..........

'Valeurs de propriétés par défaut:
Const m_def_VISITED = True
'Variables de propriétés:
Dim m_VISITED As Boolean

Public Function StartURL(URL As String) As Long
    Dim Scr_hDC As Long
    Scr_hDC = GetDesktopWindow()
    StartURL = ShellExecute(Scr_hDC, "Open", URL, "", "C:\", SW_SHOWNORMAL)
 
RaiseEvent HyperlinkStarted  ' shell lancé....

End Function

Private Sub Label1_Change()
UserControl.Height = Label1.Height + 100

UserControl.Width = Label1.Width + 200
End Sub

Private Sub Label1_Click()
StartURL (Label1.Caption)
If m_VISITED = True Then ' ici on change la couleur de bleu vers rouge (lien visité)
Label1.ForeColor = RGB(250, 0, 0)
Else
Label1.ForeColor = Label1.ForeColor
End If
End Sub

'''ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'''MappingInfo=Label1,Label1,-1,AutoSize
''Public Property Get AutoSize() As Boolean
''    AutoSize = Label1.AutoSize
''End Property
''
''Public Property Let AutoSize(ByVal New_AutoSize As Boolean)
''    Label1.AutoSize() = New_AutoSize
''    PropertyChanged "AutoSize"
''End Property

'ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

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

'ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
    BorderStyle = UserControl.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    UserControl.BorderStyle() = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property

'ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'MappingInfo=Label1,Label1,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = Label1.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    Label1.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

'ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'MappingInfo=Label1,Label1,-1,Font
Public Property Get Font() As Font
    Set Font = Label1.Font
End Property

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

'ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'MappingInfo=Label1,Label1,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = Label1.ForeColor
End Property

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

'ATTENTION! NE PAS SUPPRIMER OU MODIFIER LES LIGNES DE COMMENTAIRES QUI SUIVENT!
'MappingInfo=Label1,Label1,-1,Caption
Public Property Get URL() As String
    URL = Label1.Caption
End Property

Public Property Let URL(ByVal New_URL As String)
    Label1.Caption() = New_URL
    PropertyChanged "URL"
End Property

'Charger les valeurs des propriétés à partir du stockage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    Label1.AutoSize = PropBag.ReadProperty("AutoSize", True)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    Label1.Enabled = PropBag.ReadProperty("Enabled", True)
    Set Font = PropBag.ReadProperty("Font", Ambient.Font)
    Label1.ForeColor = PropBag.ReadProperty("ForeColor", &HFF0000)
    Label1.Caption = PropBag.ReadProperty("URL", "http://www.")
    m_VISITED = PropBag.ReadProperty("VISITED", m_def_VISITED)
End Sub

'Écrire les valeurs des propriétés dans le stockage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("AutoSize", Label1.AutoSize, True)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
    Call PropBag.WriteProperty("Enabled", Label1.Enabled, True)
    Call PropBag.WriteProperty("Font", Font, Ambient.Font)
    Call PropBag.WriteProperty("ForeColor", Label1.ForeColor, &HFF0000)
    Call PropBag.WriteProperty("URL", Label1.Caption, "http://www.")
    Call PropBag.WriteProperty("VISITED", m_VISITED, m_def_VISITED)
End Sub

Public Property Get VISITED() As Boolean
    VISITED = m_VISITED
End Property

Public Property Let VISITED(ByVal New_VISITED As Boolean)
    m_VISITED = New_VISITED
    PropertyChanged "VISITED"
End Property

'Initialiser les propriétés pour le UserControl
Private Sub UserControl_InitProperties()
    m_VISITED = m_def_VISITED
End Sub

' voir ZIP pour projet complet.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
peug
Messages postés
232
Date d'inscription
mercredi 25 octobre 2000
Statut
Membre
Dernière intervention
5 octobre 2012
24 sept. 2008 à 14:46
Salut,
Renfield, sais-tu à quoi sert '''MappingInfo=Label1,Label1,-1,AutoSize
que l'on retrouve de temps en temps dans des sources d'OCX ? A+ merci
raff999
Messages postés
5
Date d'inscription
jeudi 13 novembre 2003
Statut
Membre
Dernière intervention
1 février 2004
1 févr. 2004 à 14:45
ce code date de 1998, posté juste à titre d'exemple, cet ocx fonctionne parfaitement sous win XP........,no prob.
raff
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
 71
1 févr. 2004 à 00:23
Attention, ton code pour lancer les pages WEB ne dois fonctionner que sous Windows 98. En effet Shell Start ne fonctionne plus sous les Windows plus récents...

d'autre part, évite de mettre RGB(250,0,0) en dur, mets plutôt vbRed...

sinon, ca semble bien ficelé.... tu pourrais enlever les commentaires du générateur, ca fait négligé ;)
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 (raff999)