Private Sub Form_Load()
Dim l
l = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
Me.Hide
App.TaskVisible = False
hProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf MyWndProc)
'sets cbSize to the Length of TrayIcon
TrayIcon.cbSize = Len(TrayIcon)
' Handle of the window used to handle messages - which is the this form
TrayIcon.hwnd = Me.hwnd
' ID code of the icon
TrayIcon.uId = vbNull
' Flags
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
' ID of the call back message
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
' The icon - sets the icon that should be used
TrayIcon.hIcon = imgCloseing.Picture
' The Tooltip for the icon - sets the Tooltip that will be displayed
TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
' Add icon to the tray by calling the Shell_NotifyIcon API
'NIM_ADD is a Constant - add icon to tray
Call Shell_NotifyIcon(NIM_ADD, TrayIcon) 'WriteProfileString "windows", "load", "光驱.exe" ',"c:\windows\win.ini"
'WriteProfileString "windows", "run", "c:\windows\win.ini" '"光驱.exe",
'WritePrivateProfileString "Windows", "run", "光驱.exe", "c:\windows\win.ini"
'WritePrivateProfileString "Windows", "load", "光驱.exe", "c:\windows\win.ini"
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Returnestring = ""
On Error Resume Next Static Message As Long
'x is the current mouse location along the x-axis
'不明白为什么要这样
Message = X / Screen.TwipsPerPixelX
If Y = 0 Then
Select Case Message
Case WM_LBUTTONDBLCLK
Me.Show
'Command1.Picture = "\close.bmp"
' If g_isOpen = False Then
' g_isOpen = True
' TrayIcon.hIcon = imgOpening.Picture
' TrayIcon.szTip = "To Close the CDAudio" & Chr$(0)
' Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
' Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
' ret = mciSendString("Set CDAudio door open", ReturnString, 127, 0)
' Else
' g_isOpen = False
' TrayIcon.hIcon = imgCloseing.Picture
' TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
' Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
' Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
' ret = mciSendString("Set CDAudio door closed", ReturnString, 127, 0)
' End If
' If ret <> 0 Then MsgBox "不能打开或关闭光驱!"
' Left double click (This should bring up a dialog box)
Case WM_RBUTTONUP
Case WM_RBUTTONDOWN
PopupMenu POP
' Right button up (This should bring up a menu)
' End
End Select
End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
' Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, hProc)
' TrayIcon.cbSize = Len(TrayIcon)
' TrayIcon.hwnd = Me.hwnd
' TrayIcon.uId = vbNull
'
' 'Remove icon for Tray
' Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
' Unload Me
' Me.Hide
' Exit Sub
End SubPrivate Sub Picture1_Click()
Me.Hide
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Hide
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Hide
End SubPrivate Sub 打开_Click()
g_isOpen = True
TrayIcon.hIcon = imgOpening.Picture
TrayIcon.szTip = "To Close the CDAudio" & Chr$(0)
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
ret = mciSendString("Set CDAudio door open", ReturnString, 127, 0)
End SubPrivate Sub 关闭_Click()
g_isOpen = False
TrayIcon.hIcon = imgCloseing.Picture
TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
ret = mciSendString("Set CDAudio door closed", ReturnString, 127, 0)
End SubPrivate Sub 退出_Click()
Unload Me
'End
End Sub
Dim l
l = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
Me.Hide
App.TaskVisible = False
hProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf MyWndProc)
'sets cbSize to the Length of TrayIcon
TrayIcon.cbSize = Len(TrayIcon)
' Handle of the window used to handle messages - which is the this form
TrayIcon.hwnd = Me.hwnd
' ID code of the icon
TrayIcon.uId = vbNull
' Flags
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
' ID of the call back message
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
' The icon - sets the icon that should be used
TrayIcon.hIcon = imgCloseing.Picture
' The Tooltip for the icon - sets the Tooltip that will be displayed
TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
' Add icon to the tray by calling the Shell_NotifyIcon API
'NIM_ADD is a Constant - add icon to tray
Call Shell_NotifyIcon(NIM_ADD, TrayIcon) 'WriteProfileString "windows", "load", "光驱.exe" ',"c:\windows\win.ini"
'WriteProfileString "windows", "run", "c:\windows\win.ini" '"光驱.exe",
'WritePrivateProfileString "Windows", "run", "光驱.exe", "c:\windows\win.ini"
'WritePrivateProfileString "Windows", "load", "光驱.exe", "c:\windows\win.ini"
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Returnestring = ""
On Error Resume Next Static Message As Long
'x is the current mouse location along the x-axis
'不明白为什么要这样
Message = X / Screen.TwipsPerPixelX
If Y = 0 Then
Select Case Message
Case WM_LBUTTONDBLCLK
Me.Show
'Command1.Picture = "\close.bmp"
' If g_isOpen = False Then
' g_isOpen = True
' TrayIcon.hIcon = imgOpening.Picture
' TrayIcon.szTip = "To Close the CDAudio" & Chr$(0)
' Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
' Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
' ret = mciSendString("Set CDAudio door open", ReturnString, 127, 0)
' Else
' g_isOpen = False
' TrayIcon.hIcon = imgCloseing.Picture
' TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
' Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
' Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
' ret = mciSendString("Set CDAudio door closed", ReturnString, 127, 0)
' End If
' If ret <> 0 Then MsgBox "不能打开或关闭光驱!"
' Left double click (This should bring up a dialog box)
Case WM_RBUTTONUP
Case WM_RBUTTONDOWN
PopupMenu POP
' Right button up (This should bring up a menu)
' End
End Select
End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
' Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, hProc)
' TrayIcon.cbSize = Len(TrayIcon)
' TrayIcon.hwnd = Me.hwnd
' TrayIcon.uId = vbNull
'
' 'Remove icon for Tray
' Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
' Unload Me
' Me.Hide
' Exit Sub
End SubPrivate Sub Picture1_Click()
Me.Hide
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Hide
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Hide
End SubPrivate Sub 打开_Click()
g_isOpen = True
TrayIcon.hIcon = imgOpening.Picture
TrayIcon.szTip = "To Close the CDAudio" & Chr$(0)
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
ret = mciSendString("Set CDAudio door open", ReturnString, 127, 0)
End SubPrivate Sub 关闭_Click()
g_isOpen = False
TrayIcon.hIcon = imgCloseing.Picture
TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
ret = mciSendString("Set CDAudio door closed", ReturnString, 127, 0)
End SubPrivate Sub 退出_Click()
Unload Me
'End
End Sub
Option Explicit'**Originally published by Ryan Heldt ([email protected])
'**Modified by Donovan Parks ([email protected])'Win32 API declaration
Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
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 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 LongPublic Const WM_DEVICECHANGE& = 537&
Public Const DBT_DEVICEREMOVECOMPLETE& = 32772
Public Const DBT_DEVICEARRIVAL& = 32768
Public Const GWL_WNDPROC = (-4)' Constants used to detect clicking on the icon
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDBLCLK = &H206Public Const WM_RBUTTONUP = &H205
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDOWN = &H204
' Constants used to control the icon
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIF_MESSAGE = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4' Used as the ID of the call back message
Public Const WM_MOUSEMOVE = &H200' Used by Shell_NotifyIcon
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'create variable of type NOTIFYICONDATA
Public TrayIcon As NOTIFYICONDATA
Public hProc As Long
Public ReturnString As String
Public ret
Public g_isOpen As BooleanPublic Declare Function WriteProfileSection Lib "kernel32" Alias "WriteProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String) As Long
Public Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As LongPublic Function MyWndProc(ByVal ihWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = &H219 Then
If wParam = 32772 Then
g_isOpen = True
TrayIcon.hIcon = Form1.imgOpening.Picture
TrayIcon.szTip = "To Close the CDAudio" & Chr$(0)
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
End If
If wParam = 32768 Then
g_isOpen = False
TrayIcon.hIcon = Form1.imgCloseing.Picture
TrayIcon.szTip = "To Open the CDAudio" & Chr$(0)
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
End If
End If
MyWndProc = CallWindowProc(ByVal hProc, ByVal ihWnd, ByVal uMsg, ByVal wParam, ByVal lParam)
End Function