Foro de elhacker.net

Public nid As NOTIFYICONDATA
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Const WM_CHAR = &H102
Public Const WM_SETTEXT = &HC
Public Const WM_USER = &H400
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_CLOSE = &H10
Public Const WM_COMMAND = &H111
Public Const WM_CLEAR = &H303
Public Const WM_DESTROY = &H2
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public 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 Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'Iconos
Sub Icono()
With nid
.cbSize = Len(nid)
.hwnd = Form1.hwnd 'nombre del form que estara minimizado
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = Form1.Icon 'nombre del formulario que contiene el icono
End With
Shell_NotifyIcon NIM_ADD, nid
End Sub
Sub NoIcono()
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_Load ()
Icono 'muestra el icono
End Sub

Private Sub Form_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 517 'click derecho en el icono
            Form1.PopupMenu mnuHola
        Case 514
            Result = SetForegroundWindow(Me.hwnd) 'click izquierdo en el icono
    End Select

End Sub

Private Sub Form_Unload(Cancel As Integer)
NoIcono 'para sacar el icono cuando cerras la aplicacion
End Sub

Private Sub Command1_Click()
    NoIcono 
    Set Icon = ImageList1.ListImages(1).ExtractIcon 'en el (1) depende del lugar en que este tu imagen
    Icono
End Sub

Const STATUS_BUSY = 1
Const STATUS_FREE = 2
Const STATUS_WAIT = 3

Sub LoadIcon(Status As Integer)
      Dim csPicture As IPictureDisp
      Dim sRsrc$

  Select Case Status
    Case STATUS_BUSY: sRsrc = "ICON1"
    Case STATUS_FREE: sRsrc = "ICON2"
    Case STATUS_WAIT: sRsrc = "ICON3"
  End Select
  
  Set csPicture = LoadResPicture(sRsrc, vbResIcon)
End Sub