Files - Icon try

Visualizza l'icona in icon try



'Left-click constants.

Private Const WM_LBUTTONDBLCLK = &H203 'Double-click
Private Const WM_LBUTTONDOWN = &H201 'Button down
Private Const WM_LBUTTONUP = &H202 'Button up

'Right-click constants.

Private Const WM_RBUTTONDBLCLK = &H206 'Double-click
Private Const WM_RBUTTONDOWN = &H204 'Button down
Private Const WM_RBUTTONUP = &H205 'Button up


Const WM_MOUSEISMOVING = &H200 ' Mouse is moving
Private Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4

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

Private Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer


Private Sub Command1_Click()
Dim nic As NOTIFYICONDATA
nic.cbSize = Len(nic) ' Lunghezza della struttura NOTIFYICONDATA
nic.hIcon = Form1.Icon ' l’icona del form
nic.hwnd = Form1.hwnd ' l’handle del form
nic.szTip = "Tool Tip" & vbNullChar '
nic.uCallbackMessage = WM_MOUSEISMOVING '
nic.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP 'Ho impostato tutti i parametri della struttura
nic.uID = 1 ' L’id della icona...

Call Shell_NotifyIconA(NIM_ADD, nic)
Command1.Enabled = False
Command2.Enabled = True
Command3.Enabled = True

End Sub

Private Sub Command2_Click()
Dim nic As NOTIFYICONDATA

nic.cbSize = Len(nic)
nic.hwnd = Form1.hwnd
nic.uFlags = NIF_ICON
nic.uID = 1
Call Shell_NotifyIconA(NIM_DELETE, nic)
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False


End Sub

Private Sub Command3_Click()
Dim nic As NOTIFYICONDATA


nic.cbSize = Len(nic)

nic.hIcon = Picture1.Picture.Handle
nic.hwnd = Form1.hwnd
nic.uFlags = NIF_ICON + NIF_TIP
nic.uID = 1
nic.szTip = "L'icona e' cambiata" & vbNullChar


Call Shell_NotifyIconA(NIM_MODIFY, nic)
Command3.Enabled = False

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

On Error GoTo Form_MouseMove_err:

' This procedure receives the callbacks from the System Tray icon.

Dim Result As Long
Dim msg As Long

' The value of X will vary depending upon the scalemode setting

If Me.ScaleMode = vbPixels Then
msg = X
Else
msg = X / Screen.TwipsPerPixelX
End If


Select Case msg
Case WM_LBUTTONUP
Label1.Visible = True
Label1.BackColor = vbGreen
Label1 = "Ricevuto messaggio WM_LBUTTONUP"
Case WM_RBUTTONDOWN
Label1.Visible = True
Label1.BackColor = &HFFC0C0
Label1 = "Ricevuto messaggio WM_RBUTTONDOWN"
Case WM_LBUTTONDOWN
Label1.BackColor = &HFFC0FF
Label1 = "Ricevuto messaggio WM_LBUTTONDOWN"

Case WM_LBUTTONDBLCLK
' Process double click on your icon

Label1.Visible = True
Label1.BackColor = vbYellow
Label1 = "Ricevuto messaggio Doppio Click WM_LBUTTONDBLCLK"
Case WM_RBUTTONUP
' Usually display popup menu

Label1.Visible = True
Label1.BackColor = vbRed
Label1 = "Ricevuto messaggio Right Click WM_RBUTTONUP"

Case WM_MOUSEISMOVING
Label1.Visible = True
Label1.BackColor = vbCyan
Label1 = "Ricevuto messaggio WM_MOUSEISMOVING"
End Select

Exit Sub

Form_MouseMove_err:
' Your Error handler goes here!



End Sub