VB5 SysTray With Icons Demonstration (38K)
VB6 SysTray With Icons Demonstration (33K)
21 Mar 2000
Added the Win32 API call SetForegroundWindow before showing the SysTray menu - this ensures that the menu dismisses when the user clicks off the menu onto (for example) the desktop, whereas before it used to stick.
Fixed problem on systems with Large Fonts set. The code hardcoded a twips/pixel value of 15 into the message values responded to from the SysTray. Now the code uses VB's ScaleX method to get the correct message value so it works on all systems.
PopupMenu DLL - Create Unlimited Popup Menus
vbAccelerator ImageList Control and Class v2.0
vbAccelerator - Contents of code file: frmDemoSysTray.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmDemoSysTray
Caption = "vbAccelerator AX Popup Menu in SysTray"
ClientHeight = 3555
ClientLeft = 5925
ClientTop = 3570
ClientWidth = 5775
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmDemoSysTray.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3555
ScaleWidth = 5775
Begin VB.CheckBox chkSysTray
Appearance = 0 'Flat
Caption = "&Show in Systray"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 3
Top = 1200
Value = 1 'Checked
Width = 4455
End
Begin VB.OptionButton optIcon
Appearance = 0 'Flat
Caption = "&Bob"
ForeColor = &H80000008&
Height = 375
Index = 0
Left = 660
TabIndex = 2
Top = 1620
Value = -1 'True
Width = 915
End
Begin VB.OptionButton optIcon
Appearance = 0 'Flat
Caption = "&Tooth Beaver"
ForeColor = &H80000008&
Height = 375
Index = 1
Left = 660
TabIndex = 1
Top = 2220
Width = 915
End
Begin VB.OptionButton optIcon
Appearance = 0 'Flat
Caption = "&Stimpy"
ForeColor = &H80000008&
Height = 375
Index = 2
Left = 660
TabIndex = 0
Top = 2760
Width = 1215
End
Begin ComctlLib.ImageList ilsIcons16
Left = 5100
Top = 2820
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 43
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":1272
Key = "PASTE"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":158C
Key = "CUT"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":18A6
Key = "COPY"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":1BC0
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":1EDA
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":21F4
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":250E
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":2828
Key = ""
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":2B42
Key = ""
EndProperty
BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":2E5C
Key = ""
EndProperty
BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":3176
Key = ""
EndProperty
BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":3490
Key = ""
EndProperty
BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":37AA
Key = ""
EndProperty
BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":3AC4
Key = ""
EndProperty
BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":3DDE
Key = ""
EndProperty
BeginProperty ListImage16 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":40F8
Key = ""
EndProperty
BeginProperty ListImage17 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":4412
Key = ""
EndProperty
BeginProperty ListImage18 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":472C
Key = ""
EndProperty
BeginProperty ListImage19 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":4A46
Key = ""
EndProperty
BeginProperty ListImage20 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":4D60
Key = ""
EndProperty
BeginProperty ListImage21 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":507A
Key = ""
EndProperty
BeginProperty ListImage22 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":5394
Key = ""
EndProperty
BeginProperty ListImage23 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":56AE
Key = ""
EndProperty
BeginProperty ListImage24 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":59C8
Key = ""
EndProperty
BeginProperty ListImage25 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":5CE2
Key = ""
EndProperty
BeginProperty ListImage26 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":5FFC
Key = ""
EndProperty
BeginProperty ListImage27 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":6316
Key = ""
EndProperty
BeginProperty ListImage28 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":6630
Key = ""
EndProperty
BeginProperty ListImage29 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":694A
Key = ""
EndProperty
BeginProperty ListImage30 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":6C64
Key = ""
EndProperty
BeginProperty ListImage31 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":6F7E
Key = ""
EndProperty
BeginProperty ListImage32 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":7298
Key = ""
EndProperty
BeginProperty ListImage33 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":75B2
Key = ""
EndProperty
BeginProperty ListImage34 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":78CC
Key = ""
EndProperty
BeginProperty ListImage35 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":7BE6
Key = ""
EndProperty
BeginProperty ListImage36 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":7F00
Key = ""
EndProperty
BeginProperty ListImage37 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":821A
Key = ""
EndProperty
BeginProperty ListImage38 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":8534
Key = ""
EndProperty
BeginProperty ListImage39 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":884E
Key = "Web"
EndProperty
BeginProperty ListImage40 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":8B68
Key = ""
EndProperty
BeginProperty ListImage41 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":8E82
Key = ""
EndProperty
BeginProperty ListImage42 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":919C
Key = ""
EndProperty
BeginProperty ListImage43 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDemoSysTray.frx":94B6
Key = "vbAccelerator"
EndProperty
EndProperty
End
Begin VB.Label lblDetail
BackStyle = 0 'Transparent
Caption = "VB Source Code and Tips at http://vbaccelerator.com"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 2760
TabIndex = 4
Top = 240
Width = 2835
End
Begin VB.Image imgLogo
Height = 660
Left = 120
Picture = "frmDemoSysTray.frx":97D0
Top = 120
Width = 2535
End
Begin VB.Image imgIcon
Height = 480
Index = 0
Left = 120
Picture = "frmDemoSysTray.frx":A059
Top = 1560
Width = 480
End
Begin VB.Image imgIcon
Height = 480
Index = 1
Left = 120
Picture = "frmDemoSysTray.frx":A923
Top = 2100
Width = 480
End
Begin VB.Image imgIcon
Height = 480
Index = 2
Left = 120
Picture = "frmDemoSysTray.frx":B1ED
Top = 2700
Width = 480
End
Begin VB.Label lblBlack
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 60
TabIndex = 5
Top = 60
Width = 5655
End
End
Attribute VB_Name = "frmDemoSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents m_frmSysTray As fSysTrayIconMenu
Attribute m_frmSysTray.VB_VarHelpID = -1
Private Sub SetIcon()
Dim lI As Long
If Not m_frmSysTray Is Nothing Then
Select Case True
Case optIcon(0).Value
m_frmSysTray.IconHandle = imgIcon(0).Picture.Handle
lI = 0
Case optIcon(1).Value
m_frmSysTray.IconHandle = imgIcon(1).Picture.Handle
lI = 1
Case optIcon(2).Value
m_frmSysTray.IconHandle = imgIcon(2).Picture.Handle
lI = 2
End Select
m_frmSysTray.Checked("Bob") = (lI = 0)
m_frmSysTray.Checked("Beaver") = (lI = 1)
m_frmSysTray.Checked("Stimpy") = (lI = 2)
End If
End Sub
Private Sub chkSysTray_Click()
Dim lR As Long, lI As Long
If (chkSysTray.Value = Checked) Then
lI = ilsIcons16.ListImages.Count - 1
Set m_frmSysTray = New fSysTrayIconMenu
With m_frmSysTray
.Initialise Me.hwnd
.ImageList = ilsIcons16
.AddMenuItem "&Open SysTray Sample", "open", True, , , 7
.AddMenuItem "-"
.AddMenuItem "&vbAccelerator on the Web", "vbAccelerator", , , , 42
.AddMenuItem "&About...", "About"
lR = .AddMenuItem("Icons", "IconPopup")
.AddMenuItem "&Bob", "Bob", True, , lR, lI - 2, (optIcon(0).Value)
.AddMenuItem "&Tooth Beaver", "Beaver", , , lR, lI - 1,
(optIcon(1).Value)
.AddMenuItem "&Stimpy", "Stimpy", , , lR, lI, (optIcon(2).Value)
.AddMenuItem "-"
.AddMenuItem "&Close", "close"
.ToolTip = "SysTray Sample!"
End With
SetIcon
Else
Unload m_frmSysTray
Set m_frmSysTray = Nothing
End If
End Sub
Private Sub Form_Load()
ilsIcons16.ListImages.Add , , imgIcon(0).Picture
ilsIcons16.ListImages.Add , , imgIcon(1).Picture
ilsIcons16.ListImages.Add , , imgIcon(2).Picture
chkSysTray_Click
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not m_frmSysTray Is Nothing Then
Unload m_frmSysTray
End If
Set m_frmSysTray = Nothing
End Sub
Private Sub m_frmSysTray_MenuClick(ByVal lIndex As Long, ByVal sKey As String)
If Me.Visible Then
Me.ZOrder
End If
Select Case sKey
Case "open"
Me.Show
Me.ZOrder
Case "vbAccelerator"
'ShellEx "http://vbaccelerator.com/"
Case "Bob"
optIcon(0).Value = True
Case "Beaver"
optIcon(1).Value = True
Case "Stimpy"
optIcon(2).Value = True
Case "close"
Unload Me
End Select
End Sub
Private Sub m_frmSysTray_SysTrayDoubleClick(ByVal eButton As
MouseButtonConstants)
Me.Show
Me.ZOrder
End Sub
Private Sub m_frmSysTray_SysTrayMouseDown(ByVal eButton As MouseButtonConstants)
If (eButton = vbRightButton) Then
m_frmSysTray.ShowMenu
End If
End Sub
Private Sub optIcon_Click(Index As Integer)
SetIcon
End Sub