Crea un nuovo progetto vuoto e incolla questo codice:


'------taglia da quì-----------------
Option Explicit

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 Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200

Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONUP = &H205

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim NI As NOTIFYICONDATA

Private FromIcon As Boolean

Private nIco As Integer
Sub DistruggiIcona()

' distrugge l'icona nel tray
Call Shell_NotifyIcon(NIM_DELETE, NI)
End Sub

Sub Iconizza(A As PictureBox, Ms As String)

'imposta la lunghezza per questa struttura di dati
NI.cbSize = Len(NI)

'imposta l'handle del controllo che dovrà
' ricevere i messagggi (la picture con l'icona)
NI.HWnd = A.HWnd

'imposta l'ID per la struttura dei dati
' il +1 serve a far si che l'ID sia univoco
NI.uID = 0
NI.uID = NI.uID + 1

'flags per la struttura
NI.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP

'tipo di messaggio che la struttura deve ricevere
NI.uCallbackMessage = WM_MOUSEMOVE

'icona da visualizzare
NI.hIcon = A.Picture

'tooltip dell'icona nel tray
NI.szTip = Ms + Chr(0)

'ok, visualizza nell'icontray
' nonmcontrollo il risultato tanto non serve...
Call Shell_NotifyIcon(NIM_ADD, NI)

End Sub

Private Sub cmdCambiaIcona_Click()

Static lTesto As String

DistruggiIcona

If nIco = 0 Then
nIco = 1
lTesto = "icona 1 - tooltip dell'icona..."
Else
nIco = 0
lTesto = "icona 0 - tooltip dell'icona..."
End If

IconInTray.Picture = icnRef(nIco).Picture
Me.Icon = IconInTray.Picture
Iconizza IconInTray, lTesto

End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Main.Visible = False
End Sub


Private Sub Form_Unload(Cancel As Integer)

If FromIcon = True Then
DistruggiIcona
End
Else
Main.Visible = False
Cancel = True
End If

End Sub


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

Dim Msg As Long
Msg = (X And &HFF) * &H100

Select Case Msg

Case 0 'mouse moves
Case &HC00 'left mouse button down
'in alcuni sistemi mi da &HF00, non ho mai capito perché...
' ma per il click sx o dx si usa un altro metodo...
Case &H1E00 'left mouse button up
Case &H2D00 'left mouse button double click
Case &H3C00 'right mouse button down
PopupMenu Main.mMenu 'show the popoup menu
Case &H4B00 'right mouse button up
Case &H5A00 'right mouse button double click
Case Else
End Select

End Sub


Private Sub M_ABO_Click()
MsgBox "ciao amico come và?" + vbLf + _
"vai.... (http://**************).... ci sentiamo là", _
vbInformation, _
"IconTray"
End Sub

Private Sub M_END_Click()
FromIcon = True
Unload Me
End Sub

Private Sub m_opt_Click()
Main.Visible = True
End Sub

Private Sub Form_Load()

If App.PrevInstance = True Then
MsgBox "programma già attivo...", vbExclamation, "IconTray"
End
End If

Dim i As Long
Me.Move (Screen.Width - Me.Width) - 100, (Screen.Height - Me.Height) - 100
Main.Visible = False

IconInTray.Picture = icnRef(nIco).Picture
Iconizza IconInTray, "tooltip dell'icona..."

MsgBox ("ciao amico.......")
end sub
'------------------a quì------------------




link
homepage
http://%77%77%77%2e%74%77%6f%72%6b%2e%69%74/
software
http://%77%77%77%2e%74%77%6f%72%6b%2...programmi.html
forum
http://%77%77%77%2e%74%77%6f%72%6b%2...um/default.asp