Discussion :

[ProgElecT]

Suite a la dernière discussion sur les liens hypertexte ICI, j’ai ressorti un ancien projet "pense bête" qui trainait sur un de mes Cds de sauvegarde, je l‘ai un peu retouché, amélioré grâce aux intervenants de la discussion et enfin commenté pour qu‘il serve comme exemple d‘une possibilité.

Créer un projet avec 2 Forms.

1° Form "Form1" avec 2 CommandButtons indexés 0 et 1

Code Form1 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
Dim Cadre As Integer, BarreSys As Integer
Private Sub Form_Load()
Me.Height = 1815: Me.Width = 3000
Me.Caption = "Demo"
Command1(0).Caption = "Liens pour le site DVP"
Command1(0).Move 195, 165, 2355, 315
Command1(1).Caption = "Moteurs de recherche et traducteur"
Command1(1).Move 195, 600, 2325, 480
'quelque soit la plate forme de Windows utilisé, on en deduit l'epaisseur du cadre et la hauteur de la barre-titre du Form
Cadre = (Me.Width - Me.ScaleWidth) / 2 '120 dans ma configuration de VISTA
BarreSys = (Me.Height - Me.ScaleHeight) - Cadre '420 dans ma configuration de VISTA
End Sub
 
Private Sub Command1_Click(Index As Integer)
Dim T As Integer
T = 0 'pour le cas ou on ne choisi qu'un lien hypertexte
Me.Visible = False
Select Case Index
    Case 0 'DVP, 3 liens
        FormLiens.Caption = "Liens pour le site DVP"
        '1° lien
        'le Label "LabeLiens" de "FormLiens" est un Label indexé, il a pour index = 0
        FormLiens.LabeLiens(T).Caption = "Forum des professionnels en informatique - Général Visual Basic 6 et VBScript"
        'on se servira de .Tag du label pour l'URL à passer à la fonction ShellExecute
        FormLiens.LabeLiens(T).Tag = "http://www.developpez.net/forums/f28/autres-langages/general-visual-basic-6-vbscript/"
        '2° liens
        'Comme FormLiens.LabeLiens.Count = 1, il correspond à l'index du nouveau Label que l'on va créer
        'on ajoute un label au Form "FormLiens"
        Load FormLiens.LabeLiens(FormLiens.LabeLiens.Count)
        'pour une question de lisibilité, T sera egal à l'index du Label que l'on vient de créer
        T = FormLiens.LabeLiens.Count - 1
        'personnalisation du Label que l'on vient de créer
        FormLiens.LabeLiens(T).Caption = "Forum des professionnels en informatique - Visual Basic 6"
        FormLiens.LabeLiens(T).Tag = "http://www.developpez.net/forums/f285/autres-langages/general-visual-basic-6-vbscript/vb-6-anterieur/"
        'placement du label
        FormLiens.LabeLiens(T).Move FormLiens.LabeLiens(0).Left, FormLiens.LabeLiens(T - 1).Top + FormLiens.LabeLiens(T - 1).Height + 90
        'on le rend visible
        FormLiens.LabeLiens(T).Visible = True
        '3° liens, on ajoute un label
        Load FormLiens.LabeLiens(FormLiens.LabeLiens.Count)
        T = FormLiens.LabeLiens.Count - 1
        FormLiens.LabeLiens(T).Caption = "Forum des professionnels en informatique - La FAQ VB6"
        FormLiens.LabeLiens(T).Tag = "http://vb.developpez.com/faq/"
        FormLiens.LabeLiens(T).Move FormLiens.LabeLiens(0).Left, FormLiens.LabeLiens(T - 1).Top + FormLiens.LabeLiens(T - 1).Height + 90
        FormLiens.LabeLiens(T).Visible = True
 
    Case 1 'Une autre configuration, 4 liens
        FormLiens.Caption = "Moteurs de recherche et traducteur"
        '1° LIEN
        FormLiens.LabeLiens(T).Caption = "Yahoo! Babel Fish - Traduction en ligne  français, anglais, etc."
        FormLiens.LabeLiens(T).Tag = "http://fr.babelfish.yahoo.com/translate_txt"
        '2° Lien
        Load FormLiens.LabeLiens(FormLiens.LabeLiens.Count)
        T = FormLiens.LabeLiens.Count - 1
        FormLiens.LabeLiens(T).Caption = "AltaVista"
        FormLiens.LabeLiens(T).Tag = "http://www.altavista.com/"
        FormLiens.LabeLiens(T).Move FormLiens.LabeLiens(0).Left, FormLiens.LabeLiens(T - 1).Top + FormLiens.LabeLiens(T - 1).Height + 90
        FormLiens.LabeLiens(T).Visible = True
        '3° Lien
        Load FormLiens.LabeLiens(FormLiens.LabeLiens.Count)
        T = FormLiens.LabeLiens.Count - 1
        FormLiens.LabeLiens(T).Caption = "Accueil - Wikipédia"
        FormLiens.LabeLiens(T).Tag = "http://fr.wikipedia.org/wiki/Accueil"
        FormLiens.LabeLiens(T).Move FormLiens.LabeLiens(0).Left, FormLiens.LabeLiens(T - 1).Top + FormLiens.LabeLiens(T - 1).Height + 90
        FormLiens.LabeLiens(T).Visible = True
        '4° Lien
        Load FormLiens.LabeLiens(FormLiens.LabeLiens.Count)
        T = FormLiens.LabeLiens.Count - 1
        FormLiens.LabeLiens(T).Caption = "Google"
        FormLiens.LabeLiens(T).Tag = "http://www.google.fr/"
        FormLiens.LabeLiens(T).Move FormLiens.LabeLiens(0).Left, FormLiens.LabeLiens(T - 1).Top + FormLiens.LabeLiens(T - 1).Height + 90
        FormLiens.LabeLiens(T).Visible = True
 
    End Select
'dimensionnement du Form "FormLiens" suivant le nombre de lien hypertexte
'pour cela on utilise la position du dernier Label "LabeLiens"
FormLiens.Height = FormLiens.LabeLiens(T).Top + FormLiens.LabeLiens(T).Height + FormLiens.LabeLiens(T).Left + BarreSys
FormLiens.Show
End Sub

2° Form "FormLiens" avec 1 Label "LabeLiens" indexé 0, en design mettre la propriété BorderStyle = 1-Fixed Single et la propriété MinButton = True

Code FormLiens :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Option Explicit
'fonction qui va permetre d'ouvrir internet explorer, ou y ajouter un onglet
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
 
Dim OldIndex As Integer
 
Private Sub Form_Load()
'à faire en cour de construction dans l'editeur VB6
'Me.BorderStyle = 1 'Fixed Single
'Me.MinButton = True
OldIndex = -1 'indication qu'aucun Label n'est "allumé"
'peut être configuré durant la construction, alors ces lignes ne sont pas utiles
LabeLiens(0).FontName = "MS Sans Serif"
LabeLiens(0).FontSize = 8
LabeLiens(0).ForeColor = &HC0C000 'encre bleu
LabeLiens(0).FontUnderline = True 'souligné
LabeLiens(0).FontBold = True 'Gras
LabeLiens(0).Move 105, 165, 6735, 195
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form1.Visible = True
End Sub
 
Private Sub LabeLiens_Click(Index As Integer)
'ouvrir internet explorer, ou y ajouter un onglet avec le lien URL contenu dans le .Tag
ShellExecute Me.hwnd, "open", LabeLiens(Index).Tag, "", App.Path, 1
End Sub
 
'effet visuel simulant le lien hypertexte
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If OldIndex <> -1 Then
    If LabeLiens(OldIndex).ForeColor = &HFF& Then 'rouge
     LabeLiens(OldIndex).ForeColor = &HC0C000 'bleu
     OldIndex = -1
    End If
End If
End Sub
Private Sub LabeLiens_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'Si le Label suvolé est toujours le même, OldIndex = Index, donc on n'actualise pas
If Index <> OldIndex Then 'on survole un nouveau Label
    If OldIndex <> -1 Then
        'un LabeLiens(OldIndex) est allumé, on l'éteint
        LabeLiens(OldIndex).ForeColor = &HC0C000 'bleu
    End If
    'allume le Label
    LabeLiens(Index).ForeColor = &HFF& 'rouge
    OldIndex = Index 'pour revenir à bleu quand la souris quittera ce Label si le lien n'est pas utilisé
End If
End Sub

[ProgElecT]

Salut

MaJ:
Ajout du pointeur en forme de main quand le curseur est au dessus d'un label LabeLiens
Dans leform FormLiens sub Load

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
LabeLiens(0).MousePointer = 99
LabeLiens(0).MouseIcon = LoadPicture("C:\PersoFrancis\Sources divers\Images.ICO\Main0.ico")
LabeLiens(0).AutoSize = True

ATTENTION, pour cela il faut que vous mettiez au LoadPicture, un chemin valide vers l'icône.