你说的对,是系统托盘

lovever1999 2002-04-10 02:43:47
没错,你说的很对,是系统托盘
但是怎么使用,可不可和我说一说啊
...全文
32 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
ferrytang 2002-04-10
  • 打赏
  • 举报
回复
你搜索一下系统托盘的帖子,有很多呢!?
gump2000 2002-04-10
  • 打赏
  • 举报
回复
Form中这样使用

Dim WithEvents test As Class1

Private Sub Command2_Click()
Set test = New Class1

Set test.SourceWindow = Me
test.ChangeIcon ImageList1, 1
test.ToolTip = "测试"
End Sub

Private Sub Command3_Click()
test.MinToSysTray
End Sub

Private Sub test_LButtonDblClk()
test.RemoveFromSysTray
End Sub


gump2000 2002-04-10
  • 打赏
  • 举报
回复
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 Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private Const LR_LOADFROMFILE = &H10
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const IMAGE_ENHMETAFILE = 3
Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_DEFAULTSIZE = &H8
Private Const DI_NORMAL = DI_MASK Or DI_IMAGE Or DI_DEFAULTSIZE

Private IconData As NOTIFYICONDATA
Private WithEvents pbPictureHook As PictureBox
Private sToolTip As String

Public Event LButtonDblClk()
Public Event LButtonDown()
Public Event LButtonUp()
Public Event RButtonDblClk()
Public Event RButtonDown()
Public Event RButtonUp()

Private frmSourceWindow As Form
Private bDefaultDblClk As Boolean
Private iCurrentFrame As Integer
Public Property Let ToolTip(ByVal sData As String)

ChangeToolTip sData

End Property
Public Property Get ToolTip() As String

ToolTip = sToolTip

End Property

Public Property Let DefaultDblClk(ByVal bData As Boolean)

bDefaultDblClk = bData

End Property
Public Property Get DefaultDblClk() As Boolean

DefaultDblClk = bDefaultDblClk

End Property

Public Property Set SourceWindow(ByVal frmData As Form)

Set frmSourceWindow = frmData
SetPicHook

End Property
Public Property Get SourceWindow() As Form

Set SourceWindow = frmSourceWindow

End Property
Private Sub Class_Initialize()

bDefaultDblClk = True

IconData.cbSize = Len(IconData)
IconData.uId = 1&
IconData.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
IconData.ucallbackMessage = WM_MOUSEMOVE
IconData.hIcon = 0
IconData.szTip = Chr$(0)

End Sub
Private Sub pbPictureHook_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Static rec As Boolean
Dim msg As Long
Dim oldmsg As Long

oldmsg = msg
msg = x / Screen.TwipsPerPixelX

If rec = False Then
rec = True
Select Case msg
Case WM_LBUTTONDBLCLK:
LButtonDblClk
Case WM_LBUTTONDOWN:
RaiseEvent LButtonDown
Case WM_LBUTTONUP:
RaiseEvent LButtonUp
Case WM_RBUTTONDBLCLK:
RaiseEvent RButtonDblClk
Case WM_RBUTTONDOWN:
RaiseEvent RButtonDown
Case WM_RBUTTONUP:
RaiseEvent RButtonUp
End Select
rec = False
End If

End Sub
Private Sub LButtonDblClk()

If bDefaultDblClk Then
frmSourceWindow.WindowState = vbNormal
frmSourceWindow.Show
App.TaskVisible = True
RemoveFromSysTray
End If

RaiseEvent LButtonDblClk

End Sub
Public Sub RemoveFromSysTray()

IconData.cbSize = Len(IconData)
IconData.hwnd = pbPictureHook.hwnd
IconData.uId = 1&

Shell_NotifyIcon NIM_DELETE, IconData

End Sub
Public Sub IconInSysTray()

Shell_NotifyIcon NIM_ADD, IconData

End Sub
Public Sub MinToSysTray()

Me.IconInSysTray

frmSourceWindow.Hide
App.TaskVisible = False

End Sub
Private Sub SetPicHook()

On Error GoTo AlreadyAdded

Set pbPictureHook = frmSourceWindow.Controls.Add("VB.PictureBox", "pbPictureHook")

pbPictureHook.Visible = False
pbPictureHook.Picture = frmSourceWindow.Icon
pbPictureHook.AutoRedraw = True
pbPictureHook.AutoSize = True

IconData.hwnd = pbPictureHook.hwnd

Exit Sub

AlreadyAdded:
If Err.Number <> 727 Then
MsgBox "Run-time error '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Error"
Stop
Resume
End If

End Sub

Public Sub ChangeIcon(TrayIconList As ImageList, ImageIndex As Integer)

DestroyIcon (IconData.hIcon)

IconData.hIcon = TrayIconList.ListImages(ImageIndex).Picture

Shell_NotifyIcon NIM_MODIFY, IconData

End Sub

Public Sub ChangeToolTip(ByVal sNewTip As String)

sToolTip = sNewTip
IconData.szTip = sNewTip & Chr$(0)

Shell_NotifyIcon NIM_MODIFY, IconData

End Sub


以上是类模块
rivershan 2002-04-10
  • 打赏
  • 举报
回复
????

7,763

社区成员

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

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