查看: 575  |  回复: 0
  VB6 利用API创建你的系统拖盘
楼主
发表于 2023年5月7日 11:50

新建From1(窗体),新建Command1(按钮CommandButton),代码:

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_LWIN = &H5B
'Declare a user-defined variable to pass to the Shell_NotifyIcon
'function.
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
'Declare the constants for the API function. These constants can be
'found in the header file Shellapi.h.
'The following constants are the messages sent to the
'Shell_NotifyIcon function to add, modify, or delete an icon from the System Tray
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
'The following constant is the message sent when a mouse event occurs
'within the rectangular boundaries of the icon in the System Tray
'area.
Private Const WM_MOUSEMOVE = &H200
'The following constants are the flags that indicate the valid
'members of the NOTIFYICONDATA data type.
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
'The following constants are used to determine the mouse input on the
'the icon in the taskbar status area.
'Left-click constants.
Private Const WM_LBUTTONDBLCLK = &H203   'Double-click
Private Const WM_LBUTTONDOWN = &H201     'Button down
Private Const WM_LBUTTONUP = &H202       'Button up
'Right-click constants.
Private Const WM_RBUTTONDBLCLK = &H206   'Double-click
Private Const WM_RBUTTONDOWN = &H204     'Button down
Private Const WM_RBUTTONUP = &H205       'Button up
'Declare the API function call.
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
'Dimension a variable as the user-defined data type.
Dim nid As NOTIFYICONDATA

Private Sub Form_Terminate()
    'Delete the added icon from the System Tray when the
    'program ends.
    Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Event occurs when the mouse pointer is within the rectangular
    'boundaries of the icon in the system tray
    Dim msg As Long
    Dim sFilter As String
    msg = X / Screen.TwipsPerPixelX
    Select Case msg
        Case WM_LBUTTONDOWN
        Case WM_LBUTTONUP
        Case WM_LBUTTONDBLCLK
            ' 77 is the character code for the letter 'M'
            Call keybd_event(VK_LWIN, 0, 0, 0)
            Call keybd_event(77, 0, 0, 0)
            Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
        Case WM_RBUTTONDOWN
            Dim ToolTipString As String
            ToolTipString = InputBox("Enter the new ToolTip:", "Change ToolTip")
            If ToolTipString <> "" Then
                nid.szTip = ToolTipString & vbNullChar
                Shell_NotifyIcon NIM_MODIFY, nid
            End If
        Case WM_RBUTTONUP
        Case WM_RBUTTONDBLCLK
    End Select
End Sub

Private Sub Command1_Click()
    'Add an icon to the System Tray.
    'Set the individual values of the NOTIFYICONDATA data type.
    nid.cbSize = Len(nid)
    nid.hWnd = Form1.hWnd
    nid.uId = vbNull
    nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    nid.uCallBackMessage = WM_MOUSEMOVE
    nid.hIcon = Form1.Icon
    nid.szTip = "Show Desktop" & vbNullChar
    'Call the Shell_NotifyIcon function to add the icon to the System Tray
    Shell_NotifyIcon NIM_ADD, nid
End Sub


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com