俩问题

[踏平扶桑]

1。如何把程序压入系统托盘后响应鼠标双击（也就是只有双击才执行比如form.show）
2。如何让程序在2000/xp中的任务管理器里的应用程序中消失，象flashget一样，当显示主界面的时候在任务管理器里的应用程序中可以看到，当最小化后任务管理器里的应用程序中消失

谢谢

[踏平扶桑]

up

[SoHo_Andy]

问题1：
托盘的模块代码
Option Explicit
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 a As Long
'以下为 Shell_NotifyIcon将用到的常量
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 NIM_MODIFY = &H1
'Shell_NotifyIcon的函数声明
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'处理消息将用到的结构、常量、API声明
Type POINTAPI
x As Long
y As Long
End Type
Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Const WM_USER = &H400
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_LBUTTONDOWN = &H201
Public Const GWL_WNDPROC = -4
Public trayflag As Boolean
Global lpPrevWndProc As Long
Global gHW As Long
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 Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'以下过程为消息循环处理

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If hw = Form1.hwnd And uMsg = WM_USER + 100 Then '检测到鼠标点动托盘图标
Select Case lParam
Case WM_RBUTTONDOWN '鼠标右键按下
Form1.PopupMenu Form1.traymnu '弹出菜单
Case WM_LBUTTONDOWN '鼠标左键按下
Form1.PopupMenu Form1.mnutray2 '弹出菜单
Case Else
End Select
Else '调用缺省窗口指针
' WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

调用方法的简单演示
Private Sub Command5_Click()
On Error GoTo err
gHW = Me.hwnd '取得本窗体指针
'下一句调用钩子函数，将自制消息处理函数钩入Windows的消息循环
hook
Exit Sub
err:
MsgBox err.Description, vbOKOnly, App.Title
End Sub

Public Sub hook()
'利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong
'lpPrevWndProc用来存储原窗口的指针
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub Unhook()
'本子程序用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

问题2：
隐藏进程代码
Private Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal _
dwProcessId As Long, ByVal dwType As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Sub ShowInTaskList(ByVal bShowInTaskList As Boolean)
RegisterServiceProcess GetCurrentProcessId, IIf(bShowInTaskList, 0, 1))
End Sub

当单击窗体最小化时执行
Private Sub Form_Resize()
Me.WindowState = 1
call ShowInTaskList(Flase)
End Sub

[frankkon]

关注

[踏平扶桑]

SoHo_Andy(冰)

首先谢谢你的回复

但是两个都不能用，第一个执行压入托盘的代码就全部结束任务（包括vb）

第二个没有那个api函数RegisterServiceProcess
我的系统是2000server

[bbgbianbaogui]

up

[踏平扶桑]

谢谢各位回复
3661512(菜鸟一只) 我就是按那个做的，我是要实现只有双击任务栏图标时才执行代码

xayzmb(行者)
3661512(菜鸟一只)
wanderstar(☆★流浪星★☆)
第二个问题解决了，谢谢
等我解决第一个问题后马上结贴：）

[踏平扶桑]

up

[xayzmb]

第一个问题代码有很多
没记住
^_^

第二个问题试试下面这个,看看行不?

'当按下 ctrl + alt + del 键时
'在任务管理器里看不到正在运行的程序
'加入下列代码

App.TaskVisible = False

[3661512]

1.参考这张贴
http://www.yesky.com/SoftChannel/72342371928637440/20030306/1655428.shtml
2.App.TaskVisible = False

[wanderstar]

第一个问题

声明
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIM_ADD = &H0 '添加图标
Public Const NIM_DELETE = &H2 '删除图标
Public Const NIM_MODIFY = &H1 '图标属性已经改变的消息
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
'鼠标消息
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEMOVE = &H200

'图标特性
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


用法
Dim zmIcon As NOTIFYICONDATA

Private Sub addIcon()
Dim tmp As Long
zmIcon.cbSize = Len(zmIcon)
zmIcon.hwnd = Ficon.hwnd
zmIcon.uCallbackMessage = WM_MOUSEMOVE '定义回调事件为MouseMove
zmIcon.uID = 0 '定义图标号
zmIcon.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
zmIcon.hIcon = Ficon.Icon
zmIcon.szTip = "提示" + Chr$(0)
tmp = Shell_NotifyIcon(NIM_ADD, zmIcon)
End Sub

Private Sub delIcon()
Dim tmp As Long
tmp = Shell_NotifyIcon(NIM_DELETE, zmIcon)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case CLng(X)
Case WM_LBUTTONDBLCLK
'双击事件
Case WM_LBUTTONDBLCLK
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Case WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
delIcon
End
End Sub

Private Sub Wnl_Click()
Fcalendar.Visible = True
End Sub

第二个问题
RegisterServiceProcess 好像是WIN95才有的API啊！
App.TaskVisible = False
只适合WIN98 在WIN2K里面并不适用！

[踏平扶桑]

是啊
我用断点调试，不执行那段代码
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case CLng(X)
Case WM_LBUTTONDBLCLK
'双击事件
Case WM_LBUTTONDBLCLK
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Case WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
End Select
End Sub

那个clng（x）和select case的任何条件都不匹配，我用debug.print输出值看到的也不一样

请把你的代码发给我好吗[e-mail]

[踏平扶桑]

up

[wanderstar]

第二个问题是怎么解决的？我也想知道一下哦！！
第一个问题用我的方法不能解决吗？我一直都是这样用的啊！

[踏平扶桑]

up

[踏平扶桑]

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case CLng(X)
Case WM_LBUTTONDBLCLK
msgbox "a"
'双击事件
Case WM_LBUTTONDBLCLK
msgbox "b"
Case WM_LBUTTONDOWN
msgbox "c"
Case WM_LBUTTONUP
msgbox "d"
Case WM_RBUTTONDBLCLK
msgbox "e"
Case WM_RBUTTONDOWN
msgbox "f"
Case WM_RBUTTONUP
msgbox "g"
End Select
End Sub
你可以试一下，结果是都不执行

[wanderstar]

晕！！漏了一句！！
在FORM_LOAD事件里面加一句

addIcon

[123yy321]

5653325(等待开刃的刀):Good!

[踏平扶桑]

up

[踏平扶桑]

搞定
谢谢各位：）