Перехват Shell_NotifyIcon

[Tarik]

В общем-то, эта тема является продолжением темы про трэй (http://bbs.vbstreets.ru/viewtopic.php?t=11305). Там Max! остановился на SetParent, как на наиболее подходящем для него варианте. Мне же такой подход не подходит .
Итак, задача: написать свой shell.
Проблема: написать некоторое подобие SysTray.
Насколько я понял, для этого нужно перехватывать вызовы ф-ции Shell_NotifyIcon и выковыривать оттуда NOTIFYICONDATA. Теперь вопрос: как это сделать?

[alibek]

Я уже в том топике ответил.
Тебе не надо их перехватывать. Тебе достаточно просто создать такое же окно (с таким же классом) и обслуживать сообщения.

[Sebas]

как то я сделал контрол трея, поищу...

[Tarik]

Я уже в том топике ответил.
Тебе не надо их перехватывать. Тебе достаточно просто создать такое же окно (с таким же классом) и обслуживать сообщения.

Уже прочитал, пойду изучать матчасть

как то я сделал контрол трея, поищу...

Поищи, если не сложно

[Max!]

Tarik вот я нашол что-то похожие но нет время разбираться сам ковыряюсь по своему вопросу , в этом примере работает вроде всё но сам трей глучит слегка ! Если найдёш как это исправить то обезательно запости сюды !

[Tarik]

Ушёл смотреть...

[Tarik]

Не, с других прог он значки в трэй не ставит. По крайней мере, у меня на XP...

[xolod]

Тестил и в 9x и в nt - странноватая программка, кнопочки панели задач тока копирует.. Потом поверх такс бара и.. все
Не понятна цель это программулины

[Tarik]

Ух! Наконец-то смог совместить в последнее время несовместимые (для меня) вещи - комп и свободное время . Прочитал про сообщения, оконные процедуры, проникся. Теперь назрел главный вопрос: какие сообщения посылаются Shell_TrayWnd при добавлении/удалении/модификации значка? Посидел со Spy++ - пока мало что выловил. Надо больше времени . Может, кто знает?

[tyomitch]

Это обычный тулбар.
Шлются обычные тулбарские сообщения (TBM_*)

[Sebas]

сорри что в таком виде, старый проект(vb6) сейчас недоступен, а это перелопаченный визардом VB.NET да и не правленный.

на ВБ6 с 98 абсолютно рабочий контрол. есстесна Эхплорер нада проносить. Вообщем пиво полюбе с тебя. инфа эксклюзивна

Код: Выделить всё

Module mdlTray

    Public Const NIM_ADD As Short = &H0S
    Public Const NIM_MODIFY As Short = &H1S
    Public Const NIM_DELETE As Short = &H2S

    Public Const NIF_MESSAGE As Short = &H1S
    Public Const NIF_ICON As Short = &H2S
    Public Const NIF_TIP As Short = &H4S

    Public Const WM_LBUTTONDBLCLK As Short = &H203S
    Public Const WM_LBUTTONDOWN As Short = &H201S
    Public Const WM_LBUTTONUP As Short = &H202S
    Public Const WM_MBUTTONDBLCLK As Short = &H209S
    Public Const WM_MBUTTONDOWN As Short = &H207S
    Public Const WM_MBUTTONUP As Short = &H208S
    Public Const WM_RBUTTONDBLCLK As Short = &H206S
    Public Const WM_RBUTTONDOWN As Short = &H204S
    Public Const WM_RBUTTONUP As Short = &H205S

    Public Const DI_NORMAL As Short = &H3S
    Public Const WM_COPYDATA As Short = &H4AS
    Public Const HWND_BROADCAST As Integer = &HFFFF

    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As Any, ByRef lpvSource As Any, ByVal cbCopy As Integer)
    Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Integer
    Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal hIcon As Integer) As Integer
    Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Integer, ByVal xLeft As Integer, ByVal yTop As Integer, ByVal hIcon As Integer, ByVal cxWidth As Integer, ByVal cyWidth As Integer, ByVal istepIfAniCur As Integer, ByVal hbrFlickerFreeDraw As Integer, ByVal diFlags As Integer) As Integer
    Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    'UPGRADE_WARNING: Structure RECT may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
    Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
    'UPGRADE_NOTE: Class was upgraded to Class_Renamed. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"'
    'UPGRADE_WARNING: Structure WNDCLASS may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
    Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (ByRef Class_Renamed As WNDCLASS) As Integer
    Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Integer) As Integer
    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
    Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Integer, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hWndParent As Integer, ByVal hMenu As Integer, ByVal hInstance As Integer, ByRef lpParam As Any) As Integer
    Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Integer) As Integer
    Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Integer, ByRef lpdwProcessId As Integer) As Integer

    Public Structure NOTIFYICONDATA
        Dim cbSize As Integer
        Dim hwnd As Integer
        Dim uId As Integer
        Dim uFlags As Integer
        Dim ucallbackMessage As Integer
        Dim hIcon As Integer
        <VBFixedString(64), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=64)> Public szTip As String
    End Structure

    Public Structure RECT
        'UPGRADE_NOTE: Left was upgraded to Left_Renamed. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"'
        Dim Left_Renamed As Integer
        Dim Top As Integer
        'UPGRADE_NOTE: Right was upgraded to Right_Renamed. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"'
        Dim Right_Renamed As Integer
        Dim Bottom As Integer
    End Structure

    Public Structure WNDCLASS
        Dim style As Integer
        Dim lpfnwndproc As Integer
        Dim cbClsextra As Integer
        Dim cbWndExtra2 As Integer
        Dim hInstance As Integer
        Dim hIcon As Integer
        Dim hCursor As Integer
        Dim hbrBackground As Integer
        Dim lpszMenuName As String
        Dim lpszClassName As String
    End Structure

    Public Structure COPYDATASTRUCT
        Dim dwData As Integer
        Dim cbData As Integer
        Dim lpData As Integer
    End Structure

    Public Function TrayHook(ByVal hwnd As Integer, ByVal message As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        On Error Resume Next
        Select Case message
            Case WM_COPYDATA
                TrayHook = frmMain.DefInstance.usrTray1.MyTrayHook(hwnd, message, wParam, lParam)
            Case Else
                TrayHook = DefWindowProc(hwnd, message, wParam, lParam)
        End Select
    End Function
End Module




'контрол---------------------------------
Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class usrTray
   Inherits System.Windows.Forms.UserControl
#Region "Windows Form Designer generated code "
   Public Sub New()
      MyBase.New()
      'This call is required by the Windows Form Designer.
      InitializeComponent()
   End Sub
   'Form overrides dispose to clean up the component list.
   Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)
      If Disposing Then
         If Not components Is Nothing Then
            components.Dispose()
         End If
      End If
      MyBase.Dispose(Disposing)
   End Sub
   'Required by the Windows Form Designer
   Private components As System.ComponentModel.IContainer
   Public ToolTip1 As System.Windows.Forms.ToolTip
   Friend WithEvents _Picture1_0 As System.Windows.Forms.PictureBox
   Friend WithEvents Picture1 As Microsoft.VisualBasic.Compatibility.VB6.PictureBoxArray
   'NOTE: The following procedure is required by the Windows Form Designer
   'It can be modified using the Windows Form Designer.
   'Do not modify it using the code editor.
   <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
      Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(usrTray))
      Me.components = New System.ComponentModel.Container()
      Me.ToolTip1 = New System.Windows.Forms.ToolTip(components)
      Me.ToolTip1.Active = True
      Me._Picture1_0 = New System.Windows.Forms.PictureBox
      Me.Picture1 = New Microsoft.VisualBasic.Compatibility.VB6.PictureBoxArray(components)
      CType(Me.Picture1, System.ComponentModel.ISupportInitialize).BeginInit()
      Me.ClientSize = New System.Drawing.Size(320, 29)
      MyBase.Location = New System.Drawing.Point(0, 0)
      MyBase.Font = New System.Drawing.Font("Arial", 8!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
      MyBase.Name = "usrTray"
      Me._Picture1_0.BackColor = System.Drawing.Color.Black
      Me._Picture1_0.Size = New System.Drawing.Size(25, 17)
      Me._Picture1_0.Location = New System.Drawing.Point(8, 8)
      Me._Picture1_0.TabIndex = 0
      Me._Picture1_0.Visible = False
      Me._Picture1_0.Font = New System.Drawing.Font("Arial", 8!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
      Me._Picture1_0.Dock = System.Windows.Forms.DockStyle.None
      Me._Picture1_0.CausesValidation = True
      Me._Picture1_0.Enabled = True
      Me._Picture1_0.ForeColor = System.Drawing.SystemColors.ControlText
      Me._Picture1_0.Cursor = System.Windows.Forms.Cursors.Default
      Me._Picture1_0.RightToLeft = System.Windows.Forms.RightToLeft.No
      Me._Picture1_0.TabStop = True
      Me._Picture1_0.SizeMode = System.Windows.Forms.PictureBoxSizeMode.Normal
      Me._Picture1_0.BorderStyle = System.Windows.Forms.BorderStyle.None
      Me._Picture1_0.Name = "_Picture1_0"
      Me.Controls.Add(_Picture1_0)
      Me.Picture1.SetIndex(_Picture1_0, CType(0, Short))
      CType(Me.Picture1, System.ComponentModel.ISupportInitialize).EndInit()
   End Sub
#End Region
   
   Private hTrayWindow As Integer
   Private Const gClassName As String = "Shell_TrayWnd"
   'Const gClassName = "TrayNotifyWnd"
   'Const gAppName = "Окно из WinAPI"
   
   Public Dic As Scripting.Dictionary
   
   
   Public Shadows Sub Show()
      Dim WM_TASKBARCREATED As Integer
      Dim TrayClass As WNDCLASS
      On Error Resume Next
      'если уже создан
      If hTrayWindow <> 0 Then Exit Sub
      
      Dic = New Scripting.Dictionary
      'подготовка к регистрации класса
      'UPGRADE_WARNING: Add a delegate for AddressOf TrayHook Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1048"'
      TrayClass.lpfnwndproc = GetAddress(AddressOf TrayHook) 'обработчик сообщений
      TrayClass.hInstance = VB6.GetHInstance.ToInt32
      TrayClass.lpszClassName = gClassName
      'регистрация класса
      If RegisterClass(TrayClass) = 0 Then Exit Sub
      System.Windows.Forms.Application.DoEvents()
      'здесь создаётся окно
      hTrayWindow = CreateWindowEx(0, gClassName, " ", 0, 1, 1, 1, 1, 0, 0, VB6.GetHInstance.ToInt32, 0)
      System.Windows.Forms.Application.DoEvents()
      If hTrayWindow = 0 Then Exit Sub
      'сообщение всем программам поместить иконки
      WM_TASKBARCREATED = RegisterWindowMessage("TaskbarCreated")
      Call PostMessage(HWND_BROADCAST, WM_TASKBARCREATED, 0, 0)
      
      frmMain.DefInstance.usrTray1.Visible = True
      
   End Sub
   
   Public Shadows Sub Hide()
      On Error Resume Next
      On Error Resume Next
      If hTrayWindow = 0 Then Exit Sub
      
      Call UnregisterClass(gClassName, VB6.GetHInstance.ToInt32)
      Call DestroyWindow(hTrayWindow)
      hTrayWindow = 0
      
      frmMain.DefInstance.usrTray1.Visible = False
   End Sub
   
   Public Function MyTrayHook(ByVal hwnd As Integer, ByVal message As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
      Dim CDS As COPYDATASTRUCT
      Dim NID As NOTIFYICONDATA
      On Error Resume Next
      Dim Action As Integer
      
      'подготовка структуры
      NID.szTip = Space(64)
      NID.cbSize = Len(NID)
      'заполнение структуры
      'UPGRADE_WARNING: Couldn't resolve default property of object CDS. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
      mdlHook.CopyMemory(CDS, lParam, Len(CDS)) 'pointer(integer(5454)+8);
      'CDS.dwData=1 Это правильно!
      'UPGRADE_WARNING: Couldn't resolve default property of object NID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
      mdlHook.CopyMemory(NID, CDS.lpData + 8, Len(NID))
      'получение действия
      mdlHook.CopyMemory(Action, CDS.lpData + 4, 4)
      Select Case Action
         Case NIM_ADD
            MyTrayHook = Tray_Add(NID)
         Case NIM_MODIFY
            MyTrayHook = Tray_Modify(NID)
         Case NIM_DELETE
            MyTrayHook = Tray_Delete(NID)
      End Select
      
   End Function
   
   Private Function Tray_Add(ByRef NID As NOTIFYICONDATA) As Integer
      Dim i, NewIndex As Short
      On Error Resume Next
      'проверка на наличи окна
      If Dic.Exists("h" & CStr(NID.hwnd)) Then
         Tray_Add = Tray_Modify(NID)
         Exit Function
      End If
      
      'finding empty pic
      For i = 1 To Me.Picture1.UBound
         If Me.Picture1(i).Tag = "" Then
            NewIndex = i
            Exit For
         End If
      Next i
      
      If NewIndex = 0 Then
         NewIndex = Me.Picture1.UBound + 1
         Err.Clear()
         Me.Picture1.Load(NewIndex)
         If Err.Number <> 0 Then
            Exit Function
         End If
      End If
      
      Me.Picture1(NewIndex).Tag = NID.hwnd & ";" & NID.ucallbackMessage & ";" & NID.uId
      
      If (NID.uFlags And NIF_TIP) = NIF_TIP Then
         'NID.szTip = StrConv(NID.szTip, vbFromUnicode)
         ToolTip1.SetToolTip(Me.Picture1(NewIndex), VB.Left(NID.szTip, InStr(NID.szTip, Chr(0)) - 1))
      End If
      If (NID.uFlags And NIF_ICON) = NIF_ICON Then
         'UPGRADE_ISSUE: PictureBox method Picture1.Cls was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"'
         Me.Picture1(NewIndex).Cls()
         'UPGRADE_ISSUE: PictureBox property Picture1.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"'
         Call DrawIconEx(Me.Picture1(NewIndex).hdc, 0, 0, NID.hIcon, 16, 16, 0, 0, DI_NORMAL)
         'BitBlt UserControl.Picture1(NewIndex).hdc, 1, 1, 16, 16, NID.hIcon, 1, 1, SRCCOPY
         'Debug.Print "AddIcon" & NID.hIcon & ":" & DrawIconEx(frmMain.Picture2.hdc, 0, 0, NID.hIcon, 16, 16, 0, 0, DI_NORMAL)
      End If
      
      Dic.Add("h" & CStr(NID.hwnd), NewIndex)
      
      Me.Picture1(NewIndex).Top = 0
      Me.Picture1(NewIndex).Height = VB6.TwipsToPixelsY(MyBase.height)
      'UserControl.Picture1(NewIndex).height = 250
      'UserControl.Picture1(NewIndex).Width = 250
      Me.Picture1(NewIndex).Visible = True
      
      Refresh()
      Tray_Add = -1
   End Function
   
   Private Function Tray_Modify(ByRef NID As NOTIFYICONDATA) As Integer
      Dim i, NewIndex As Short
      On Error Resume Next
      'проверка на наличи окна
      If Not Dic.Exists("h" & CStr(NID.hwnd)) Then
         Tray_Modify = Tray_Add(NID)
         Exit Function
      End If
      
      'UPGRADE_WARNING: Couldn't resolve default property of object Dic.Item(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
      NewIndex = Dic.Item("h" & CStr(NID.hwnd))
      If NewIndex = 0 Then Exit Function
      'finding empty pic
      If Me.Picture1(NewIndex) Is Nothing Then
         Exit Function
      End If
      
      Me.Picture1(NewIndex).Tag = NID.hwnd & ";" & NID.ucallbackMessage & ";" & NID.uId
      
      If (NID.uFlags And NIF_TIP) = NIF_TIP Then
         'NID.szTip = StrConv(NID.szTip, vbFromUnicode)
         ToolTip1.SetToolTip(Me.Picture1(NewIndex), VB.Left(NID.szTip, InStr(NID.szTip, Chr(0)) - 1))
      End If
      If (NID.uFlags And NIF_ICON) = NIF_ICON Then
         'UPGRADE_ISSUE: PictureBox method Picture1.Cls was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"'
         Me.Picture1(NewIndex).Cls()
         'UPGRADE_ISSUE: PictureBox property Picture1.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"'
         Call DrawIconEx(Me.Picture1(NewIndex).hdc, 0, 0, NID.hIcon, 0, 0, 0, 0, DI_NORMAL)
      End If
      
      Refresh()
      Tray_Modify = -1
   End Function
   
   Private Function Tray_Delete(ByRef NID As NOTIFYICONDATA) As Integer
      Dim i, NewIndex As Short
      On Error Resume Next
      'проверка на наличи окна
      If Not Dic.Exists("h" & CStr(NID.hwnd)) Then
         Exit Function
      End If
      
      'UPGRADE_WARNING: Couldn't resolve default property of object Dic.Item(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
      NewIndex = Dic.Item("h" & CStr(NID.hwnd))
      Dic.Remove("h" & CStr(NID.hwnd))
      
      If NewIndex = 0 Then Exit Function
      'finding empty pic
      Me.Picture1(NewIndex).Tag = ""
      Me.Picture1(NewIndex).Visible = False
      
      Refresh()
      Tray_Delete = -1
   End Function
   
   Public Overrides Sub Refresh()
      Dim i, y As Short
      On Error Resume Next
      For i = 1 To Me.Picture1.UBound
         If Me.Picture1(i).Tag <> "" Then
            Me.Picture1(i).Left = VB6.TwipsToPixelsX(y)
            y = VB6.PixelsToTwipsX(Me.Picture1(i).Left) + VB6.PixelsToTwipsX(Me.Picture1(i).Width) + 10
         End If
      Next i
      
      frmMain.DefInstance.usrTray1.Width = VB6.TwipsToPixelsX(y)
      frmMain.DefInstance.usrTray1.Left = VB6.TwipsToPixelsX(10935 - VB6.PixelsToTwipsX(frmMain.DefInstance.usrTray1.Width))
   End Sub
   
   Public Function GetAddress(ByVal lngAddr As Integer) As Integer
      On Error Resume Next
      GetAddress = lngAddr
   End Function
   
   Private Sub Picture1_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Picture1.DoubleClick
      Dim Index As Short = Picture1.GetIndex(eventSender)
      Dim rc As Integer
      Dim arr() As String
      On Error Resume Next
      arr = Split(Me.Picture1(Index).Tag, ";")
      
      rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_LBUTTONDBLCLK)
   End Sub
   
   Private Sub Picture1_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles Picture1.MouseDown
      Dim Button As Short = eventArgs.Button \ &H100000
      Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
      Dim x As Single = VB6.PixelsToTwipsX(eventArgs.X)
      Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
      Dim Index As Short = Picture1.GetIndex(eventSender)
      Dim rc As Integer
      Dim arr() As String
      On Error Resume Next
      arr = Split(Me.Picture1(Index).Tag, ";")
      
      Select Case Button
         Case VB6.MouseButtonConstants.LeftButton
            rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_LBUTTONDOWN)
         Case VB6.MouseButtonConstants.RightButton
            rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_RBUTTONDOWN)
         Case VB6.MouseButtonConstants.RightButton
            rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_MBUTTONDOWN)
      End Select
   End Sub
   
   Private Sub Picture1_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles Picture1.MouseMove
      Dim Button As Short = eventArgs.Button \ &H100000
      Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
      Dim x As Single = VB6.PixelsToTwipsX(eventArgs.X)
      Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
      Dim Index As Short = Picture1.GetIndex(eventSender)
      Dim rc As Integer
      Dim arr() As String
      On Error Resume Next
      arr = Split(Me.Picture1(Index).Tag, ";")
      
      Call GetWindowThreadProcessId(CInt(arr(0)), rc)
      If rc = 0 Then
         Dic.Remove("h" & arr(0))
         Me.Picture1(Index).Tag = ""
         Me.Picture1(Index).Visible = False
         
         Refresh()
      End If
   End Sub
   
   Private Sub Picture1_MouseUp(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles Picture1.MouseUp
      Dim Button As Short = eventArgs.Button \ &H100000
      Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
      Dim x As Single = VB6.PixelsToTwipsX(eventArgs.X)
      Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
      Dim Index As Short = Picture1.GetIndex(eventSender)
      Dim rc As Integer
      Dim arr() As String
      On Error Resume Next
      arr = Split(Me.Picture1(Index).Tag, ";")
      
      Select Case Button
         Case VB6.MouseButtonConstants.LeftButton
            rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_LBUTTONUP)
         Case VB6.MouseButtonConstants.RightButton
            rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_RBUTTONUP)
         Case VB6.MouseButtonConstants.RightButton
            rc = PostMessage(CInt(arr(0)), CInt(arr(1)), CInt(arr(2)), WM_MBUTTONUP)
      End Select
   End Sub
End Class

[Tarik]

Sebas, пошёл разбирать. Спасибо! Если и правда пашет, с меня точно пиво

[SAS]

А можно ли по ID процесса определить сворачиваются ли его окна в трэй?