VERSION 2.00
Begin Form Form1
BackColor = &H00C0C0C0&
Caption = "Form1"
ClientHeight = 2532
ClientLeft = 2520
ClientTop = 2592
ClientWidth = 4716
Height = 2856
Icon = TASKBAR.FRX:0000
Left = 2472
LinkTopic = "Form1"
ScaleHeight = 2532
ScaleWidth = 4716
Top = 2316
Width = 4812
Begin CommandButton Command5
Caption = "Exit"
Height = 372
Left = 3300
TabIndex = 4
Top = 1680
Width = 732
End
Begin CommandButton Command1
Caption = "Command1"
DragIcon = TASKBAR.FRX:0302
Height = 432
Left = 360
TabIndex = 0
Top = 132
Width = 1452
End
Begin Timer Timer1
Enabled = 0 'False
Interval = 2000
Left = 2280
Top = 1440
End
Begin MsgHook MsgHook1
Left = 2280
Top = 1920
End
Begin CommandButton Command4
Caption = "Command4"
DragIcon = TASKBAR.FRX:0444
Height = 432
Left = 360
TabIndex = 3
Top = 1920
Width = 1452
End
Begin CommandButton Command3
Caption = "Command3"
DragIcon = TASKBAR.FRX:0746
Height = 432
Left = 360
TabIndex = 2
Top = 1320
Width = 1452
End
Begin CommandButton Command2
Caption = "Command2"
DragIcon = TASKBAR.FRX:0A48
Height = 432
Left = 360
TabIndex = 1
Top = 720
Width = 1452
End
Begin Label Label4
Alignment = 2 'Center
Height = 252
Left = 3120
TabIndex = 8
Top = 900
Width = 852
End
Begin Label Label3
BackColor = &H00C0C0C0&
Caption = "Icon:"
Height = 252
Left = 2460
TabIndex = 7
Top = 900
Width = 492
End
Begin Label Label2
Alignment = 2 'Center
Height = 252
Left = 2460
TabIndex = 6
Top = 540
Width = 2052
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Mouse Event:"
Height = 252
Left = 2460
TabIndex = 5
Top = 180
Width = 1512
End
End
Option Explicit
Dim sTempString$
Dim iIconUsed&
Dim lIconAdded&
Dim hIcon(4) As Long 'to hold handles for the icons extracted
Sub Command1_Click ()
'-----------------------------------------------------
'This button adds a new icon to the tray.
'-----------------------------------------------------
'-----------------------
'Select one of the icons
'-----------------------
iIconUsed = iIconUsed + 1
If iIconUsed > 4 Then
iIconUsed = 1
End If
'-------------------------------
'put the icon into the structure
'-------------------------------
structnotify.hIcon = hIcon(iIconUsed)
'------------------------------------------------------------
'Select a unique number for use during callbacks. lIconAdded
'was set to -1 during Form_Load
'------------------------------------------------------------
lIconAdded = lIconAdded + 1
structnotify.lID = lIconAdded
structnotify.lFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
lTempLong = Shell_NotifyIcon(NIM_ADD, structnotify, idShell_NotifyIcon)
End Sub
Sub Command2_Click ()
'--------------------------------------------------------
'This routine changes the text a user will see when placing
'the mouse over a tray icon. Since structNotify.lID is not
'changed, this will affect the last icon added and any future
'icons until the .sTip property is changed again.
'--------------------------------------------------------
sTempString = InputBox("New text", , structnotify.sTip)
If Len(sTempString) > 63 Then sTempString = Left$(sTempString, 63)
structnotify.sTip = sTempString & Chr$(0)
structnotify.lFlags = NIF_TIP
lTempLong = Shell_NotifyIcon(NIM_MODIFY, structnotify, idShell_NotifyIcon)
End Sub
Sub Command3_Click ()
'--------------------------------------------------
'This routine demonstrates changing the icon under
'program control.
'Icon modification would routinely be used as a status
'indicator. For example, the Win95 Dial-Up utility
'places a modem with read and send indicators that cycle
'between red and green.
'Since structNotify.lID is not changed, this will affect
'only the last icon loaded. Specify a particular .lID to
'change a particular icon
'--------------------------------------------------
'-----------------------
'Select the next icon
'-----------------------
iIconUsed = iIconUsed + 1
If iIconUsed > 4 Then
iIconUsed = 1
End If
'-------------------------------
'put the icon into the structure
'-------------------------------
structnotify.hIcon = hIcon(iIconUsed)
'-------------------------------
'Set flag so that the function knows
'we are changing only the icon
'-------------------------------
structnotify.lFlags = NIF_ICON
lTempLong = Shell_NotifyIcon(NIM_MODIFY, structnotify, idShell_NotifyIcon)
End Sub
Sub Command4_Click ()
If lIconAdded < 0 Then Exit Sub 'no icons
'-------------------------------------------
'Deletes the last icon added
'-------------------------------------------
structnotify.lID = lIconAdded
lIconAdded = lIconAdded - 1
lTempLong = Shell_NotifyIcon(NIM_DELETE, structnotify, idShell_NotifyIcon)
End Sub
Sub Command5_Click ()
Unload Me
End Sub
Sub Form_Load ()
Dim lVerNum&
Dim iVerWord%
Dim iVersNum%
Dim iTrueVers%
'-----------------------------------------------------
'First we find out which Windows is running. This will
'not work with 16-bit Windows 3.x, nor with versions of
'Windows NT prior to 3.51
'-----------------------------------------------------
lVerNum = GetVersion()
iVerWord = CInt(lVerNum And &HFFFF&)
iVersNum = (iVerWord And &HFF) * 100 + CInt(iVerWord / 256)
If GetWinFlags() And WF_WINNT Then
iWinVers = WinNT
'We need to use a 32-bit version call to find out
'which NT is running
iTrueVers = GetVersion32()
Else
'Win95 reports version 3.95
'when queried by 16-bit programs. It returns
'4.00 from 32-bit calls
If iVersNum < 390 Then
iWinVers = Win16
Else
iWinVers = Win32
'The true version isn't used by this sample application,
'but it is nice to see that the function works. Set a
'break point after this line and look at the value for
'iTrueVers - it should be 400 with Win95
iTrueVers = GetVersion32()
End If
End If
If iWinVers = Win16 Then
MsgBox "This program is intended only for use with 32-bit Windows versions."
Unload form1
Exit Sub
End If
If iWinVers = WinNT And iTrueVers < 351 Then
MsgBox "This program will not work on NT versions earlier then 3.51"
Unload form1
Exit Sub
End If
'--------------------------------------------------------
'CALL32 requires that functions be initialized
'--------------------------------------------------------
idShell_NotifyIcon = Declare32("Shell_NotifyIconA", "shell32.dll", "ip")
idSHAppBarMessage = Declare32("SHAppBarMessage", "shell32.dll", "ip")
idExtractIcon = Declare32("ExtractIcon", "shell32.dll", "ipi")
idDestroyIcon = Declare32("DestroyIcon", "user32.dll", "i")
'----------------------------------------------------------
'Get our instance for use with ExtractIcon
'----------------------------------------------------------
hInstance = GetClassWord(Me.hWnd, GCW_HMODULE)
'--------------------------------------------------------
'Since a user may be running 32-bit Windows but not be using
'the Explorer shell, we use the SHAppBarMessage call to determine
'whether there is a system taskbar.
'---------------------------------------------------------
structBarData.lStructureSize = 36&
lTempLong = SHAppBarMessage(ABM_GETTASKBARPOS, structBarData, idSHAppBarMessage)
If lTempLong <> 1 Then
MsgBox "There is no tray currently available"
Unload Me
Exit Sub
End If
'----------------------------------------------------------
'Enable the MsgHook control to receive callbacks from the taskbar
'----------------------------------------------------------
MsgHook1.HwndHook = Me.hWnd
MsgHook1.Message(UM_TaskBarMessage) = True
'------------------------------------------------------------
'Set up the data structure for the Shell_NotifyIcon function
'------------------------------------------------------------
structnotify.lStructureSize = 88&
structnotify.hWnd = Me.hWnd
structnotify.lFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
structnotify.lCallBackMessage = UM_TaskBarMessage
structnotify.sTip = "This is a test" & Chr$(0)
command1.Caption = "Add Icon"
command2.Caption = "Tooltip Text"
command3.Caption = "Change Icon"
command4.Caption = "Delete Icon"
'-------------------------------------------
'We need a valid 32-bit handle to each icon that
'we are going to use in the tray. This example
'should come with 4 icons that are placed in the
'directory from which the program is run. It is up
'to the programmer to provide proper path info if the
'icons or icon-containing files are elsewhere. If
'the icon is in a multiple icon file, the icon number
'must be provided in the third parameter, where zero is
'the first icon. Passing -1 in this parameter will
'result in a return that is the number of available
'icons, instead of a valid hIcon.
'--------------------------------------------
hIcon(1) = ExtractIcon(hInstance, app.Path & "\arw06up.ico", 0&, idExtractIcon)
hIcon(2) = ExtractIcon(hInstance, app.Path & "\arw06lt.ico", 0&, idExtractIcon)
hIcon(3) = ExtractIcon(hInstance, app.Path & "\arw06dn.ico", 0&, idExtractIcon)
hIcon(4) = ExtractIcon(hInstance, app.Path & "\arw06rt.ico", 0&, idExtractIcon)
'------------------------------------------------------
'initialize icon ID value
'------------------------------------------------------
lIconAdded = -1
End Sub
Sub Form_Unload (Cancel As Integer)
Dim iTempInt%
'-------------------------------------------
'We delete all icons associated with this app
'on closing. If we do not, the icon will remain
'until the user moves the mouse over it.
'-------------------------------------------
Do Until lIconAdded < 0
structnotify.lID = lIconAdded
lIconAdded = lIconAdded - 1
lTempLong = Shell_NotifyIcon(NIM_DELETE, structnotify, idShell_NotifyIcon)
Loop
'------------------------------------------
'Clean up the icon resources used
'------------------------------------------
For iTempInt = 1 To 4
lTempLong = DestroyIcon(hIcon(iTempInt), idDestroyIcon)
Next
End Sub
Sub MsgHook1_Message (msg As Integer, wParam As Integer, lParam As Long, result As Long)
Select Case msg
Case UM_TaskBarMessage
label4 = wParam
Select Case lParam
Case WM_MOUSEMOVE
label2 = "MOUSEMOVE"
Case WM_RBUTTONDBLCLK
label2 = "RBUTTONDBLCLK"
Case WM_RBUTTONDOWN
label2 = "RBUTTONDOWN"
Case WM_RBUTTONUP
label2 = "RBUTTONUP"
Case WM_MBUTTONDBLCLK
label2 = "MBUTTONDBLCLK"
Case WM_MBUTTONDOWN
label2 = "MBUTTONDOWN"
Case WM_MBUTTONUP
label2 = "MBUTTONUP"
Case WM_LBUTTONDBLCLK
label2 = "LBUTTONDBLCLK"
Case WM_LBUTTONDOWN
label2 = "LBUTTONDOWN"
Case WM_LBUTTONUP
label2 = "LBUTTONUP"
End Select
Timer1.Enabled = True
End Select
End Sub
Sub Timer1_Timer ()
label2 = ""
label4 = ""
Timer1.Enabled = False
End Sub
