Сворачивание формы в трей

[darkich]

подскажите как (куда) вписать код чтоб он сработал при сворачивании формы - нужно для того чтоб при соворачивании форма падала в трей

[Cheese]

Попробуй вот так

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


' Form1.frm
VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Пример TrayIcon"
   ClientHeight    =   2295
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   2295
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox edtToolTip
      Height          =   285
      Left            =   2280
      TabIndex        =   3
      Top             =   1200
      Width           =   2295
   End
   Begin VB.CommandButton butDelete
      Caption         =   "Удалить"
      Height          =   375
      Left            =   3240
      TabIndex        =   2
      Top             =   1800
      Width           =   1335
   End
   Begin VB.CommandButton butModify
      Caption         =   "Изменить"
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Top             =   1800
      Width           =   1335
   End
   Begin VB.CommandButton butAdd
      Caption         =   "Добавить"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   1800
      Width           =   1335
   End
   Begin VB.Label labToolTip
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Всплывающая подсказка:"
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   1230
      Width           =   2010
   End
   Begin VB.Label Label1
      Caption         =   $"Form1.frx":0000
      Height          =   855
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   4455
   End
   Begin VB.Menu pmnuTray
      Caption         =   "[Tray]"
      Visible         =   0   'False
      Begin VB.Menu mnuHello
         Caption         =   "Привет из трея"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents cTray As TrayIcon
Attribute cTray.VB_VarHelpID = -1

'загрузка формы
Private Sub Form_Load()

   'запрещаем кнопки Удалить и Изменить, скрываем поле
      butModify.Enabled = False
      butDelete.Enabled = False
      edtToolTip.Visible = False
      labToolTip.Visible = False
     
   'создаем инстанс объекта
      Set cTray = New TrayIcon
     
End Sub

'выгрущка формы
Private Sub Form_Unload(Cancel As Integer)

   'убиваем объект
      Set cTray = Nothing
     
End Sub


'добавить иконку в трей
Private Sub butAdd_Click()
   
   'хендл окна
      cTray.hwnd = hwnd
   'иконка, что будет отображена в трее
      cTray.Icon = Icon
   'тултипс (всплывающая подсказка)
      cTray.ToolTipText = "Просто иконка"
     
   'создаем иконку
      cTray.Add
   
   'разрешаем кнопки Удалить и Изменить, показываем поле, запрещаем кнопку Добавить
      butAdd.Enabled = False
      butModify.Enabled = True
      butDelete.Enabled = True
      edtToolTip.Visible = True
      labToolTip.Visible = True
   
End Sub

'изменить иконку в трее
Private Sub butModify_Click()

   'меняем тултипс, можно поменять и Icon
      cTray.ToolTipText = edtToolTip.Text
     
   'меняем иконку
      cTray.Modify
     
End Sub

'удалить иконку из трея
Private Sub butDelete_Click()

   'удаляем иконку
      cTray.Delete
     
   'запрещаем кнопки Удалить и Изменить, скрываем поле, разрешаем кнопку Добавить
      butAdd.Enabled = True
      butModify.Enabled = False
      butDelete.Enabled = False
      edtToolTip.Visible = False
      labToolTip.Visible = False
   
End Sub


'ловим ивенты на форме
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

   'передаем данные в объект
      cTray.CallEvent X, Y
     
End Sub

'ивент срабатывает при действиях на иконке в трее
Private Sub cTray_OnIcon(MouseButton As Integer)
   'обладочная информация
      Debug.Print MouseButton
   
   'левый двойной клик
      If MouseButton = TRAYICON_MOUSE_LEFTDBLCLICK Then MsgBox "LeftDoubleClick on TrayIcon"
   'отжатие правой кнопки мыши
      If MouseButton = TRAYICON_MOUSE_RIGHTUP Then cTray.CallPopupMenu Me, pmnuTray, 2, , , mnuHello
     
End Sub


'TraySim.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TrayIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*********************************************************************
'*                            TrayIcon                               *
'*             Библиотека для работы с SystemTray                    *
'*-------------------------------------------------------------------*
'
'  Ивенты:
'     OnIcon ( MouseButton as integer )
'                       ; генерируется при действии над иконкой в трее.
'                       ; MouseButton соответствует - Enum TRAYICON_MOUSE_*.
'  Свойства:
'     hWnd (Long)       ; hWnd окна, к которому привязана иконка
'     Icon (Long)       ; указатель на иконку. Иконка должна быть 16 цветная.
'     ToolTipText       ; всплывающий текст
'
'  Методы:
'     Add ( )           ; добавление иконки в трей. Заранее нужно установить все свойства.
'     Modify ( )        ; изменение иконки в трее.
'     Delete ( )        ; удаление иконки из трея
'     CallEvent ( X as single, Y as single )
'                       ; вызывается из Form_MouseDown, ей передаются значения X и Y
'
'---------------------------------------------------------------------
'     Version 0.90 Beta * Copyright (с) А.Щербаков * May 17, 2000
'*********************************************************************
   Option Explicit

'декларация функций Win32API
   Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
   Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
   Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'константы и структуры Win32API
   Private Const NIF_MESSAGE = &H1
   Private Const NIF_ICON = &H2
   Private Const NIF_TIP = &H4
   Private Const NIM_ADD = &H0
   Private Const NIM_MODIFY = &H1
   Private Const NIM_DELETE = &H2
   Private Const WM_RBUTTONDOWN = &H204
   Private Const WM_NULL = &H0
   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 NID As NOTIFYICONDATA

'---------------------------------------------------------------------

'переменные и структуры модуля
   Private m_hWnd          As Long
   Private m_Icon          As Long
   Private m_ToolTipText   As String
   Public Enum TrayIcon_Mouse
      TRAYICON_MOUSE_NONE = 0
      TRAYICON_MOUSE_LEFTDOWN = 1
      TRAYICON_MOUSE_LEFTUP = 2
      TRAYICON_MOUSE_LEFTDBLCLICK = 3
      TRAYICON_MOUSE_RIGHTDOWN = 4
      TRAYICON_MOUSE_RIGHTUP = 5
      TRAYICON_MOUSE_RIGHTDBLCLICK = 6
   End Enum

'ивенты
   Public Event OnIcon(MouseButton As Integer)
   

'---------------------------------------------------------------------
'  Свойства

'получить свойство hWnd
Public Property Get hwnd() As Long
      hwnd = m_hWnd
End Property

'присвоить свойство hWnd
Public Property Let hwnd(ByVal NewValue As Long)
      m_hWnd = NewValue
End Property


'получить свойство Icon
Public Property Get Icon() As Long
      Icon = m_Icon
End Property

'присвоить свойство Icon
Public Property Let Icon(ByVal NewValue As Long)
      m_Icon = NewValue
End Property


'получить свойство ToolTipText
Public Property Get ToolTipText() As String
      ToolTipText = m_ToolTipText
End Property

'присвоить свойство ToolTipText
Public Property Let ToolTipText(ByVal NewValue As String)
      m_ToolTipText = NewValue
End Property

'---------------------------------------------------------------------
'  Методы

'добавление иконки в Tray
Public Sub Add()
   Dim ret As Long
     
   'заполняем структуру
      NID.uID = m_hWnd
      NID.hwnd = m_hWnd
      NID.hIcon = m_Icon
      NID.szTip = Left$(m_ToolTipText, 63) & Chr$(0)
      NID.uFlags = NIF_TIP + NIF_MESSAGE + NIF_ICON
      NID.uCallbackMessage = WM_RBUTTONDOWN
      NID.cbSize = Len(NID)
   
   'вызываем функцию API
      ret = Shell_NotifyIcon(NIM_ADD, NID)
     
End Sub

'изменение иконки и ToolTip в Tray
Public Sub Modify()
   Dim ret As Long
   
   'заполняем структурку
      NID.hIcon = m_Icon
      NID.szTip = Left$(m_ToolTipText, 63) & Chr$(0)
      NID.uFlags = NIF_TIP + NIF_ICON
      NID.cbSize = Len(NID)
     
   'вызываем функцию API
      ret = Shell_NotifyIcon(NIM_MODIFY, NID)
     
End Sub

'удаление иконки из Tray
Public Sub Delete()
   Dim ret As Long
   
   'заполняем структурку
      NID.cbSize = Len(NID)
   
   'вызываем функцию API
      ret = Shell_NotifyIcon(NIM_DELETE, NID)
     
End Sub


'вызвать ивент
Public Sub CallEvent(X As Single, Y As Single)
   'проверка, было ли действие по окну или по иконке в трее
      If Y Then Exit Sub
     
   'получаем тип действия
      Dim MouseButton As Integer
      MouseButton = (X And &HFF) / Screen.TwipsPerPixelX
   
   'генерируем ивент
      RaiseEvent OnIcon(MouseButton)
     
End Sub

'вызов всплывающего меню
Public Sub CallPopupMenu(Window As Form, PopMenu As Menu, Optional Flags, Optional X, Optional Y, Optional DefMenu)
     
   'устанавливаем окно
      SetForegroundWindow m_hWnd
     
   'выводим всплывающее меню
      Window.PopupMenu PopMenu, Flags, X, Y, DefMenu
     
   'посылаем сообщение окну
      PostMessage m_hWnd, WM_NULL, 0, 0

End Sub

' TraySem.vbp
Type=Exe
Form=Form1.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\StdOle2.tlb#OLE Automation
Class=TrayIcon; TrayIcon.cls
IconForm="Form1"
Startup="Form1"
Command32=""
Name="TraySample"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
ThreadPerObject=0
MaxNumberOfThreads=1

' TraySim.vbw
Form1 = 9, 14, 688, 464, C, 152, 70, 522, 318, C
TrayIcon = 25, 21, 670, 440, C


[Cheese]

А лучше загляни в свое мыло там все это в нормальном виде

[darkich]

А лучше загляни в свое мыло там все это в нормальном виде

эээээээ - Но всёравно спасибо!!!!! буду разбираться
в трей кидать умею вот на сворачивание код поместить не могу

[MEMBER]

Лучщее сворачивание Me.Hide
Всё остальное от лукавого.