[VB6] Minimizzare un form nell'area a fianco dell'orologio (system tray)

[binbum]

Si...

[xegallo]

in un modulo

Option Explicit


Private Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As Rect) As Long
Private Declare Function GetParent Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" _
    (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
    (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
    ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook&) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
    Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
    lpData As NOTIFYICONDATA) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    Message As Long
    hwnd As Long
End Type

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 Enum Notify
    NIM_ADD = &H0
    NIM_DELETE = &H2
    NIM_MODIFY = &H1
End Enum

Public Const WM_MOVE = &H3
Public Const WM_NCPAINT = &H85
Public Const WM_COMMAND = &H111
Public Const SWP_FRAMECHANGED = &H20
Public Const WH_CALLWNDPROC = 4
Public Const WS_EX_TOOLWINDOW = &H80
Public Const GWL_EXSTYLE = -20

Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4

Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDOWN = &H204

Public Const TRAYRIGHTCLICK = 7755
Public Const TRAYDBLLEFTCLICK = 7725

Private oldproc As Long
Private cmdButtonHwnd As Long
Private formHook As Form

Public TrayIcon As NOTIFYICONDATA

Public Function HookForm(frm As Form, cmd_TitleButton As CommandButton)
    Set formHook = frm
    cmdButtonHwnd = cmd_TitleButton.hwnd
    oldproc = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf CallWndProc, 0, App.ThreadID)
    Call SetWindowLong(cmdButtonHwnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW)
    Call SetParent(cmdButtonHwnd, GetParent(frm.hwnd))
End Function

Public Function UnHookForm(frm As Form)
    Call UnhookWindowsHookEx(oldproc)
    Call SetParent(cmdButtonHwnd, frm.hwnd)
    Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End Function

Public Function CallWndProc(ByVal nCode As Long, ByVal wParam As Long, Inf As CWPSTRUCT) As Long
    Dim FormRect As Rect
    Select Case Inf.Message
        Case WM_COMMAND 'mouse click
            formHook.MettiinTray
        Case WM_NCPAINT, WM_MOVE
            Call GetWindowRect(formHook.hwnd, FormRect)
            Call SetWindowPos(cmdButtonHwnd, 0, FormRect.Right - 73, FormRect.Top + 6, 17, 14, SWP_FRAMECHANGED)
    End Select
End Function

Public Function Notifica(Messaggio As Notify, Tray As NOTIFYICONDATA) As Boolean
    Call Shell_NotifyIcon(Messaggio, Tray)
End Function

Public Function GetWinVersion() As String
    Dim Ver As Long, WinVer As Long
    Ver = GetVersion()
    WinVer = Ver And &HFFFF&
    GetWinVersion = Format((WinVer Mod 256) + ((WinVer \ 256) / 100), "Fixed")
End Function

nel form che devi gestire

Option Explicit

Private Sub cmdTest_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If GetWinVersion = "4.00" Then
        Call MettiinTray
    End If
End Sub


Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Select Case x
        Case TRAYRIGHTCLICK   'Right Click
            PopupMenu mnu_systray
        Case TRAYDBLLEFTCLICK    'Dbl Left Click
            Me.Show
            cmdTest.Visible = True
            Call Notifica(NIM_DELETE, TrayIcon)
    End Select
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    Call UnHookForm(Me)
    Set MDIForm1 = Nothing
End Sub

Private Sub MDIForm_Load()
    Call HookForm(Me, cmdTest)
End Sub


Private Sub mnuEnd_Click()
    Call UnHookForm(Me)
    End
End Sub

Private Sub mnuShow_Click()
    Me.Show
    cmdTest.Visible = True
    Call Notifica(NIM_DELETE, TrayIcon)
End Sub

Public Sub MettiinTray()
    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hwnd = Me.hwnd
    TrayIcon.uID = vbNull
    TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    TrayIcon.uCallbackMessage = WM_MOUSEMOVE
    TrayIcon.hIcon = Me.Icon
    TrayIcon.szTip = App.EXEName & vbNullChar
    Call Notifica(NIM_ADD, TrayIcon)
    Call Notifica(NIM_MODIFY, TrayIcon)
    Me.Hide
    cmdTest.Visible = False
End Sub

nel form oltre ad un commadbutton di dimensioni appropriate per stare nella barra
ho inserito
un menu mnu_systray e l'ho reso invisibile
con due sotto menu mnuShow e mnuEnd

in qualsiasi caso quando si scarica la form e/o si termina il programma anche in maniera forzata fare in modo che venga eseguita la funzione UnHookForm

[binbum]

Grazie 1000