开发工具:
文件大小: 44kb
下载次数: 0
上传时间: 2013-11-15
详细说明： Option Explicit Dim Resolution As String '延时 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '电脑音量 Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySet tingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long Private Const CCDEVICENAME As Long = 32 Private Const CCFORMNAME As Long = 32 Private Const DM_BITSPERPEL As Long = &H40000 Private Const DM_PELSWIDTH As Long = &H80000 Private Const DM_PELSHEIGHT As Long = &H100000 Private Const DM_DISPLAYFLAGS As Long = &H200000 Private Const DM_DISPLAYFREQUENCY = &H400000 Private Const CDS_FORCE As Long = &H80000000 Private Const BITSPIXEL As Long = 12 Private Const HORZRES As Long = 8 Private Const VERTRES As Long = 10 Private Const VREFRESH = 116 Private Type DEVMODE dmDeviceName As String * CCDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type '设置窗口顶置 Private 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 '最小化到托盘 Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Const NIM_ADD = &H0 Const NIM_DELETE = &H2 Const NIF_ICON = &H2 Const NIF_MESSAGE = &H1 Const NIF_TIP = &H4 Const WM_MOUSEMOVE = &H200 Const WM_LBUTTONDBLCLK = &H203 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 Dim tray As NOTIFYICONDATA Private Sub Form_DblClick() Unload Me End End Sub Private Sub Form_Load() '获取分辨率 Resolution = GetDeviceCaps(Me.hdc, HORZRES) & "*" & GetDeviceCaps(Me.hdc, VERTRES) 'Label11.Caption = Resolution If Resolution = "1366*768" Then Me.Left = 7500 If Resolution = "1024*768" Then Me.Left = 4900 If Resolution = "800*600" Then Me.Left = 3200 Me.Top = 1000 End If '设置为透明窗体 Me.BackColor = vbBlue Dim rtn As Long rtn = GetWindowLong(hWnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hWnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hWnd, vbBlue, 190, LWA_COLORKEY '总在最上 SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 2 Or 1 End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim msg As Long msg = X / 15 If msg = WM_LBUTTONDBLCLK Then Me.Show Shell_NotifyIcon NIM_DELETE, tray End If Shape1.BorderWidth = 2 Shape2.BorderWidth = 2 Shape3.BorderWidth = 2 Shape4.BorderWidth = 2 Shape5.BorderWidth = 2 Shape6.BorderWidth = 2 Shape7.BorderWidth = 2 Shape8.BorderWidth = 1 Shape9.BorderWidth = 1 End Sub Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape1.BackStyle = 0 End Sub Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape1.BackStyle = 1 End Sub Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape2.BackStyle = 0 End Sub Private Sub Label2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape2.BackStyle = 1 End Sub Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape3.BackStyle = 0 End Sub Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape3.BackStyle = 1 End Sub Private Sub Label4_Click() Shell "cmd.exe /c shutdown -r -t 0", vbHide End Sub Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape4.BackStyle = 0 End Sub Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape4.BackStyle = 1 End Sub Private Sub Label5_Click() '音量增大 SendMessage hWnd, 793, 197266, 655360 Sleep 5 SendMessage hWnd, 793, 197266, 655360 End Sub Private Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape5.BackStyle = 0 End Sub Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape5.BackStyle = 1 End Sub Private Sub Label6_Click() Shell "cmd.exe /c shutdown -s -t 0", vbHide End Sub Private Sub Label6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape6.BackStyle = 0 End Sub Private Sub Label6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape6.BackStyle = 1 End Sub Private Sub Label7_Click() '音量减小 SendMessage hWnd, 793, 197266, 589824 Sleep 5 SendMessage hWnd, 793, 197266, 589824 End Sub Private Sub Label7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape7.BackStyle = 0 End Sub Private Sub Label7_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape7.BackStyle = 1 End Sub Private Sub Label8_Click() Timer1.Enabled = False Me.WindowState = 1 End Sub Private Sub Label8_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape8.BackStyle = 0 End Sub Private Sub Label8_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape8.BackStyle = 1 End Sub Private Sub Label9_Click() tray.cbSize = Len(tray) tray.uId = vbNull tray.hWnd = Me.hWnd tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON tray.uCallBackMessage = WM_MOUSEMOVE tray.hIcon = Me.Icon tray.szTip = "多媒体中控台" & vbNullChar Shell_NotifyIcon NIM_ADD, tray Me.Hide End Sub Private Sub Label9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape9.BackStyle = 0 End Sub Private Sub Label9_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape9.BackStyle = 1 End Sub Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape1.BorderWidth = 5 End Sub Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape2.BorderWidth = 5 End Sub Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape3.BorderWidth = 5 End Sub Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape4.BorderWidth = 5 End Sub Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape5.BorderWidth = 5 End Sub Private Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape6.BorderWidth = 5 End Sub Private Sub Label7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape7.BorderWidth = 5 End Sub Private Sub Label8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape8.BorderWidth = 3 End Sub Private Sub Label9_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Shape9.BorderWidth = 3 End Sub Private Sub Timer1_Timer() '获取分辨率 Resolution = GetDeviceCaps(Me.hdc, HORZRES) & "*" & GetDeviceCaps(Me.hdc, VERTRES) 'Label11.Caption = Resolution If Resolution = "1366*768" Then Me.Left = 7500 If Resolution = "1024*768" Then Me.Left = 4900 If Resolution = "800*600" Then Me.Left = 3200 Me.Top = 1000 End If '总在最上 SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 2 Or 1 End Sub Private Sub Timer2_Timer() If Me.WindowState = 2 Then Timer1.Enabled = True End If End Sub ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
