你的位置: Kiyo'Space首页 编程 阅读文章 欢迎留下您的足迹

点最小化按钮把窗口放到托盘中

[ 编程 ] 分享
以下是代码片段:

 

‘模块内容
Option Explicit

Public OldWindowProc As Long       ‘旧的窗口进程号
Public TheForm As Form             ‘保存的窗体信息
Public TheMenu As Menu             ‘保存菜单信息

‘将消息传答窗口函数
Public 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
‘设置窗口附加内存长型数值
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
‘发送修改任务栏图标
Public 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      ‘ICON图标数据信息
  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

Public 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 Long

Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
‘—–

‘*************************************************************************
‘**函 数 名:KeepOnTop
‘**输    入:F(Form) -
‘**输    出:无
‘**功能描述:窗体放在最前
‘**全局变量:
‘**调用模块:
‘**作    者:叶帆
‘**日    期:2003年04月17日
‘**修 改 人:
‘**日    期:
‘**版    本:V1.0
‘*************************************************************************
Sub KeepOnTop(F As Form)
  Const SWP_NOMOVE = 2
  Const SWP_NOSIZE = 1

  Const HWND_TOPMOST = -1
  Const HWND_NOTOPMOST = -2

  SetWindowPos F.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE
End Sub

‘*************************************************************************
‘**函 数 名:NewWindowProc
‘**输    入:ByVal hwnd(Long)   -
‘**        :ByVal Msg(Long)    -
‘**        :ByVal wParam(Long) -
‘**        :ByVal lParam(Long) -
‘**输    出:(Long) -
‘**功能描述:新的窗口进程
‘**全局变量:
‘**调用模块:
‘**作    者:叶帆
‘**日    期:2003年04月17日
‘**修 改 人:
‘**日    期:
‘**版    本:V1.0
‘*************************************************************************
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

    ‘ 用户单击托盘中的图标
    If lParam = WM_LBUTTONUP Then  ‘单击左键显示窗体
      ‘窗体状态为最小化
      If TheForm.WindowState = vbMinimized Then TheForm.WindowState = TheForm.LastState
      TheForm.Visible = True
      TheForm.SetFocus
      Exit Function
    End If

    If lParam = WM_RBUTTONUP Then  ‘单击右键键显示菜单
      TheForm.PopupMenu TheMenu
      Exit Function
    End If

  End If
  ‘发送其余的消息到原先的窗口信息处理进程
  NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function

‘*************************************************************************
‘**函 数 名:AddToTray
‘**输    入:frm(Form) -
‘**        :mnu(Menu) -
‘**输    出:无
‘**功能描述:在托盘中增加窗体的图标
‘**全局变量:
‘**调用模块:
‘**作    者:叶帆
‘**日    期:2003年04月17日
‘**修 改 人:
‘**日    期:
‘**版    本:V1.0
‘*************************************************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
  ‘必须在设计状态下设置ShowInTaskbar为false,因为在运行状态下该属性只读。

  ‘ 保存当前窗体和菜单信息
  Set TheForm = frm
  Set TheMenu = mnu

  ‘ 设置新的窗口信息处理进程             ‘窗口进程        ‘窗口进程地址
  OldWindowProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

  ‘ 设置窗体图标的信息
  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

‘*************************************************************************
‘**函 数 名:RemoveFromTray
‘**输    入:无
‘**输    出:无
‘**功能描述:删除托盘内的图标
‘**全局变量:
‘**调用模块:
‘**作    者:叶帆
‘**日    期:2003年04月17日
‘**修 改 人:
‘**日    期:
‘**版    本:V1.0
‘*************************************************************************
Public Sub RemoveFromTray()
  ‘删除托盘内的图标

  With TheData
    .uFlags = 0
  End With
  Shell_NotifyIcon NIM_Delete, TheData

  ‘ 恢复原来窗口信息处理进程.
  SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProc
End Sub

‘*************************************************************************
‘**函 数 名:SetTrayTip
‘**输    入:tip(String) -
‘**输    出:无
‘**功能描述:设置新的托盘图标提示
‘**全局变量:
‘**调用模块:
‘**作    者:叶帆
‘**日    期:2003年04月17日
‘**修 改 人:
‘**日    期:
‘**版    本:V1.0
‘*************************************************************************
Public Sub SetTrayTip(tip As String)
  With TheData
    .szTip = tip & vbNullChar
    .uFlags = NIF_TIP
  End With
  Shell_NotifyIcon NIM_MODIFY, TheData
End Sub

‘*************************************************************************
‘**函 数 名:SetTrayIcon
‘**输    入:pic(Picture) -
‘**输    出:无
‘**功能描述:设置新的托盘图标
‘**全局变量:
‘**调用模块:
‘**作    者:叶帆
‘**日    期:2003年04月17日
‘**修 改 人:
‘**日    期:
‘**版    本:V1.0
‘*************************************************************************
Public Sub SetTrayIcon(pic As Picture)
  ‘ 如果图片的格式不是ICON类型,则退出
  If pic.Type <> vbPicTypeIcon Then Exit Sub

  ‘更新托盘图标
  With TheData
    .hIcon = pic.Handle
    .uFlags = NIF_ICON
  End With
  Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
‘调用方法:
  AddToTray Me, 菜单名称     ‘增加图标到托盘
  RemoveFromTray                      ‘清除托盘内的图标

 

以下是代码片段:

窗体代码
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Dim MinFlag As Boolean

Private Sub Form_Load()
    MinFlag = False
   
End Sub

Private Sub Form_Resize()
    If IsIconic(Me.hwnd) <> 0 And MinFlag = False Then
        MinFlag = True
        Me.Visible = False ‘隐藏窗口
        ‘将窗口图标加入通知栏
        Call Icon_Add(Me.hwnd, Me.Caption, Me.Icon, 0)
    End If
End Sub

 

模块代码
Public Const DefaultIconIndex = 1 ‘图标缺省索引
Public Const WM_LBUTTONDOWN = &H201 ‘按鼠标左键
Public Const WM_RBUTTONDOWN = &H204 ‘按鼠标右键

Public Const NIM_ADD = 0 ‘添加图标
Public Const NIM_MODIFY = 1 ‘修改图标
Public Const NIM_Delete = 2 ‘删除图标

Public Const NIF_MESSAGE = 1 ‘message 有效
Public Const NIF_ICON = 2 ‘图标操作(添加、修改、删除)有效
Public Const NIF_TIP = 4 ‘ToolTip(提示)有效

‘API函数声明
‘图标操作
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
‘判断窗口是否最小化
Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long

‘设置窗口位置和状态(position)的功能
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 Long

‘定义类型
‘通知栏图标状态
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

‘函数定义
‘添加图标至通知栏
Public Function Icon_Add(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
  ‘参数说明:iHwnd:窗口句柄,sTips:当鼠标移到通知栏图标上时显示的提示内容
  ‘hIcon:图标句柄,IconID:图标Id号
  Dim IconVa As NOTIFYICONDATA
  With IconVa
    .hwnd = iHwnd
    .szTip = sTips + Chr$(0)
    .hIcon = hIcon
    .uID = IconID
    .uCallbackMessage = WM_LBUTTONDOWN
    .cbSize = Len(IconVa)
    .uFlags = NIF_MESSAGE or NIF_ICON or NIF_TIP
    Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)
  End With
End Function
‘删除通知栏图标(参数说明同Icon_Add)
Function Icon_Del(iHwnd As Long, lIndex As Long) As Long
  Dim IconVa As NOTIFYICONDATA
  Dim L As Long
  With IconVa
    .hwnd = iHwnd
    .uID = lIndex
    .cbSize = Len(IconVa)
  End With
  Icon_Del = Shell_NotifyIcon(NIM_Delete, IconVa)
End Function
‘修改通知栏图标(参数说明同Icon_Add)
Public Function Icon_Modify(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
  Dim IconVa As NOTIFYICONDATA
  With IconVa
    .hwnd = iHwnd
    .szTip = sTips + Chr$(0)
    .hIcon = hIcon
    .uID = IconID
    .uCallbackMessage = WM_LBUTTONDOWN
    .cbSize = Len(IconVa)
    .uFlags = NIF_MESSAGE or NIF_ICON or NIF_TIP
    Icon_Modify = Shell_NotifyIcon(NIM_MODIFY, IconVa)
  End With
End Function

没有评论

  • (Required)
  • (Required, will not be published)