VB托盘图标实现

合集下载

最小化到托盘

Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
cSysTray1.InTray = True
Me.Visible = FalseEnd If
End SLeabharlann b 点击托盘图标后让程序显示出来，如下：
Private Sub cSysTray1_MouseDown(Button As Integer, Id As Long)
Me.WindowState = vbNormal
Me.Visible = True
cSysTray1.InTray = False
Me.SetFocus
End Sub
然后在自己的VB程序中添加改控件(工程-部件-浏览)。
最好把这个ocx放到C:\WINDOWS\system32。
改控件的属性InTray属性用来设置是否显示在托盘中，True为显示在托盘，False为不显示。TrayIcon属性是在托盘中显示的图标式样。TrayTip属性是鼠标移到改控件上面显示的提示文字。如果要使程序最小化时显示到托盘，如下：
单击“最小化”按钮（标题栏的右边）将窗口缩小为任务栏上右边的图标，同时隐藏原窗体。单击或者右键托盘化的图标，可以重现原窗体。
vb中有部分api可以实现将窗体最小化的功能，但是非常繁琐。这里有一个非常简单的办法：可以用微软封装好的控件来实现，不过该控件并不在VB安装目录中，需要找到VB的安装盘(不是安装以后的目录)的COMMON\TOOLS\VB\UNSUPPRT\SYSTRAY目录，将Systray目录拷到硬盘上面并编译为ocx控件（编译前记得要先把只读属性修改掉，有时候会提示要先保存，直接保存。），

怎么能让VB 程序最小化时在托盘显示呀急急急!~希望VB高手帮忙!

给你个例子吧建立一个frmmain主窗体Option ExplicitPrivate Sub Form_Load()'初始化imgIcon控件的Picture属性imgIcon.Picture = LoadPicture(App.Path & "\" & "heart.ico") mnuTrayShow.Enabled = False'初始化NOTIFYICONDATA数据结构Dim nid As NOTIFYICONDATAnid.cbSize = Len(nid)nid.hwnd = frmTemp.hwndnid.uId = 1&nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE nid.uCallbackMessage = WM_NOTIFYICONnid.hicon = imgIcon.Picturenid.szTip = "系统托盘中的图标" & Chr(0)'调用Shell_NotifyIcon函数将图标加入到系统托盘中Shell_NotifyIcon NIM_ADD, nidEnd SubPrivate Sub Form_Unload(Cancel As Integer)'设置自定义类型的变量的内容Dim nid As NOTIFYICONDATAnid.cbSize = Len(nid)nid.hwnd = frmTemp.hwndnid.uId = 1&nid.uFlags = 0'调用Shell_NotifyIcon方法来删除系统托盘中的图标Shell_NotifyIcon NIM_DELETE, nidUnload frmTempEnd SubPrivate Sub mnuTrayExit_Click()Unload MeEnd SubPrivate Sub mnuTrayHide_Click()'隐藏窗体，并相应改变菜单项的状态Me.HidemnuTrayHide.Enabled = FalsemnuTrayShow.Enabled = TrueEnd SubPrivate Sub mnuTrayIcon_Click()'设置dlgOpen公用对话框的属性，以便取得相应的图标文件dlgOpen.Filter = "图标文件(*.ico)|*.ico"dlgOpen.Flags = cdlOFNFileMustExistdlgOpen.ShowOpenIf dlgOpen.FileName = "" Then Exit Sub'根据所取得图标文件，来改变imgIcon文件的属性imgIcon.Picture = LoadPicture(dlgOpen.FileName)'设置NOTIFYICONDATA数据结构Dim nid As NOTIFYICONDATAnid.cbSize = Len(nid)nid.hwnd = frmTemp.hwndnid.uId = 1&nid.uFlags = NIF_ICONnid.hicon = imgIcon.Picture'调用Shell_NotifyIcon函数来修改系统托盘中的图标Shell_NotifyIcon NIM_MODIFY, nidEnd SubPrivate Sub mnuTrayShow_Click()'显示窗体，并相应改变菜单项的状态Me.ShowmnuTrayHide.Enabled = TruemnuTrayShow.Enabled = FalseEnd SubPrivate Sub mnuTrayTip_Click()Dim str As Stringstr = InputBox("输入系统托盘中的图标的提示信息：", "提示信息") If str = "" Then Exit Sub'设置NOTIFYICONDATA数据结构Dim nid As NOTIFYICONDATAnid.cbSize = Len(nid)nid.hwnd = frmTemp.hwndnid.uId = 1&nid.uFlags = NIF_TIPnid.szTip = str & Chr(0)'调用Shell_NotifyIcon函数来修改系统托盘中的图标的提示Shell_NotifyIcon NIM_MODIFY, nidEnd Sub再建立一个空窗体叫frmTemp再建一个模块,名字随便了Option Explicit'声明Shell_NotifyIcon函数，用于将图标加入到系统托盘中Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean'声明自定义的数据类型NOTIFYICONDATAPublic Type NOTIFYICONDATAcbSize As Longhwnd As LonguId As LonguFlags As LonguCallbackMessage As Longhicon As LongszTip As String * 64End Type'声明常量Public Const NIM_ADD = &H0Public Const NIM_MODIFY = &H1Public Const NIM_DELETE = &H2Public Const NIF_MESSAGE = &H1Public Const NIF_ICON = &H2Public Const NIF_TIP = &H4'定义SetWindowLong，用以改变frmTemp窗体的窗体函数Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long'定义事件的常数代码Public Const WM_LBUTTONDOWN = &H201Public Const WM_RBUTTONDOWN = &H204Public Const WM_USER = &H400'定义自定义的事件WM_NOTIFYICONPublic Const WM_NOTIFYICON = WM_USER + &H100'替换窗口处理函数Public Const GWL_WNDPROC = (-4)'该函数为frmTest的窗体处理函数。

VB实现在窗口的标题栏上添加一个按钮的功能实现程序最小化到系统托盘

程序运行窗口在窗口的标题栏上添加了一个按钮，实现最小化到系统托盘右键菜单1、复制以下程序段到记事本中另存为文件：Type=ExeReference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\std ole2.tlb#OLE AutomationModule=TrayStartup="frmMain"HelpFile=""ExeName32="Project1.exe"Path32="..\..\..\..\..\..\WINDOWS\Desktop"Command32=""Name="Project1"HelpContextID="0"CompatibleMode="0"MajorVer=1MinorVer=0RevisionVer=0AutoIncrementVer=0ServerSupportFiles=0VersionCompanyName="None"CompilationType=0OptimizationType=0FavorPentiumPro(tm)=0CodeViewDebugInfo=0NoAliasing=0BoundsCheck=0OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1[MS Transaction Server] AutoRefresh=1Begin VB.Form frmMainAutoRedraw = -1 'TrueCaption = "TitleBar Tray Button Demo"ClientHeight = 2040ClientLeft = 60ClientTop = 345ClientWidth = 4680LinkTopic = "Form1"ScaleHeight = 2040ScaleWidth = 4680StartUpPosition = 3 '窗口缺省Begin VB.Menu mnuPopUpCaption = ""Visible = 0 'FalseBegin VB.Menu mnuRestoreCaption = "Restore"EndEndEndAttribute VB_Name = "frmMain"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Sub Form_Load()Print "Right Click For Menu"Me.ScaleMode = vbPixels 'The API works in pixelsHook Me 'FormHook Hook()End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)If Button = 2 Then TrayMenu Me 'TrayNotify TrayMneu()End SubPrivate Sub Form_Unload(Cancel As Integer)UnHook 'FormHook UnHook()End SubAttribute VB_Name = "ToolTip"Const WS_EX_TOPMOST = &H8&Const TTS_ALWAYSTIP = &H1Const HWND_TOPMOST = -1Const SWP_NOACTIVATE = &H10Const SWP_NOMOVE = &H2Const SWP_NOSIZE = &H1Const WM_USER = &H400Const TTM_ADDTOOLA = (WM_USER + 4)Const TTF_SUBCLASS = &H10Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long 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 LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongType TOOLINFOcbSize As LonguFlags As Longhwnd As Longuid As LongRECT As RECThinst As LonglpszText As StringlParam As LongEnd TypePublic hWndTT As LongPublic Sub CreateTip(hwndForm As Long, szText As String, rct As RECT)hWndTT = CreateWindowEx(WS_EX_TOPMOST, "tooltips_class32", "",TTS_ALWAYSTIP, _0, 0, 0, 0, hwndForm, 0&, App.hInstance, 0&)SetWindowPos hWndTT, HWND_TOPMOST, 0, 0, 0, 0, _SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATEDim TI As TOOLINFOWith TI.cbSize = Len(TI).uFlags = TTF_SUBCLASS.hwnd = hwndForm.uid = 1&.lpszText = szText & vbNullChar.RECT = rctEnd WithSendMessage hWndTT, TTM_ADDTOOLA, 0, TIEnd SubPublic Sub KillTip()DestroyWindow hWndTTEnd Sub4、复制以下程序段到记事本中另存为文件：Attribute VB_Name = "DrawButton"Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As LongDeclare Function GetTitleBarInfo Lib "user32" (ByVal hwnd As Long, pti As TitleBarInfo) As BooleanDeclare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As LongDeclare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As LongDeclare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongType RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypeType TitleBarInfocbSize As LongrcTitleBar As RECT 'A RECT structure that receives the coordinates of the title barrgState(5) As Long 'An array that receives a DWORD value for each element of the title barEnd Type'rgState array Values'0 The titlebar Itself'1 Reserved'2 Min button'3 Max button'4 Help button'5 Close button''rgstate return constatnts'STATE_SYSTEM_FOCUSABLE = &H00100000'STATE_SYSTEM_INVISIBLE = &H00008000'STATE_SYSTEM_OFFSCREEN = &H00010000'STATE_SYSTEM_PRESSED = &H00000008'STATE_SYSTEM_UNAVAILABLE = &H00000001Const DFC_BUTTON = 4Const DFCS_BUTTONPUSH = &H10Const DFCS_PUSHED = &H200Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPublic Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPublic Type POINTAPIx As Longy As LongEnd TypeConst SM_CXFRAME = 32Const COLOR_BTNTEXT = 18Dim lDC As LongPublic R As RECTPublic Sub ButtonDraw(frm As Form, bState As Boolean)Dim TBButtons As IntegerDim TBarHeight As IntegerDim TBButtonHeight As IntegerDim TBButtonWidth As IntegerDim DrawWidth As IntegerDim TBI As TitleBarInfoDim TBIRect As RECTDim bRslt As BooleanDim WinBorder As IntegerWith frmIf .BorderStyle = 0 Then Exit Sub ' Don't draw a button if there is no titlebar'----How Many Buttons in TitleBar------------------------------------------If Not .ControlBox Then TBButtons = 0If .ControlBox Then TBButtons = 1If .ControlBox And .WhatsThisButton ThenIf .BorderStyle < 4 ThenTBButtons = 2ElsetButtons = 1End IfEnd IfIf .ControlBox And .MinButton And .BorderStyle = 2 Then TBButtons = 3If .ControlBox And .MinButton And .BorderStyle = 5 Then TBButtons = 1If .ControlBox And .MaxButton And .BorderStyle = 2 Then TBButtons = 3If .ControlBox And .MaxButton And .BorderStyle = 5 Then TBButtons = 1'------------------------------------------------------------------------'----Get height of Titlebar----------------------------------------------'Using this method gets the height of the titlebar regardless of the window'style. It does, however, restrict its use to Win98/2000. So if you want to'use this code in Win95, then call GetSystemMetrics to find the windowstyle'and titlebar size.TBI.cbSize = Len(TBI)bRslt = GetTitleBarInfo(.hwnd, TBI)TBarHeight = TBIRect.Bottom - TBIRect.Top - 1'-----------------------------------------------------------------------'----Get WindowBorder Size----------------------------------------------If .BorderStyle = 2 Or .BorderStyle = 5 ThenR.Top = GetSystemMetrics(32) + 2WinBorder = R.Top - 6ElseR.Top = 5WinBorder = -1End IfEnd With'---------------------------------------------------------------------------'----Use Titlebar Height to determin button size----------------------------TBButtonHeight = TBarHeight - 4TBButtonWidth = TBButtonHeight + 2'and the size and space of the dot on the buttonDrawWidth = TBarHeight / 8'---------------------------------------------------------------------------'----Determin the position of our button------------------------------------R.Bottom = R.Top + TBButtonHeightSelect Case TBButtonsCase 1R.Right = frm.ScaleWidth - (TBButtonWidth) + WinBorderCase 2R.Right = frm.ScaleWidth - ((TBButtonWidth * 2) + 2) + WinBorderCase 3R.Right = frm.ScaleWidth - ((TBButtonWidth * 3) + 2) + WinBorderCase ElseEnd SelectR.Left = R.Right - TBButtonWidth'--------------------------------------------------------------------------'----Get the Widow DC so that we may draw in the title bar-----------------lDC = GetWindowDC(frm.hwnd)'--------------------------------------------------------------------------'----Determin the position of thedot--------------------------------------Dim StartXY As Integer, EndXY As IntegerSelect Case TBarHeightCase Is < 20StartXY = DrawWidth + 1EndXY = DrawWidth - 1Case ElseStartXY = (DrawWidth * 2)EndXY = DrawWidthEnd Select'--------------------------------------------------------------------------'----We have all the information we need So Draw the button----------------Dim rDot As RECTIf bState ThenDrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHEDrDot.Left = R.Right - (1 + StartXY): rDot.Top = R.Bottom - (1 + StartXY)rDot.Right = R.Right - (1 + EndXY): rDot.Bottom = R.Bottom - (1 + EndXY)ElseDrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSHrDot.Left = R.Right - (2 + StartXY): rDot.Top = R.Bottom - (2 + StartXY)rDot.Right = R.Right - (2 + EndXY): rDot.Bottom = R.Bottom - (2 + EndXY)End IfFillRect lDC, rDot, GetSysColorBrush(COLOR_BTNTEXT)'---------------------------------------------------------------------------'----SetTooltip------------------------------------------------------------ Dim TTRect As RECTTTRect.Bottom = R.Bottom + (TBarHeight - ((TBarHeight * 2) + WinBorder + 5))TTRect.Left = R.Left - (4 - WinBorder)TTRect.Right = R.Right - (4 - WinBorder)TTRect.Top = R.Top + (TBarHeight - ((TBarHeight * 2) + WinBorder + 5))KillTip 'ToolTip KillTip()CreateTip appForm.hwnd, "System Tray", TTRect 'ToolTip CreateTip()End Sub5、复制以下程序段到记事本中另存为文件：Attribute VB_Name = "TrayNotify"Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare Function CreatePopupMenu Lib "user32" () As LongDeclare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As LongDeclare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As LongDeclare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As LongType NOTIFYICONDATAcbSize As Longhwnd As Longuid As LonguFlags As LonguCallbackMessage As LonghIcon As Longsztip As String * 64End TypeConst NIM_ADD = &H0Const NIM_DELETE = &H2Const NIM_MODIFY = &H1Const NIF_MESSAGE = &H1Const NIF_ICON = &H2Const NIF_TIP = &H4Const MF_GRAYED = &H1&Const MF_STRING = &H0&Const MF_SEPARATOR = &H800&Const TPM_NONOTIFY = &H80&Const TPM_RETURNCMD = &H100&Public bTraySet As BooleanDim lMenu As LongPublic Sub TraySet(frm As Form, sztip As String, hIcon As Long)Dim NID As NOTIFYICONDATAWith NID.cbSize = Len(NID).hIcon = hIcon.sztip = sztip & vbNullChar.uCallbackMessage = WM_LBUTTONUP.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP .uid = 1&End WithShell_NotifyIcon NIM_ADD, NIDbTraySet = TrueEnd SubPublic Sub TrayRestore(frm As Form)Dim NID As NOTIFYICONDATAWith NID.cbSize = Len(NID).uid = 1&End WithShell_NotifyIcon NIM_DELETE, NIDbTraySet = FalseEnd SubPublic Sub TrayMenu(frm As Form)Dim hMenu As Long, tMenu As LongDim MP As POINTAPIGetCursorPos MPhMenu = CreatePopupMenu()If bTraySet ThenAppendMenu hMenu, MF_STRING, 1000, "Restore" ElseAppendMenu hMenu, MF_STRING Or MF_GRAYED, 1000, "Restore"End IfAppendMenu hMenu, MF_SEPARATOR, 0&, 0&AppendMenu hMenu, MF_STRING, 1010, "Exit"tMenu = TrackPopupMenu(hMenu, TPM_NONOTIFY Or TPM_RETURNCMD, MP.x, MP.y, 0&, frm.hwnd, 0&)Select Case tMenuCase 1000TrayRestore frmCase 1010TrayRestore frmUnHookUnload frmCase Else'do nothingEnd SelectDestroyMenu hMenuEnd Sub6、复制以下程序段到记事本中另存为文件：Attribute VB_Name = "FormHook"Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _ (ByVal lpPrevWndFunc As Long, _ByVal hwnd As Long, _ByVal Msg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ByVal nIndex As Long, _ByVal dwNewLong As Long) As LongDeclare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPublic Const GWL_WNDPROC = -4Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_MOUSEMOVE = &H200Public Const WM_NCMOUSEMOVE = &HA0Public Const WM_NCLBUTTONDOWN = &HA1Public Const WM_NCLBUTTONUP = &HA2Public Const WM_NCLBUTTONDBLCLK = &HA3Public Const WM_NCRBUTTONDOWN = &HA4Public Const WM_NCRBUTTONUP = &HA5Public Const WM_ACTIVATE = &H6Public Const WM_NCPAINT = &H85Public Const WM_PAINT = &HFPublic Const WM_ACTIVATEAPP = &H1CPublic Const WM_MOUSEACTIVATE = &H21Public Const WM_COMMAND = &H111Public Const WM_NCACTIVATE = &H86Public Const WM_DESTROY = &H2Public Const WM_SIZE = &H5Global lpPrevWndProc As LongGlobal gHW As LongGlobal appForm As FormPrivate Function MakePoints(lParam As Long) As POINTAPIDim hexstr As Stringhexstr = Right("00000000" & Hex(lParam), 8)MakePoints.x = CLng("&H" & Right(hexstr, 4)) - (appForm.Left / Screen.TwipsPerPixelX)MakePoints.y = CLng("&H" & Left(hexstr, 4)) - (appForm.Top / Screen.TwipsPerPixelY)End FunctionPublic Sub Hook(frm As Form)Set appForm = frmlpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)End SubPublic Sub UnHook()Dim lngReturnValue As LonglngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) End SubFunction WindowProc(ByVal hwnd As Long, _ByVal uMsg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As Long'------------------------------------------------------------------------------'Messing around in here can cause allsorts of problems.'So, if you must, make sure you save everytihing you want to keep 'before you run the program.'Don't run anything outside of a message selection as it will be 'executed so many times per second that it will slow down system response.Dim lRslt As LongDim retProc As BooleanStatic STButtonState As BooleanStatic Toggle As BooleanStatic i As IntegerOn Error Resume NextSelect Case uMsgCase WM_DESTROYTrayRestore appFormKillTip 'ToolTip KillTip()UnHookretProc = TrueCase WM_NCMOUSEMOVE'Only draw the button when necessaryIf GetAsyncKeyState(vbLeftButton) < 0 ThenIf OverButton(lParam) ThenIf Toggle = False ThenToggle = TrueButtonDraw appForm, Toggle 'DrawButton ButtonDraw()End IfElseIf Toggle = True ThenToggle = FalseButtonDraw appForm, Toggle 'DrawButton ButtonDraw()End IfEnd IfElseSTButtonState = FalseretProc = TrueEnd IfCase WM_NCLBUTTONDOWNIf OverButton(lParam) ThenSTButtonState = TrueButtonDraw appForm, True 'DrawButton ButtonDraw()ElseSTButtonState = FalseretProc = TrueEnd IfCase WM_NCLBUTTONUPSTButtonState = FalseIf OverButton(lParam) ThenTraySet appForm, appForm.Caption, appForm.Icon'TrayNotify TraySet()ButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = FalseElseretProc = TrueEnd IfCase WM_LBUTTONUPSTButtonState = FalseButtonDraw appForm, False 'DrawButton ButtonDraw()If GetAsyncKeyState(vbLeftButton) < 0 And bTraySet Then TrayMenu appForm 'TrayNotify TrayMenu()End IfretProc = TrueCase WM_NCLBUTTONDBLCLK, WM_NCRBUTTONDOWNIf Not OverButton(lParam) ThenretProc = TrueEnd IfCase WM_SIZE, WM_NCPAINT, WM_PAINT, WM_COMMANDButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = TrueCase WM_ACTIVATEAPP, WM_NCACTIVATE, WM_ACTIVATE, WM_MOUSEACTIVATEButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = TrueCase ElseretProc = TrueEnd SelectIf retProc ThenWindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)ElseWindowProc = 0End IfEnd FunctionPrivate Function OverButton(lParam As Long) As Boolean Dim MP As POINTAPIMP = MakePoints(lParam)If PtInRect(R, MP.x, MP.y) Then OverButton = True End Function双击工程文件：运行，就可以看到效果。

实现将程序图标显示在系统托盘

长久以来，一直很好奇类似QQ等软件的图标是如何显示在系统托盘的，这次有个项目正好用到，所以就研究了一下。

具体方法如下：1、首先我们需要在工具栏找到NotifyIcon这个控件，找到后将其拖到Form中。

然后，我们需要设置其Icon属性、Text属性和Visible属性。

其中：Icon属性是设置显示在右下角系统托盘的图标。

Text属性是设置当鼠标移动到系统托盘图标时显示的文字，一般设置为软件的名称。

Visible属性是设置小图标是否显示在系统托盘。

注意：如果程序退出前没有将其设置为false，那么小图标将一直停留在系统栏，直到鼠标从上面经过时才会消失。

2、基本属性设置完之后，我们要将程序主窗体的ShowInTaskBar设置为True。

这样小图标才可以显示在系统托盘中，一般，这个属性默认就是True。

3、设置完属性，我们就需要对NotifyIcon方法进行实现。

我要做的实现是当点击最小化时，让程序的图标出现在“系统托盘”的位置上，而不显示在“任务栏”中。

当双击系统托盘上的图标时，还原程序窗体，再次双击时最小化到系统托盘。

点击程序的关闭按钮，正常退出程序。

要实现上面的功能我们需要实现两个方法：一个方法是主窗体的SizeChanged事件。

view plai n1./// <summary>2./// 最小化时到系统托盘3./// </summary>4./// <param name="sender"></param>5./// <param name="e"></param>6.private void MainForm_SizeChanged(object sender, EventArgs e)7.{8.if (this.WindowState == FormWindowState.Minimized) //判断是否最小化9. {10.this.ShowInTaskbar = false; //不显示在系统任务栏11. }12.}一个是NotifyIcon的双击事件。

任务栏托盘图标及右键菜单实现

VC++任务栏托盘图标及右键菜单实现作者：xingzhe826 日期：2013年11月14日1.创建单文档工程TaskQMenu2.设置图标右键菜单，ID为IDR_TPMENU3.初始化托盘图标// 初始化托盘图标NOTIFYICONDATA nifd; // NOTIFYICONDATA 结构声明nifd.cbSize = sizeof(NOTIFYICONDATA); // NOTIFYICONDATA 结构体大小nifd.hWnd = m_hWnd; // 标识窗口：接收与托盘图标相关的消息 nifd.uID = IDR_MAINFRAME; // 指定任务栏图标nifd.uFlags = NIF_MESSAGE // 指定该结构体变量的那些成员变量有效| NIF_ICON| NIF_TIP;nifd.uCallbackMessage = WM_UIMSG; // 自定义消息标识：当托盘图标发生鼠标事// 件或使用键盘选择或激活图标时，系统将// 次标识向hWnd窗口发送消息 nifd.hIcon = theApp.LoadIcon(IDR_MAINFRAME);// 图标句柄lstrcpy(nifd.szTip, _T("提示文本")); // 托盘图标提示文本Shell_NotifyIcon(NIM_ADD, &tnd); // 安装托盘图标4.消息处理BEGIN_MESSAGE_MAP(CMainFrame, CFrameWnd)ON_MESSAGE(WM_UIICON, OnNotifyIcon) // WM_UIICON消息映射END_MESSAGE_MAP()afx_msg LRESULT OnNotifyIcon(WPARAM wParam, LPARAM lParam);// 消息处理LRESULT CMainFrame::OnNotifyIcon(WPARAM wParam, LPARAM lParam){UINT uID; // 发出该消息的消息的图标IDUINT uMouseMsg; // 鼠标消息uID = (UINT)wParam; // 参数解析并赋值uMouseMsg = (UINT)lParam;if(WM_LBUTTONDOWN == uMouseMsg){// 单击左键if (IDR_MAINFRAME == uID){if (IsIconic()) // 是否最小化(图标化)窗口{ShowWindow(SW_NORMAL);}}}else if (WM_RBUTTONDOWN == uMouseMsg){// 单击右键if (IDR_MAINFRAME == uID){CMenu menu;menu.LoadMenu(IDR_TPMENU); // 加入图标右键快捷菜单SetForegroundWindow(); // 放置在前面CMenu* pMenu = menu.GetSubMenu(0); // 下拉菜单ASSERT(NULL != pMenu);POINT pt;GetCursorPos(&pt);pMenu->TrackPopupMenu( // 弹出快捷菜单TPM_RIGHTBUTTON | TPM_LEFTALIGN, pt.x, pt.y, this);pMenu->DestroyMenu();}}return TRUE;}5.在程序退出消息处理程序中执行托盘图标卸载过程// 添加消息映射BEGIN_MESSAGE_MAP(CMainFrame, CFrameWnd)ON_COMMAND(ID_APP_EXIT, OnAppExit)END_MESSAGE_MAP()// 消息处理函数afx_msg void OnAppExit();void ExitNotifyIcon();void CMainFrame::OnAppExit(){ExitNotifyIcon();}void CMainFrame::ExitNotifyIcon(){NOTIFYICONDATA nifd;nifd.cbSize = sizeof(NOTIFYICONDATA);nifd.hWnd = m_hWnd;nifd.uID = IDR_MAINFRAME;Shell_NotifyIcon(NIM_DELETE, &nifd);AfxPostQuitMessage(0);}小结：1）学习理解NOTIFYICONDATA结构体中的成员变量2）Shell_NotifyIcon()的使用：安装/卸载3）IsIconic()的使用4）自定义消息映射/ID_APP_EXIT系统ID的应用PS：衣缘满室此链接与学习无关，纯粹GG。

VB代码VB小程序：在系统托盘为程序添加图标

VB代码VB小程序：在系统托盘为程序添加图标当前位置：首页> VB小程序1-99 > 在系统托盘为程序添加图标20. 在系统托盘为程序添加图标本人原创，转载请注明出处：/100bd/blog/item/330b4d88ab0fa0b80e244455.html为程序在系统托盘中添加图标，要解决两个问题：一、调用 API 函数 Shell_NotifyIcon 添加图标，设置正确的参数。

程序结束时，从系统托盘删除添加的图标。

二、拦截窗口的回调函数，响应用户在系统托盘图标上的鼠标事件，一般是弹出快捷菜单。

自定义的回调函数不能放在窗体代码中，必须在模块中。

编写有关窗口回调函数的程序，最大的难点在于调试。

调试时，如果在窗口回调函数过程的执行期间设置断点，轻则影响窗口的自动重画，重则使程序停止响应。

因此，修改代码后应注意及时保存。

下面是实现在系统托盘为程序添加图标的完整代码，包括一个窗体和一个模块：'■■以下是窗体 Form1 的代码 ------------------------------------' 1.为窗体添加菜单' 为窗体添加菜单: mFast' 为 mFast 添加下级子菜单 mmFast，并将 mmFast 的索引设置为 0' 2.在窗体上添加四个控件，所有控件均采用默认设置：' Label1，Command1，Command2，Command3Dim ctTrayIco As NotifyIconDataPrivate Sub Form_Load()Me.Caption = "系统托盘例子"'为数组菜单 mmFast 添加条目mFast.Visible = FalseLoadKjZu mmFast, "显示 " & Me.Caption & "(&R)", "mmFast-Run"LoadKjZu mmFast, "最小化窗口(&N)", "mmFast-Min"LoadKjZu mmFast, "菜单例子 1 (&A)", "mmFast-A"LoadKjZu mmFast, "菜单例子 2 (&B)", "mmFast-B"LoadKjZu mmFast, "-" '菜单分隔条LoadKjZu mmFast, "退出(X)", "mmFast-Exit"Dim S As SingleLabel1.AutoSize = True: S = Label1.HeightLabel1.Caption = Me.Caption: Label1.Move S, SCommand1.Caption = "添加到系统托盘": Command1.Move S, S * 3, S * 11, S * 2Command2.Caption = "最小化到系统托盘": Command2.Move S, S * 6, S * 11, S * 2Command3.Caption = "从系统托盘删除图标": Command3.Move S, S * 9, S * 11, S * 2'将窗口函数的地址设置为模块中的 WndProc 过程，当用户'在系统托盘图标单击鼠标右键时，弹出自定义的菜单 mFastWinAddress Me.hWnd''如果需要程序一启动就添加到系统托盘，解除下面语句的注释即可'Call SysTrayEnd SubPrivate Sub Form_Resize()'设置快捷菜单的是否可用状态Dim nEnabled As BooleanOn Error Resume NextnEnabled = Me.WindowState = vbMinimizedmmFast(KjZuIndex(mmFast, "mmFast-Min")).Enabled = nEnabledmmFast(KjZuIndex(mmFast, "mmFast-Run")).Enabled = Not nEnabled End SubPrivate Sub Form_Unload(Cancel As Integer)SysTray True '退出时，从系统托盘删除本程序图标WinAddress Me.hWnd, True '退出时，将窗口地址还原End SubPrivate Sub LoadKjZu(Kj As Object, nCap As String, Optional nTag As String)'为数组控件添加一个成员Dim I As LongI = Kj.UBoundIf Kj(I).Tag <> "" ThenI = I + 1Load Kj(I): Kj(I).Visible = TrueEnd IfKj(I).Caption = nCapIf nCap = "-" Then Kj(I).Tag = "bar" Else Kj(I).Tag = nTag End SubPrivate Function KjZuIndex(Kj As Object, nTag As String) As Long'返回数组控件中 Tag 属性为 nTag 的成员索引，没有找到返回 -1Dim I As LongFor I = Kj.LBound To Kj.UBoundIf Kj(I).Tag <> nTag Then KjZuIndex = I: Exit FunctionNextKjZuIndex = -1End FunctionPrivate Sub mmFast_Click(Index As Integer)'系统托盘快捷菜单Dim nCmd As StringnCmd = Trim(mmFast(Index).Tag)Select Case UCase(nCmd)Case UCase("mmFast-Run"): Call WinNormal '正常显示主窗口Case UCase("mmFast-Min"): Call WinMinimized '缩小到系统托盘Case UCase("mmFast-Exit"): Unload Me '退出程序Case UCase("mmFast-A"): MsgBox "这是系统托盘快捷菜单：mmFast-A", vbInformation, Me.Caption'Case UCase("mmFast-B")Case Else: MsgBox "此命令在“mmFast_Click”中无效：" & vbCrLf & vbCrLf & "nCmd = " & nCmd, vbInformati on, Me.Caption & " - 无效命令"End SelectEnd SubPrivate Sub Command1_Click()Call SysTray '添加到系统托盘End SubPrivate Sub Command2_Click()Call WinMinimized '缩小到系统托盘End SubPrivate Sub Command3_Click()Call SysTray(True) '从系统托盘删除本程序图标End SubPrivate Sub WinNormal()'正常显示主窗口Me.Visible = TrueDoEventsMe.WindowState = 0End SubPrivate Sub WinMinimized()'缩小到系统托盘Me.WindowState = vbMinimizedCall SysTray: Me.Visible = FalseLabel1.Caption = "缩小到系统图标"End SubPrivate Sub SysTray(Optional IcoDel As Boolean)'在系统托盘为本程序添加图标Dim dl As LongIf IcoDel Thendl = Shell_NotifyIcon(NIM_DELETE, ctTrayIco)If dl = 0 ThenLabel1.Caption = "从系统托盘删除图标，失败" ElseLabel1.Caption = "已从系统托盘删除图标，成功" End IfExit SubEnd IfctTrayIco.cbSize = Len(ctTrayIco)ctTrayIco.hWnd = Me.hWndctTrayIco.uID = SysTray_IDctTrayIco.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP ctTrayIco.uCallbackMessage = WM_TrayctTrayIco.hIcon = Me.Icon.HandlectTrayIco.szTip = "我的系统托盘图标" & Chr(0)dl = Shell_NotifyIcon(NIM_ADD, ctTrayIco)If dl = 0 ThenLabel1.Caption = "图标添加到系统托盘，失败" ElseLabel1.Caption = "图标已添加到系统托盘，成功" End IfEnd Sub'■■以下是模块代码 ------------------------------------Public Type NotifyIconDatacbSize As Long '结构大小，设置为：Len(NotifyIconData)hWnd As Long '建立托盘图标窗体的句柄uID As Long '托盘图标 ID 标识uFlags As Long '对图标的操作方式：uCallbackMessage As Long '回调函数消息编号，设置为：WM_USER + ？hIcon As Long '图标 Handle，设置为：Me.Icon.HandleszTip As String * 64 '图标提示信息，设置为："字符串" & Chr(0)End TypePublic Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_N otifyIconA" (ByVal dwMessage As Long, lpData As NotifyIconData) As LongPublic Const SysTray_ID = 1Public Const NIM_ADD = &H0Public Const NIM_DELETE = &H2Public Const NIM_MODIFY = &H1Public Const NIF_MESSAGE = &H1Public Const NIF_ICON = &H2Public Const NIF_TIP = &H4Public Const WM_USER = &H400Public Const WM_Tray = WM_USER + 2Private Declare Function CallWindowProc Lib "user32" Alias "CallWindo wProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByV al wParam As Long, ByVal lParam As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWind owLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindo wLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As L ongPublic Const GWL_WNDPROC = (-4)Public Const WM_KEYDOWN = &H100Public Const WM_KEYUP = &H101Public Const WM_CHAR = &H102Public Const WM_SYSKEYDOWN = &H104Public Const WM_SYSKEYUP = &H105Public Const WM_SYSCHAR = &H106Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_RBUTTONDOWN = &H204Public Const WM_RBUTTONUP = &H205Dim moProc As LongPublic Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Lon g, ByVal lParam As Long) As Long'这是自定义的窗口回调函数。

vb右键点击托盘的图标弹出菜单,怎样实现？

vb右键点击托盘的图标弹出菜单,怎样实现？注意事项：一定记得建立菜单并且名称必须和代码中的一致或者修改代码中的名称否则会有错误提示,在代码最后有一段代码，把这段代码复制到窗体代码里面取消注释即可建立步骤：1.新建一个工程，设置窗体的属性BoarderStyle为1-Fixed singleMinButton为trueShowIntaskbar为false把下文的窗体代码内容复制到工程的窗体代码框；2.工程添加一个模块并把文中的模块代码复制到模块代码里；3.右键点击窗体选择菜单编辑器，在名称中输入mnuTray,标题为“右键菜单”，可见复选框设为非选择状态；点击下一个，点击右箭头，在名称里输入mnuTrayexit,标题为“退出”；最后点击确定。

4.点击工具栏中的启动按钮，运行程序；5.点击最小化键，在托盘显示出图标并隐藏了窗口即：最小化到系统状态栏。

右键点击一下托盘图标，弹出菜单。

左键点击托盘图标窗口还原。

更改托盘图标：方法一：设置工程窗体的图标，即在窗体的属性中的Icon中选择自定义的*.ico文件。

代码中使用的是窗体的图标；方法二：使用一个图片框存储图标，并把图片框的句柄赋给Thedata中的HIcon即可,在with....end with中修改或直接Thedata.HIcon=...即可。

TheData.HIcon = Picture1.Picture.Handle'把图片框的图片句柄赋给TheData.HIconShell_NotifyIcon NIM_MODIFY, TheData动态显示托盘图标：添加定时器，每到定时值触发一次事件更换图标；重新设置Thedata.HIcon为新的图标然后使用 Shell_NotifyIcon NIM_MODIFY, TheData 修改图标显示。

***************************************模块代码***********************************************Option ExplicitPublic OldWindowProc As LongPublic TheForm As FormPublic TheMenu As MenuPublic Const WM_USER = &H400Public Const WM_LBUTTONUP = &H202 '左键消息编号Public Const WM_MBUTTONUP = &H208 '中键消息编号Public Const WM_RBUTTONUP = &H205 '右键消息编号Public Const TRAY_CALLBACK = (WM_USER + 1001&) '消息编号Public Const GWL_WNDPROC = (-4)Public Const NIF_ICON = &H2 'Public Const NIF_TIP = &H4Public Const NIF_MESSAGE = &H1Public Const NIM_ADD = &H0Public Const NIM_MODIFY = &H1Public Const NIM_DELETE = &H2Public Type NOTIFYICONDATA '定义结构NOTIFYICONDATA cbSize As Longhwnd As LongUid As LongUFlags As LongUCallbackMessage As LongHIcon As LongSzTip As String * 64End TypePublic TheData As NOTIFYICONDATA '定义结构对象TheDataPublic Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData AsNOTIFYICONDATA) As LongPublic Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As LongPublic Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long'自己建立的消息循环处理过程If Msg = TRAY_CALLBACK ThenIf lParam = WM_LBUTTONUP ThenIf TheForm.WindowState = vbMinimized ThenRemoveTrayTheForm.WindowState = vbNormalTheForm.ShowTheForm.SetFocusExit FunctionEnd IfEnd IfIf lParam = WM_RBUTTONUP ThenSetForegroundWindow TheForm.hwnd '按下右键时使窗体获得焦点，这也可以使用TheForm.SetFocus代替以实现右键菜单弹出后不能消失的问题TheForm.PopupMenu TheMenu '弹出菜单Exit FunctionEnd IfEnd IfNewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam) '把原来消息函数的消息传递给自定义的消息函数End FunctionPublic Sub SetTray() '调用此子过程添加托盘图标OldWindowProc = SetWindowLong(TheForm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc) '设置新的自定义消息循环函数以进行左、右键按键处理'存储原来消息函数地址到OldWindowProcWith TheData.Uid = 0.hwnd = TheForm.hwnd.cbSize = Len(TheData).HIcon = TheForm.Icon.Handle.UFlags = NIF_ICON.UCallbackMessage = TRAY_CALLBACK.UFlags = .UFlags Or NIF_MESSAGE Or NIF_TIP.SzTip = "右键退出菜单" & vbNullChar.cbSize = Len(TheData)End WithShell_NotifyIcon NIM_ADD, TheData '显示托盘图标End SubPublic Sub Minimized() '调用此子过程最小化隐藏窗体If TheForm.WindowState = vbMinimized Then TheForm.Hide End SubPublic Sub RemoveTray() '调用此子过程删除托盘图标With TheData.UFlags = 0End WithShell_NotifyIcon NIM_DELETE, TheData '删除托盘图标SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProc '恢复消息循环函数为原有的End Sub*************************************代码结束*************************************************'模块说明：模块包括建立托盘图标，删除托盘图标，最小化隐藏窗体，自定义消息循环函数'Settray子过程：功能为建立托盘图标，即调用此过程会设置自定义消息循环函数并建立托盘图标以及右键弹出菜单'Minimized子过程：功能为最小化时隐藏TheForm窗体'RemoveTray子过程：功能为删除托盘图标并恢复消息循环函数为原来函数'在窗体上应该使用菜单编辑器编辑一个菜单mnuTray并建立其子菜单mnuTrayexit (退出)，在mnuTrayexit (退出)的click事件里应该调用RemoveTray子过程并unload me;'TheForm 在开始时（Formload过程）应该指定为窗体Me；TheMenu在开始时（Formload过程）应该指定为菜单名称mnuTray;'为实现最小化时托盘显示应该在Form_Resize过程中隐藏窗体并调用Settray子过程以及Minimized子过程以建立托盘图标并隐藏窗体'以下为基本的建立托盘图标的过程代码*************************************窗体代码内容*********************************************Private Sub Form_Load()Set TheForm = Me '窗体Set TheMenu = mnuTray '菜单名称,一定要建立菜单且名称必须与代码的一致'代码中的菜单名称为mnuTray，标题自定义，mnuTray的子菜单为弹出来的菜单例中只建立了一个子菜单mnuTrayexitEnd SubPrivate Sub Form_Resize()If TheForm.WindowState = vbMinimized ThenSetTray '调用过程显示托盘图标Minimized '调用过程最小化隐藏窗体，效果为最小化到托盘End IfEnd SubPrivate Sub mnuTrayexit_Click()RemoveTray '调用过程删除托盘图标Unload TheForm '卸载窗体End Sub*************************************代码结束*************************************************。

VB实现托盘完整代码

VB托盘完整代码'VB最小化到托盘（含托盘菜单）的方法很多，这里介绍的是最简洁的做法，使用cSysTray控件，该控件需要自己编译并添加。

'需要找到VB的安装盘(不是安装以后的目录)的COMMON\TOOLS\VB\UNSUPPRT\SYSTRAY目录，将Systray目录拷到硬盘上面并编译为ocx控件（编译前记得要先把只读属性修改掉，有时候会提示要先保存，直接保存。

），使用安装包安装的用户，可在VB安装包里找到。

'以下是代码'API发送按键函数。

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Const KEYEVENTF_KEYUP = &H2’托盘菜单-退出选项'tuichu 为一菜单的名称'此处用API函数发送ALT+F1指令调用窗体退出菜单，因此窗体菜单-退出选项需设置快捷键ALT+F1Private Sub tuichu_Click()cSysTray1.InTray = False主程序.WindowState = vbNormal主程序.Visible = True主程序.SetFocuskeybd_event vbKeyControl, 0, 0, 0keybd_event vbKeyF1, 0, 0, 0keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0End sub'托盘弹出菜单Private Sub cSysTray1_MouseDown(Button As Integer, Id As Long)If Button = 2 Then PopupMenu tuopan, 10End Sub'最小化后归托盘Private Sub Form_Resize()If Me.WindowState = vbMinimized ThencSysTray1.InTray = TrueMe.Visible = FalseElse: cSysTray1.InTray = TrueEnd If'托盘菜单弹出主界面'zhujiemian 为一菜单项的名称Private Sub zhujiemian_Click()主程序.WindowState = vbNormal主程序.Visible = TrueEnd Sub'双击托盘菜单弹出主界面Private Sub cSysTray1_MouseDblClick(Button As Integer, Id As Long)主程序.WindowState = vbNormal主程序.Visible = True主程序.SetFocusEnd Sub'单击关闭不退出程序Private Sub Form_Unload(Cancel As Integer)主程序.HideCancel = FalseEnd Sub'单击关闭不退出程序Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Cancel = 1主程序.HideEnd Sub’tui为窗体菜单-退出选项名称Private Sub tui_Click()’快捷键设ALT+F1EndEnd Sub'注："主程序"代表一个窗体(Form)，窗体菜单-退出选项需设置快捷键ALT+F1 '这个控件有一个小小的问题，如果托盘菜单有退出选项，不能直接用"End 语句"，否则在编译后运行期间用户选择退出后，操作系统会报错，以上使用发送按键方法避免出错，当然还有其他避免出错方法。

隐藏或显示托盘图标

hwnd2 = FindWindow("Shell_TrayWnd", vbNullString)
hwnd2 = FindWindowEx(hwnd2, 0, "TrayNotifyWnd", vbNullString)
hwnd2 = FindWindowEx(hwnd2, 0, "SysPager", vbNullString)
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Dim pIdExplorer As Long, hwnd2 As Long, hExplorer As Long, lpIconText As Long
Dim i As Integer
Dim BtnCount As Integer
Dim IconText As String
nd If
Next
VirtualFreeEx hExplorer, lpIconText, Len(IconText), MEM_RELEASE
CloseHandle hExplorer

用VB实现托盘动画图标

Private Const NIM_ADD = &&H0
Private Const NIM_DELETE = &&H2
Private Const NIM_MODIFY = &&H1
Private Const WM_MOUSEMOVE = &&H200
Private Declare Function Shell_NotifyIcon Lib "shell32" _
If X = &&H1E3C Then
Me.PopupMenu mMyPopMenu
End If
End Sub
⑸窗体卸载时删除托盘中的图标：
Private Sub Form_Unload(Cancel As Integer)
图1
⑷其它控件，根据程序实际功能需要设置。
2.编写程序代码
⑴在窗体的声明部分给出如下声明：
Private Type NOTIFYICONDATA
cbSize As Long
注释：指定NOTIFYICONDATA结构长度
hWnd As Long 注释：指定接收回调消息的窗体或控件的句柄
End Sub
⑷响应托盘中图标的鼠标事件：
Private Sub picture1_MouseMove(Index As Integer, _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
.uId = 1&&
.uFlags = NIF_ICON

给VB应用程序制作托盘图标

。
关键词Ｗｉｄｗ托盘图标ＡＰ函数ｎｏｓＩ
ＭａｎｇＴｒｙＩｏｆｐｐｌｃｉｎｓｉＶＢｋｉａｃｎｏｒＡｉａｔｏｎ
ＬｉＪａｇｏｉｎｕ
ＡｂｔａｔｓｒｃＫｅｗｏｄｙｒＴｈｓｐｐｒｉｔｏｃｓｔｉａｅｎｒｄｕｅｈｅｍｅｏｔｓｉｄｗｓＡＰＩｎｋｓｒｙｉｏｏｐｌａｉｎｎＶＢｈｔｄｏｕｅＷｎｏａｄｍａｅｔｃｎｆｒａｐｉｔｓｉａｃｏＷｉｄｗｓｎｏＴｒｙＩｏＡＰｕｔｎａｃｎＩＦｃｉｏ
维普资讯
２０年ｌ０２Ｏ月
电脑学习
第５期
给Ｖ应用程序制作托盘图标Ｂ
李建国
摘要介绍了利用ＷｉｄｗＡＰｎｏｓＩ函数给ＶＢ应用程序制作托盘图标的方法
一
个，别代表添加、除、改托盘上的图标。参数ｌＤｔ分删修ｐａａＮＴＦＩＯＡＡ类型的参数非常重要，其中ｃＳｚＯＩＹＣＮＤＴｂｉｅ
１３操作说明．调用ｈｌＮｔｙｃｎ函数可以完成系统托盘区的所有Ｓｅ＿ｏｉｌｏｌｆ操作。该函数的参数有ｄＭｅｓｇｗｓａｅ和ｌＤｔｐａａ两个。参数
ｄＭｅｓｇｗｓａｅ是ＮＭ— Ｄ、ＩＤＬＴ、ＩＭＯＩＹ中的ＩＡＤＮＭ— ＥＥＥＮＭ＿ＤＦ

如何用VISUAL BASIC编写托盘程序

收辅日期：２０－－ｌ０１６Ｉ０
ＳｃＩｏｉＩｎ的函数声明ｈｌＮｔｙｃ－ｆｏ
作者越舟ｔ李夭明（９６），男．甘肃甘谷人，夭求市委党校讲师Ｉ６．３９
维普资讯
ＤｃａｅＦｎｔｎＳｅｌｔＩｏｉｅｌｒｕｃｉｈｌＮｏｃｎＬｂ” Ｓｅｌ２ｄｌＡｌｓ “ ｏ－ｈｌ．ｌ” ３ｉａ
中田分类号：Ｔ３３Ｐ９文献标识码：Ｂ文章编号：１７－３１２０）２０９０３１１５（０２０－３－３０
ｌ托盘程序的慨念及在ＶＢ中编写的原则
在Ｗｉｄｗ桌面上的任务栏里，右下角有许多应用程序ｎｏｓ目标，如系统时钟、输入法、计划任务等。而程序本身的窗口是隐藏的，若你要调用应用程序的窗口，则双击该图标即可，这种程序称为托盘程序。
ｃＳｚＤｎｂｉｅＡｓＬｇｈｄＡＬｗｎｓＤ唱
ｕＤＡＬｏｇｌｓｎ
ｕｌｇｓＬＦａｓＡＤｒ
ｕｌａｋ￣ｓｇＣａｌｃＭｂａｅＡｓｏｇＬｎ
ＨｄＡＬｎｗｕｓｏｇ’接受托盘图标消息的窗口指针ｕＤＡｓｏｇ’由程序定义的图标识别符。因为有的程ｌｎＬ序有多个图标ｕｇｓｍ ’对托盘图标操作的标志，包括添加、ＲａｓＡ修改，删除ｕａｌｃＭｃｇＡｓｏｇ’标志应用程序的消息Ｃｌａｋ￣ｃＬｎｂｈｃｎＡＬｎＩｏｓｏｇ’托盘图标指针ｓＴｐＡ￣ｎ＊４’当鼠标指到托盘图标时提示字符ｚｉｓ＇ｇ６Ｓｉ

托盘程序详解

Case vbMinimized
mnuTrayMaximize.Enabled = True
mnuTrayMinimize.Enabled = False
mnuTrayMove.Enabled = False
'【说明】
' 在窗口结构中为指定的窗口设置信息
'【返回值】
' Long，指定数据的前一个值
'【参数表】
End Sub
'保证在程序退出时删除托盘图标
Private Sub Form_Unload(Cancel As Integer)
RemoveFromTray
End Sub
'“文件”菜单的“退出”项被点击时
Private Sub mnuFileExit_Click()
Unload Me
'表示发送的是系统命令
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
'当主窗体加载时
托盘程序详解(一)
很多软件运行时会在系统托盘区(就是桌面右下角显示时间的区域)出现一个小图标，它作为程序运行的一个标志，我们可以通过使用小图标所弹出的菜单来控制应用程序的状态。本例就给出了一个功能比较完整的托盘程序，我们可以看到怎样用API函数Shell_NotifyIcon来添加、删除、更改托盘图标；而且例中还演示了为托盘图标添加右键菜单和浮动提示的方法。

vb将程序最小化到托盘

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hicon As Long) As LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As LongPublic Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As LongPublic Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongPublic Type POINTAPIx As Longy As LongEnd TypePublic Type NOTIFYICONDATAcbSize As Long '结构的长度hwnd As Long '消息接收窗口的句柄uID As Long '图标的标识uFlags As Long '设置参数uCallbackMessage As Long '回调消息的值hicon As Long '图标句柄szTip As String * 64 '提示字符串End TypePublic Const NIM_ADD = 0 '添加图标Public Const NIM_MODIFY = 1 '修改图标Public Const NIM_DELETE = 2 '删除图标Public Const NIF_MESSAGE = 1 '当有鼠标事件发生时产生消息Public Const NIF_ICON = 2 'Public Const NIF_TIP = 4 '图标有提示字符串Public Const WM_LBUTTONDOWN = &H201Public Const WM_RBUTTONDOWN = &H204Public Const WM_USER = &H400Public Const WM_NOTIFYICON = WM_USER + &H100Public Const WM_COMMAND = &H111Public Const WM_DESTROY = &H2Public Const WM_DRA WITEM = &H2BPublic Const WM_INITDIALOG = &H110Public Const WM_PAINT = &HFPublic Const WM_MENUSELECT = &H11FPublic Const GWL_WNDPROC = (-4) '替换窗口处理函数Dim pmenu As LongDim submenu As LongGlobal lproc As LongFunction CMenu() As Boolean'这个函数获得Form1的子菜单Dim l As LongDim l1 As Longpmenu = GetMenu(Form1.hwnd)submenu = GetSubMenu(pmenu, 0)If submenu ThenCMenu = TrueElseCMenu = FalseEnd IfEnd FunctionFunction Icon_Del(ihwnd As Long) As LongDim ano As NOTIFYICONDATADim l As Longano.hwnd = ihwndano.uID = 0ano.cbSize = Len(ano)'删除图标Icon_Del = Shell_NotifyIcon(NIM_DELETE, ano)End Function'这个函数接收图标句柄和窗口句柄并且新建图标Function Icon_Add(ihwnd As Long, hicon As Long) As LongDim ano As NOTIFYICONDATADim astr As String'为图标添加提示行astr = LTrim$(InputBox$("Input the tips you wanted to add.")) ano.szTip = astr + Chr$(0)'设置消息接收窗口ano.hwnd = ihwndano.uID = 0'图标有提示并且可以发送消息ano.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGEano.hicon = hiconano.cbSize = Len(ano)'将图标的回调消息设置为WM_NOTIFYICON，当在图标区域有鼠标消息，系统就会向'消息接收窗口发送WM_NOTIFYICON消息。

vb实现托盘(含程序)

VB托盘我按照下面的方法建了一个VB程序，可是在我自己的电脑上可以托盘，但换了电脑在别人的电脑上运行就没有托盘了，怎么回事啊！1、新建立一个VB6工程，将Form1的ShowInTaskBar属性设置为False2、菜单：工程--添加模块按“打开”这样就添加了一个新模块，名为Module1,保存为Module1.bas3、在Module1中写下如下代码：Option ExplicitPublic Const MAX_TOOLTIP As Integer = 64Public Const NIF_ICON = &H2Public Const NIF_MESSAGE = &H1Public Const NIF_TIP = &H4Public Const NIM_ADD = &H0Public Const NIM_DELETE = &H2Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_LBUTTONDBLCLK = &H203Public Const WM_RBUTTONDOWN = &H204Public Const WM_RBUTTONUP = &H205Public Const WM_RBUTTONDBLCLK = &H206Public Const SW_RESTORE = 9Public Const SW_HIDE = 0Public nfIconData As NOTIFYICONDATAPublic Type NOTIFYICONDATAcbSize As LonghWnd As LonguID As LonguFlags As LonguCallbackMessage As LonghIcon As LongszTip As String * MAX_TOOLTIPEnd TypePublic Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As LongPublic Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long'4、在Form1的Load事件中写下如下代码：Private Sub Form_Load()'以下把程序放入System Tray====================================System Tray BeginWith nfIconData.hWnd = Me.hWnd.uID = Me.Icon.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP.uCallbackMessage = WM_MOUSEMOVE.hIcon = Me.Icon.Handle'定义鼠标移动到托盘上时显示的Tip.szTip = App.Title + "(版本" & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar.cbSize = Len(nfIconData)End WithCall Shell_NotifyIcon(NIM_ADD, nfIconData)'=============================================================System Tray EndMe.HideEnd Sub'5、在Form1的QueryUnload事件中写入如下代码：Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)Call Shell_NotifyIcon(NIM_DELETE, nfIconData)End Sub'6、在Form1的MouseMove事件中写下如下代码：Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim lMsg As SinglelMsg = X / Screen.TwipsPerPixelXSelect Case lMsgCase WM_LBUTTONUP'MsgBox "请用鼠标右键点击图标!", vbInformation, "实时播音专家"'单击左键，显示窗体ShowWindow Me.hWnd, SW_RESTORE'下面两句的目的是把窗口显示在窗口最顶层'Me.Show'Me.SetFocus'' Case WM_RBUTTONUP'' PopupMenu MenuTray '如果是在系统Tray图标上点右键，则弹出菜单MenuTray'' Case WM_MOUSEMOVE'' Case WM_LBUTTONDOWN'' Case WM_LBUTTONDBLCLK'' Case WM_RBUTTONDOWN'' Case WM_RBUTTONDBLCLK'' Case ElseEnd SelectEnd Sub7、现在将程序保存起来运行看看系统托盘处是否增加了一个本工程的图标。

VB.NET编写托盘程序

编写托盘程序
编写托盘程序
托盘程序作为一类特殊的窗体，其快捷图标显示在系统托盘中，窗体本身则隐藏不可见。

在.NET之前版本的VB中编写托盘程序是十分困难的，但是提供的新的NotifyIcon组件却使VB初学者也能轻松编写一个这样的程序：
新建“Windows应用程序”，设置主窗体Opacity属性为0，FormBorderStyle属性为None，ShowInTaskbar属性为False，这样窗体将在启动后隐藏。

在窗体上放置一个NotifyIcon组件NotifyIcon1，一个ContextMenu（弹出菜单）组件 ContextMenu1，并根据需要为ContextMenu1添加菜单项。

设置NotifyIcon1的ICON属性，这个图标就是应用程序出现在系统托盘中的快捷图标；设置NotifyIcon1的Text属性为“ 托盘程序”，这就是鼠标移动到托盘图标时弹出的文字说明；设置NotifyIcon1的ContextMenu属性为ContextMenu1，也就是右键单击快捷图标时的弹出菜单为 ContextMenu1。

OK，按F5运行！
几乎不用编写代码，一个托盘程序就这样轻松实现了。

VC中系统托盘图标的实现

VC中系统托盘图标的实现本文以实例代码的形式讲述了在VC中系统托盘图标的实现。

技术实现：在VC中实现系统托盘图标主要用到一个Shell_NotifyIcon系统API。

在本文中我们以对话框程序为例子实现系统托盘图标，步骤如下：1．在StdAfx.h中定义消息ID，如：#define MYWM_NOTIFYICON WM_USER+12．定义一个全局NOTIFYICONDATA变量，如：NOTIFYICONDATA g_nd;3．实现添加系统托盘图标函数，如：void CZTXClientDlg::AddSystrayIcon(){// 将图标放入系统托盘g_nd.cbSize = sizeof (NOTIFYICONDATA);g_nd.hWnd = m_hWnd;g_nd.uID = IDR_MAINFRAME;g_nd.uFlags = NIF_ICON|NIF_MESSAGE|NIF_TIP;g_nd.uCallbackMessage= MYWM_NOTIFYICON;g_nd.hIcon = m_hIcon;strcpy(g_nd.szTip, "知天下娱乐中心[V1.1]");Shell_NotifyIcon(NIM_ADD, &g_nd);}4．实现删除系统托盘图标函数，如：void CZTXClientDlg::DelSystrayIcon(){Shell_NotifyIcon(NIM_DELETE, &g_nd);5．重载WindowProc函数，如：LRESULT CZTXClientDlg::WindowProc(UINT message, WPARAM wParam, LPARAM lParam){// TODO: Add your specialized code here and/or call the base classswitch( message ){case MYWM_NOTIFYICON:if(lParam==WM_LBUTTONDBLCLK){AfxGetApp()->m_pMainWnd->ShowWindow(SW_SHOW);}else if(lParam==WM_RBUTTONDOWN){CMenu menu;//载入事先定义的选单menu.LoadMenu(IDR_TRADEMEMU);CMenu*pMenu=menu.GetSubMenu(0);CPoint pos;GetCursorPos(&pos);//加入SetForegroundWindow的目的为使用户点菜单之外时菜单可以消失::SetForegroundWindow(m_hWnd);pMenu->TrackPopupMenu(TPM_LEFTALIGN|TPM_RIGHTBU TTON,pos.x,pos.y,AfxGetMainWnd());}break;}return CDialog::WindowProc(message, wParam, lParam);6． OK，现在在我们的OnInitDialog函数中加入如下代码：AddSystrayIcon( );7．在窗口关闭函数中加入如下代码：DelSystrayIcon( );经测试可行!非常感谢!。

使用VB实现系统托盘图标操作及一个有日历记事功能的实例

使用VB实现系统托盘图标操作及一个有日历记事功能的实例张庆
【期刊名称】《电脑编程技巧与维护》
【年(卷),期】2003(000)006
【摘要】本文对如何使用VB6.O通过调用Windows AIP函数,实现应用程序图标加入到Windows系统托盘和利用图标控制程序做了较为详细的介绍,并给出了一个应用程序实例来体现其具体实现过程.同时还讲解了VB6.0利用Monthview控件及Data控件实现日历记事和事件提醒功能的方法.
【总页数】5页(P21-25)
【作者】张庆
【作者单位】无
【正文语种】中文
【中图分类】TP3
【相关文献】
1.利用VBA实现宏操作实例 [J], 王丽;张桂香;李君
2.使用VBA技术实现办公自动化实例一二 [J], 陈迪;裴朋
3.利用VBA扩展Microsoft Word功能的一个实例--Microsoft Word学科插件[J], 蒋长根;黄明和
4.利用日历记事软件实现药品效期自动化管理 [J], 刘岩
5.不只是日历--一个基于浏览器的多功能日历 [J],
因版权原因，仅展示原文概要，查看原文内容请购买。