急!!如何实现象MSN Messenger一样的功能!

Hahahahahaha 2002-03-04 08:33:21
如何用VB6实现象MSN Messenger或者NetAnts(网络蚂蚁)一样的功能,在输入法旁边藏一个小图标,好多软件都有这个功能。
提供思路的都给分,提供代码的另开贴给分。
...全文
47 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
Hahahahahaha 2002-03-04
  • 打赏
  • 举报
回复
多谢:jamex(亲亲吾爱) 、40Star(陪你去看--☆流星雨★)、ferrytang(ferry) ,请分别到以下贴领分,为防止斑竹删贴,请把回复再贴一遍。
http://www.csdn.net/expert/topic/553/553122.xml
http://www.csdn.net/expert/topic/553/553093.xml
http://www.csdn.net/expert/topic/553/553087.xml
jamex 2002-03-04
  • 打赏
  • 举报
回复
将以上代码贴到一个form里,试一下,我几天前就是这样做的
jamex 2002-03-04
  • 打赏
  • 举报
回复
Option Explicit

Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
Public LastState As Integer

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
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_USER = &H400
Public 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 GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public 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 TheData As NOTIFYICONDATA
' *********************************************
' The replacement window proc.
' *********************************************
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = TRAY_CALLBACK Then
' The user clicked on the tray icon.
' Look for click events.
If lParam = WM_LBUTTONUP Then
' On left click, show the form.
If TheForm.WindowState = vbMinimized Then _
TheForm.WindowState = TheForm.LastState
TheForm.Visible = True
TheForm.SetFocus
Exit Function
End If
If lParam = WM_RBUTTONUP Then
' On right click, show the menu.
TheForm.PopupMenu TheMenu
Exit Function
End If
End If

' Send other messages to the original
' window proc.
NewWindowProc = CallWindowProc( _
OldWindowProc, hwnd, Msg, _
wParam, lParam)
End Function
' *********************************************
' Add the form's icon to the tray.
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
' ShowInTaskbar must be set to False at
' design time because it is read-only at
' run time.

' Save the form and menu for later use.
Set TheForm = frm
Set TheMenu = mnu

' Install the new WindowProc.
OldWindowProc = SetWindowLong(frm.hwnd, _
GWL_WNDPROC, AddressOf NewWindowProc)

' Install the form's icon in the tray.
With TheData
.uID = 0
.hwnd = frm.hwnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON
.uCallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' Remove the icon from the system tray.
' *********************************************
Public Sub RemoveFromTray()
' Remove the icon from the tray.
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData

' Restore the original window proc.
SetWindowLong TheForm.hwnd, GWL_WNDPROC, _
OldWindowProc
End Sub
' *********************************************
' Set a new tray tip.
' *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
' *********************************************
' Set a new tray icon.
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
' Do nothing if the picture is not an icon.
If pic.Type <> vbPicTypeIcon Then Exit Sub

' Update the tray icon.
With TheData
.hIcon = pic.Handle
.uFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub


Private Sub Form_Load()
'tray init
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If

AddToTray Me, mnuTray
SetTrayTip "Chat Client"
End Sub

Private Sub Form_Resize()
Select Case WindowState
Case vbMinimized
Me.Visible = False
Case vbMaximized

Case vbNormal

End Select

If WindowState <> vbMinimized Then _
LastState = WindowState

End Sub

Private Sub Form_Unload(Cancel As Integer)
RemoveFromTray
End Sub
dbcontrols 2002-03-04
  • 打赏
  • 举报
回复
在这里搜索“托盘”
ferrytang 2002-03-04
  • 打赏
  • 举报
回复
也可搜索"系统托盘"相关帖子
ferrytang 2002-03-04
  • 打赏
  • 举报
回复
在WINDOWS98里,右下角有许多应用程序的图标。而程序本身的窗口是隐藏的,若你需要调用应用程序的窗口,则双击该图标即可。这种程序称为托盘程序。这是WINDOWS98操作系统的一大特色。使用户能够更加快捷的显示和隐藏应用程序,可以使任务栏不致于太乱。托盘程序在Visual Basic里是怎么实现的呢?
    编写托盘程序主要解决两个问题:(1)创建、修改、删除托盘;(2)如何对托盘接收到的消息进行处理。这就要用到几个Windows API函数。
    首先,Shell_NotifyIcon是用于托盘的Shell API。该API用到一个NOTIFYICONDATA结构.
  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
    其次,应该考虑怎样在VB中接收、处理托盘的消息(双击、单击、左键、右键)。C++、Delphi等语言对消息循环的处理较简单,但在VB中处理消息循环时必须应用Win32的SetWindowLong、CallWindowProc这两个API函数。SetWindowLong 函数利用GWL_WNDPROC 索引来创建窗口类的子类(窗口类是用来创建窗口的),它使用AddressOf关键字和回调函数(WindowProc)来截取消息并根据消息来执行相应的功能,如窗口的最大化、最小化、隐藏、退出等。CallWindowProc函数调用原窗口类缺省的指针,程序最后退出时可通过SetWindowLong来关闭子类,重新使原来的Windows过程成为回调函数。
    本程序项目包括一个模块和一个窗体
    1、模块源代码为:
   Option Explicit '强制定义每个使用的变量
    Type NOTIFYICONDATA '定义结构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
    '以下为 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_LBUTTONDBLCLK = &H203
    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.mainmenu '弹出菜单
    Case WM_LBUTTONDBLCLK '鼠标左键双击
   Form1.Show '显示窗口
    Case Else
    End Select
   Else '调用缺省窗口指针
     WindowProc = CallWindowProc(lpPrevWndProc, hw,uMsg, wParam, lParam)
   End If
  End Function
  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、在窗口form1加入一个主菜单mainmenu,设置为不可见。在加入一些子菜单如"显示窗口"(名称为:show),"隐藏窗口"(名称为:hide),'退出程序"(名称为:exit)。在加入四个按钮Command1,Command2,Command3,Command。caption属性分别为:“删除托盘图标",“创建托盘图标",“修改托盘图标",“退出程序".
   代码窗口的内容为:
   Dim MyNot As NOTIFYICONDATA '定义一个托盘结构
   Private Sub Command1_Click() '按下删除托盘图标按钮
   With MyNot
   .hIcon = Form1.Icon '托盘图标指针指向窗口的图标
   .hwnd = Form1.hwnd '窗体指针
   .szTip = "" '弹出提示字符串,删除时应为空
   .uCallbackMessage = WM_USER + 100 '对应程序定义的消息
   .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE '图标标志
   .uID = 1 '图标识别符
   .cbSize = Len(MyNot) '计算结构实例MyNot的长度
   End With
   hh = Shell_NotifyIcon(NIM_DELETE, MyNot) '删除该托盘图标
   trayflag = False '托盘图标删除后trayflag为假
   End Sub
   Private Sub Command2_Click() '按下创建托盘图标按钮
   Dim hh As Long
   With MyNot
   .hIcon = Form1.Icon
   .hwnd = Form1.hwnd
   .szTip = "托盘图标" & Chr(&H0)
   .uCallbackMessage = WM_USER + 100
   .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
   .uID = 1
   .cbSize = Len(MyNot)
   End With
   hh = Shell_NotifyIcon(NIM_ADD, MyNot) '添加一个托盘图标
   trayflag = True '托盘图标添加后trayflag为真
   End Sub
   Private Sub Command3_Click() '按下修改托盘图标按钮
   Dim hh As Long
   Set P = LoadPicture("cd.ico") '导入一个新图标
   With MyNot
   .hIcon = P '将托盘图标改为新图标
   .hwnd = Form1.hwnd
   .szTip = "光盘图标" & Chr(&H0) '更改提示信息
   .uCallbackMessage = WM_USER + 100
   .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
   .uID = 1
   .cbSize = Len(MyNot)
   End With
   hh = Shell_NotifyIcon(NIM_MODIFY, MyNot) '修改托盘图标的某些特征
   End Sub
   Private Sub Command4_Click() '退出窗口按钮被按下
   If trayflag = True Then Command1_Click '如果托盘图标仍在,模拟按下"删除托盘图标"按钮
   Unhook '退出消息循环
   Unload Me '卸载窗体
   End Sub
  Private Sub exit_Click()
   If trayflag = True Then Command1_Click '如果托盘图标仍在,模拟按下“删除托盘图标"按钮
   Unhook '退出消息循环
   Unload Me '卸载窗体
  End Sub
   Private Sub Form_Load()
   gHW = Me.hwnd '取得本窗体指针
   hook '调用钩子函数,将自制消息处理函数钩入Windows的消息循环
   End Sub
  Private Sub hide_Click()
  Form1.hide '隐藏窗口
  End Sub
  Private Sub show_Click()
  Form1.show 显示窗口
  End Sub
40Star 2002-03-04
  • 打赏
  • 举报
回复
'1.这里我们调用的API函数是:
'"Shell_NotifyIcon",在您的模块中添加如下的函
'数声明和常量声明:
'以下常量告诉系统在托盘中您的图标上发生了什么 操作
'常量声明
Public Const WM_MOUSEMOVE = &H200 '在图标上移动鼠标
Public Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
Public Const WM_LBUTTONUP = &H202 '鼠标左键释放
Public Const WM_LBUTTONDBLCLK = &H203 '双击鼠标左键
Public Const WM_RBUTTONDOWN = &H204 '鼠标右键按下
Public Const WM_RBUTTONUP = &H205 '鼠标右键释放
Public Const WM_RBUTTONDBLCLK = &H206 '双击鼠标右键
Public Const WM_SETHOTKEY = &H32 '响应您定义的热键
'API函数声明
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "" ()
Shell_NotifyIconA " (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long "
'自定义一个调用API Shell_NotifyIcon要用到的类 型"NOTIFYICONDATA"
Public Type NOTIFYICONDATA
cdSize As Long 'NOTIFYICONDATA类型的大小
hwnd As Long '你的应用程序窗体的名柄
uId As Long '应用程序图标资源的ID号
uFlags As Long '使那些参数有效它是以下枚举类型中的
'NIF_MESSAGE、NIF_ICON、NIF_TIP三组的组合
uCallbackMessage As Long '鼠标移动时把此消息发给该图标的窗体
hIcon As Long '图标名柄
szTip As String * 64 '当鼠标在图标上时显示的Tip文本
End Type

'这是一个枚举类型它告诉API Shell_NotifyIcon去做什么操作
Public Enum enm_NIM_Shell
NIM_ADD = &H40 '在“金碟”中加一图标
NIM_MODIFY = &H1 '修改“金碟”中的图标
NIM_DELETE = &H2 '删除“金碟”中的图标
NIF_MESSAGE = &H1 '使类型"NOTIFYICONDATA"中的uCallbackMessage有效
NIF_ICON = &H2 '使类型"NOTIFYICONDATA"中的hIcon有效
NIF_TIP = &H4 '使类型"NOTIFYICONDATA"中的szTip有效
WM_MOUSEMOVE = &H200 '使鼠标移动消息有效
End Enum
'定义一个"NOTIFYICONDATA"类型的变量
Public nidProgramData As NOTIFYICONDATA

'以上是函数及常量声明和自定义的一个类型变量,下面是此API函数的调用方法:
'2. 在窗体上用菜单编辑一个具有如下信息的菜单项:
'主菜单: 无标题、名称 (mainMenu)
'子菜单:标题(API编程)、名称(submnul);
'标题(退出)、名称(submnu2).
'这里只是举个例子,具体的功能你可以根据你的具体需要来编辑此菜单项
'3. 在窗体的Load事件中添加如下代码:
Private Sub Form_Load()
'隐藏窗体
With Me
.Top = -10000
.Left = -10000
.WindowState = vbMinimized
End With
'设置类型NOTIFYICONDATA所具有的特征
With nidProgramData
.cbSize = Len(nidProgramData)
.hwnd = Me.hwnd
.uld = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
'触发鼠标移动消息
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
'“托盘”中放入窗体图标,你可以把窗体的图标换成你所喜欢的图标
.szTip = "VB 的 Win32 API 编程" & vbNullChar
End With

'调用该函数
Shell_NotifyIcon NIM_ADD, nidProgramData
End Sub
'根据不同的鼠标消息做不同的操作
Private Sub Form_MouseMove(Button As Integer, Shift As lnteger, x As Single, Y As Single)
On Error GoTo Form_MouseMove_err:
Dim Result As Long
Dim msg As Long
'X的值依赖与显示模式的设置
If Me.ScaleMode = vbPixels Then
msg = x
Else
msg = x / Screen.TwipsPerPixe1X
End If
Select Case msg
Case WM_LBUTTONUP
'在这里加入鼠标左键释放时你想做的操作
Case WM_LBUTTONDBLCLK
'在这里加入双击鼠标左键时你想做的操作
Case WM_RBUTTONUP
'通常这里弹出你的功能菜单
PopupMenu mainMenu
Case WM_MOUSEISMOVING
'在这里加入鼠标正在移动时你想做的操作
End Select
Exit Sub

Form_MouseMove_err:
'在这里加入你的处理异常错误的代码
End Sub
40Star 2002-03-04
  • 打赏
  • 举报
回复
有很多这样的贴子,你搜一下!
Hahahahahaha 2002-03-04
  • 打赏
  • 举报
回复
就是实现在“最小化”时把图标藏在时间的旁边,双击时再显示。

我给分从不吝惜,请高手帮忙!!!
老熊宝宝 2002-03-04
  • 打赏
  • 举报
回复
我记我跟很多人说过,在VB里用字类化技术代价很高,要实现SysTray,
根本就不需要字类化,因为有现成的uCallBackMessage,如下:
With Tray
.cbSize = Len(Tray)
.hwnd = Me.hwnd
.hIcon = Inactive.Picture
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.szTip = "InterCommVB II DDE Server" & vbNullChar
.uCallBackMessage = WM_MOUSEMOVE
End With

然后就可以直接在Form里用:
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case X
Case WM_RBUTTONUP
Me.PopupMenu Me.TrayMenu
End Select
End Sub

这才是在VB里实现SysTray最经济的方法。
还有用子类化,VB光盘里有现成的SysTray的控件。

刚看过40Star的方法,和他的一样,也应该用这样的方法。
Hahahahahaha 2002-03-04
  • 打赏
  • 举报
回复
UP!

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧