[VB6] Icône dans le Systray et MDIForm

**Jihnn** · 19/08/2006, 18h28

Bonjour à tous,

J'ai un problème avec le systray et mon programme.

Je suis capable d'ajouter l'icône de mon programme sans problème, mais ce qui s'y rattache par la suite ne fonctionne pas.

Une icône se place dans le systray lorsque la feuille est fermée via le X rouge, en haut à droite. Jusque ici, tout marche.

La procédure Form_Move tiré de cette rubrique de la FAQ ne marche pas avec les MDIForms parce que la propriété .ScaleMode n'existe pas.

Et je suis tout à fait incapable d'enlever l'icône du systray lors de la fermeture du programme. Voici un bout de mon code :

Place l'icône dans le systray

Code :

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
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Cancel = 1
 
    If UnloadMode <> vbFormCode Then
        Me.Show
 
        With nid
            .cbSize = Len(nid)
            .hwnd = Me.hwnd
            .uId = vbNull
            .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
            .uCallBackMessage = WM_MOUSEMOVE
            .hIcon = Me.Icon
            .szTip = "ThunderIRC v1.1.0" & vbNullChar
       End With
 
       Shell_NotifyIcon NIM_ADD, nid
       Me.Hide
    Else
        Quit
    End If
End Sub

Form_Move

Code :

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
Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Result As Long
    Dim msg As Long
 
    If Me.ScaleMode = vbPixels Then
        msg = X
    Else
        msg = X / Screen.TwipsPerPixelX
    End If
 
    Select Case msg
        Case WM_LBUTTONDBLCLK
            Me.WindowState = vbNormal
            Result = SetForegroundWindow(Me.hwnd)
            Me.Show
            Shell_NotifyIcon NIM_DELETE, nid
        Case WM_RBUTTONUP
            Result = SetForegroundWindow(Me.hwnd)
            Me.PopupMenu Me.mnuSystray
    End Select
End Sub

Enlever du systray

Code :

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

1
2
3
4
5
6
Private Sub MDIForm_Unload(Cancel As Integer)
    Dim Result As Long
 
    Result = SetForegroundWindow(Me.hwnd)
    Shell_NotifyIcon NIM_DELETE, nid
End Sub

En bref, seul l'ajout de l'icône dans le systray marche, rien d'autre.

Une recherche sur ce forum m'a plus ou moins aidé : J'ai trouvé un topic très semblable, mais des 4 liens données, 3 sont morts.

Merci d'avance,

Jihnn

**Delbeke** · 21/08/2006, 15h29

Le problème avec le Form Mdi, c'est qu'elle ont , en interne deux fenetres. l'une parente de l'autre. et c'est la child qui reçoit les evénements.
Il devient donc tres difficile de gerer les evenements.

Je te propose ma solution: un composant ocx à poser sur la feuille principale
Tu crées un nouveau projet de type composant activex
- proprièté InvisibeAtRunTime = True
Tu y places un timer
- propriété enabled =false
- propriété interval = 1000
et tu ajoutes ce code

Code :

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 
Option Explicit
 
 
' Const
Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const NIM_MODIFY = &H1
 
Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4
 
' Messages
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONUP = &H208
Private Const WM_RBUTTONUP = &H205
 
Private Const WM_MOUSEMOVE = &H200
 
' Déclaration du type pour l'icône de la barre des tâches
Private Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type
 
Public Enum vbButton
    vbLeft = 1
    vbRight = 2
    vbMiddle = 4
End Enum
 
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
                             (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
 
'Private vars
Private m_Tray As NOTIFYICONDATA
Private m_Visible As Boolean
Private m_ToolTipText As String
Private m_Icon As New StdPicture
 
 
'Events
Event Click()
Event DblClick()
Event MouseUp(Button As vbButton)
Event MouseDown(Button As vbButton)
 
'============================
'UserControl
'============================
Private Sub UserControl_Initialize()
  m_Visible = False
  m_ToolTipText = ""
  Set m_Icon = picTray.Picture
End Sub
 
Private Sub UserControl_Terminate()
  If m_Visible Then
    UnSetTray
  End If
End Sub
 
Private Sub UserControl_Resize()
  picTray.Move 0, 0
  UserControl.Width = 500
  UserControl.Height = 500
End Sub
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
' Charger les valeurs des propriétés à partir du stockage
  Set m_Icon = PropBag.ReadProperty("Icon", Nothing)
  m_ToolTipText = PropBag.ReadProperty("ToolTipText", "")
End Sub
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
' Écrire les valeurs des propriétés dans le stockage
  Call PropBag.WriteProperty("Icon", m_Icon, Nothing)
  Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, "")
End Sub
'==============================
'Properties
'==============================
Public Property Get Icon() As Picture
  Set Icon = picTray.Picture
End Property
Public Property Set Icon(ByVal New_Icon As Picture)
  Dim lRet As Long
  Set m_Icon = New_Icon
  If m_Visible Then
    SetTray
  End If
  PropertyChanged "Icon"
End Property
'
Property Get ToolTipText() As String
  ToolTipText = m_ToolTipText
End Property
Property Let ToolTipText(stData As String)
  Dim lRet As Long
  m_ToolTipText = Left$(stData, 63)
  PropertyChanged "ToolTipText"
  If m_Visible Then
    SetTray
  End If
End Property
'
Property Get IsVisible() As Boolean
  IsVisible = m_Visible
End Property
'=======================
' Internals Events
'=======================
Private Sub picTray_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  X = X / Screen.TwipsPerPixelX
  Select Case X
    Case WM_LBUTTONDBLCLK, WM_MBUTTONDBLCLK, WM_RBUTTONDBLCLK
        RaiseEvent DblClick
    Case WM_LBUTTONUP
        RaiseEvent MouseUp(vbLeft)
        RaiseEvent Click
    Case WM_MBUTTONUP
        RaiseEvent MouseUp(vbMiddle)
        RaiseEvent Click
    Case WM_RBUTTONUP
        RaiseEvent MouseUp(vbRight)
        RaiseEvent Click
    Case WM_LBUTTONDOWN
        RaiseEvent MouseDown(vbLeft)
    Case WM_MBUTTONDOWN
        RaiseEvent MouseDown(vbMiddle)
    Case WM_RBUTTONDOWN
        RaiseEvent MouseDown(vbRight)
    Case Else
        ' Rien
  End Select
End Sub
 
Private Sub Timer1_Timer()
  Show
  If m_Visible Then
    Timer1.Enabled = False
  End If
End Sub
'=============================
' Externals Functions
'=============================
Public Function Show()
  Dim lRet As Long
  SetTray
End Function
 
Public Sub Hide()
  UnSetTray
End Sub
 
Public Sub About()
  dlgAbout.Show 1
  Set dlgAbout = Nothing
End Sub
'=========================================
'Internal Functions
'=========================================
Private Function SetTray()
  Dim lRet As Long
  m_Tray.szTip = m_ToolTipText & vbNullChar
  m_Tray.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
  m_Tray.uID = 101
  m_Tray.cbSize = Len(m_Tray)
  Set picTray.Picture = m_Icon
  m_Tray.hWnd = picTray.hWnd
  m_Tray.uCallbackMessage = WM_MOUSEMOVE
  m_Tray.hIcon = picTray.Picture
  If m_Visible Then
    lRet = Shell_NotifyIcon(NIM_MODIFY, m_Tray)
  Else
    lRet = Shell_NotifyIcon(NIM_ADD, m_Tray)
    If lRet Then
      m_Visible = True
    Else
      Timer1.Enabled = True
    End If
  End If
End Function
Private Function UnSetTray()
  Dim lRet As Long
  If m_Visible Then
    lRet = Shell_NotifyIcon(NIM_DELETE, m_Tray)
    If lRet Then
      m_Visible = False
    End If
  End If
End Function

Pour utilisert le composant une fois compilé

Ajoute le composant dans la boite à outils et places en un sur la feuille Mdi

Voila le code pour la feuille

Code :

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
 
 
Private Sub IconTray1_Click()
  MsgBox "Click"
End Sub
 
Private Sub IconTray1_DblClick()
  MsgBox "DblClick"
End Sub
 
Private Sub MDIForm_Load()
  IconTray1.Show
End Sub
 
Private Sub MDIForm_Unload(Cancel As Integer)
  IconTray1.Hide
End Sub

Le composant gere egalement les propriètes mousedown/up/move

**Jihnn** · 21/08/2006, 15h44

Je vais voir, merci

Edit: Ça marche parfaitement, merci !

Mais une dernière chose... Y'a moyen de gérer le RightClick ?
Je pourrais toucher à ton code, mais j'ai trop peur de faire une bêtise ^^

Merci d'avance,

Jihnn

**Delbeke** · 21/08/2006, 19h23

Utilise l' evenement MouseUp, le parametre buton donne le bouton utilisé

Code :

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

1
2
3
4
5
6
 
Private Sub IconTray1_MouseUp(Button As DiIconTray6.vbButton)
  If Button = vbRight Then
    PopupMenu mnupopup, 0
  End If
End Sub

**Jihnn** · 21/08/2006, 19h26

C'est parfait, merci !

(Tu devrais proposer cette source, ça aiderait les gens je crois bien

)

**Delbeke** · 21/08/2006, 19h27

Oui, je le ferais, promis

[VB6] Icône dans le Systray et MDIForm

VB 6 et antérieur

Discussions similaires

Partager

Partager