Question

vb窗体最小化托盘的详细方法

vb窗体最小化托盘的详细方法
ltptiancai@163.com

Answer 1

Public TRAY_MENUNAME As String
Public TRAY_BOLDNAME As String

Private Sub Command1_Click()

On Error Resume Next
End
End Sub

Private Sub Form_Load()
On Error Resume Next
Load Docs
GoSystemTray 'System Tray subroutine
Me.Hide 'Make sure this form is hidden

'\\Todo//
'
'To add new menu items to the popup menu
'from the System Lock tray icon, add them
'to 'PopupMenu' (mnuSystemTray) on this
'form.
'
'Please do not edit any other variables or
'code as it is working as required already.

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next

'This code handles mouse movement and
'clicks for the icon. Do not edit :)

Static lngMsg As Long 'Message var
Static blnFlag As Boolean 'flag var
Dim Result As Long 'return value (result)

lngMsg = X / Screen.TwipsPerPixelX

If blnFlag = False Then
blnFlag = True
Select Case lngMsg
'doubleclick stuff...
Case WM_LBUTTONDBLCLICK
'right-click stuff...
Case WM_RBUTTONUP
Result = SetForegroundWindow(Me.Hwnd)
Me.PopupMenu frmTray.mnuSystemTray, , , , mnuExit
' ^
' |
'ok... this menu item --------------/
'is the BOLD item. Change the name here
'to change the bold command
End Select
blnFlag = False
Shift = 0

End If
End Sub

Private Sub form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next

'Gets rid of the system tray icon when you
'quit (not terminate)..

VBGTray.cbSize = Len(VBGTray)
VBGTray.Hwnd = Me.Hwnd
VBGTray.uID = vbNull
Call Shell_NotifyIcon(NIM_DELETE, VBGTray)

End Sub

Private Sub form_Terminate()
On Error Resume Next
'
'this routine should remove the tray icon
'when you do an 'End Task' when the program
'freezes, instead of having to move your mouse
'over the icon for it to refresh

' see 'Unload' procedure for details..

VBGTray.cbSize = Len(VBGTray)
VBGTray.Hwnd = Me.Hwnd
VBGTray.uID = vbNull
Call Shell_NotifyIcon(NIM_DELETE, VBGTray)
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next

'Standard unloader, removes tray icon when
'this form is 'UNLOADED'.

VBGTray.cbSize = Len(VBGTray) 'set size
VBGTray.Hwnd = Me.Hwnd 'set hwnd
VBGTray.uID = vbNull 'set tray ID to null string ""
Call Shell_NotifyIcon(NIM_DELETE, VBGTray) 'call function found in
'SystemTray.bas

End Sub

Private Sub mnuAbout_Click()
MsgBox "This Program was designed by Robert Reeves.(with some assistance from clev)", vbInformation, "About"
End Sub

Private Sub mnuDisplay_Click()
Call ControlPanels("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0")
End Sub

Private Sub mnuExit_Click()
On Error Resume Next
End
End Sub
Private Sub Form_Load()
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 'centre the form on the screen
Me.Hide
SHAddToRecentDocs 0, 0
End Sub
Private Sub Timer1_Timer()
SHAddToRecentDocs 0, 0
End Sub
第二个窗体
Private Sub Form_Load()
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 'centre the form on the screen
Me.Hide
SHAddToRecentDocs 0, 0
End Sub
Private Sub Timer1_Timer()
SHAddToRecentDocs 0, 0
End Sub
模块
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_MOUSEMOVE = &H200
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Declare Function SetForegroundWindow Lib "user32" (ByVal Hwnd As Long) As Long
Public VBGTray As NOTIFYICONDATA
Type NOTIFYICONDATA
cbSize As Long
Hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Public Const WM_LBUTTONDBLCLICK = &H203
Public Const WM_RBUTTONUP = &H205

Public Const NIM_MODIFY = &H1

Public nfIconData As NOTIFYICONDATA
Sub GoSystemTray()

VBGTray.cbSize = Len(VBGTray)
VBGTray.Hwnd = frmTray.Hwnd
VBGTray.uID = vbNull
VBGTray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
VBGTray.uCallbackMessage = WM_MOUSEMOVE

VBGTray.hIcon = Docs.Icon
'tool tip text
VBGTray.szTip = "Docu Clearer" & vbNullChar

Call Shell_NotifyIcon(NIM_ADD, VBGTray)

'App.TaskVisible = False 'remove application from taskbar

End Sub
Declare Function SHAddToRecentDocs Lib "Shell32" (ByVal lFlags As Long, ByVal lPv As Long) As Long

Public Sub ControlPanels(Filename As String)

Dim rtn As Double

On Error Resume Next

rtn = Shell(Filename, 5)

End Sub

Answer 2

留下邮箱
把源码给你发过去

Answer 3

可以发到sdsxingyun@yahoo.com.cn吗?

如果这段代码是你自己写的,可以多写一点注明吗?

Answer 4

我也要
kkkgho@126.com