📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "CD 开关"
ClientHeight = 3195
ClientLeft = 165
ClientTop = 450
ClientWidth = 4680
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.PictureBox Picture1
Height = 1095
Left = 1680
MouseIcon = "Form1.frx":030A
Picture = "Form1.frx":0614
ScaleHeight = 1035
ScaleWidth = 1035
TabIndex = 0
Top = 1440
Width = 1095
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
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 Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim t As NOTIFYICONDATA
Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_RBUTTONDOWN As Long = &H204
'Dim returnstring As String
'Dim retvalue As Long
Private Sub Form_Load()
t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&
t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.ucallbackMessage = WM_MOUSEMOVE
t.hIcon = Picture1.Picture
t.szTip = "CD 开关" & Chr$(0)
Shell_NotifyIcon NIM_ADD, t
Me.Hide
App.TaskVisible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&
Shell_NotifyIcon NIM_DELETE, t
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Hex(X) = "1E3C" Then
' Me.PopupMenu mnuFile
'End If
Dim lMsg As Long
Static bInHere As Boolean
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
' Case WM_LBUTTONDBLCLK:
'
' On Mouse DoubleClick - Restore the window
'On Error Resume Next
'Me.Show
' retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)
'If Me.WindowState = vbMinimized Then
' Me.WindowState = vbDefault
'End If
'Me.ZOrder
Case WM_LBUTTONDOWN:
retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)
Case WM_RBUTTONDOWN:
retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -