下面的vb代码怎么才能最小化到托盘?并且可以还原? 50
Private Sub Form_Load()
WebBrowser1.Navigate "1293.qcqc.net/login.asp"
End Sub
Private Sub Timer1_Timer()
Me.Caption = WebBrowser1.LocationName
If InStr(Me.Caption, "管理端") > 0 Then
Form1.Width = 13590
Form1.Height = 8400
Dim oldwidth, oldheight
WebBrowser1.Width = 13590
WebBrowser1.Height = 8400
WebBrowser1.ToolBar = 0
Form1.Left = (Screen.Width - Form1.Width) / 2
Form1.Top = (Screen.Height - Form1.Height) / 2
Timer1.Enabled = False
End If
End Sub 展开
放到 Module1.bas中
Option Explicit
'托盘图标
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 Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const LB_SETHORIZONTALEXTENT = &H194
Public Const LB_ITEMFROMPOINT = &H1A9
'重建窗口
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) 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 Long '//////////处理消息
'Public Function wndproc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4) '//////////获取该窗口的窗口函数的地址
Public lngProOld As Long
Public lngMsgBarRester As Long
Public WM_TASKBARCREATED As Long
Public t As NOTIFYICONDATA
Public Function wndproc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If msg = lngMsgBarRester Then '如果是任务栏重建了
Call Shell_NotifyIcon(NIM_ADD, t) '//////////新建托盘图标
End If
wndproc = CallWindowProc(lngProOld, hwnd, msg, wParam, lParam) '//////////如果不是让窗体处理其他消息
End Function
放置到 Form1的Private Sub Form_Load()中
'设置托盘图标属性
With t
.cbSize = Len(t)
.hwnd = pic.hwnd
.uId = 1&
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.ucallbackMessage = WM_MOUSEMOVE
.hIcon = pic.Picture
.szTip = "----O(∩_∩)O快速打开文件夹O(∩_∩)O----" & Chr$(0)
End With
Shell_NotifyIcon NIM_ADD, t
lngProOld = GetWindowLong(Me.hwnd, GWL_WNDPROC) '//////////获取窗体函数地址,将其保存
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc) '//////////将消息定位到wndproc函数(过程)中
lngMsgBarRester = RegisterWindowMessage("TaskBarCreated") '//////////注册任务栏恢复消息。
在Form中的Private Sub Form_Unload(Cancel As Integer)放置以下代码
With t
.cbSize = Len(t)
.hwnd = pic.hwnd
.uId = 1&
End With
Shell_NotifyIcon NIM_DELETE, t
Unload Me
需要示例文件,LZ可以留下邮箱,我发给你 。
代码显的比较多,在代码中加入了 重建图标的代码。作用:当结束进程explorer.exe时,任务栏的图标就不会显示,但程序还在运行,不少程序都有这个问题。所以在代码中加入了重建图标代码,当结束explorer.exe,然后新建的时候,任务栏的图标也会重建,仍然显示。 截图
2024-09-19 广告
我们在窗口拥抱,人们从街上张望:
漫不经心地依了某个深邃的用意,
试探吧,我被逼近我全部的思想。
从前的生活
你就是非的离开哈哈
'=============================================================================
'//注意:使用或者转载本程序请著名作者信息
'//作者:countrygril@qq.com 村姑
'//QQ:1287349083
'//声明:本产品并未开发完,想继续开发的自己研究下去吧!本人是研究郁闷了~
'=============================================================================
Option Explicit
Public Type NOTIFYICONDATA
cbSize As Long ' 结构大小(字节)
hwnd As Long ' 处理消息的窗口的句柄
uid As Long ' 唯一的标识符
uFlags As Long ' Flags
uCallBackMessage As Long ' 处理消息的窗口接收的消息
hIcon As Long ' 托盘图标句柄
szTip As String * 128 ' Tooltip 提示文本
dwState As Long ' 托盘图标状态
dwStateMask As Long ' 状态掩码
szInfo As String * 256 ' 气球提示文本
uTimeoutOrVersion As Long ' 气球提示消失时间或版本
' uTimeout - 气球提示消失时间(单位:ms, 10000 -- 30000)
' uVersion - 版本(0 for V4, 3 for V5)
szInfoTitle As String * 64 ' 气球提示标题
dwInfoFlags As Long ' 气球提示图标
End Type
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Const NIS_HIDDEN = &H1 ' 隐藏图标
Private Const NIS_SHAREDICON = &H2 ' 共享图标
' dwInfoFlags to NOTIFIICONDATA structure
Private Const NIIF_NONE = &H0 ' 无图标
Private Const NIIF_INFO = &H1 ' "消息"图标
Private Const NIIF_WARNING = &H2 ' "警告"图标
Private Const NIIF_ERROR = &H3 ' "错误"图标
' uFlags to NOTIFYICONDATA structure
Private Const NIF_ICON As Long = &H2
Private Const NIF_INFO As Long = &H10
Private Const NIF_MESSAGE As Long = &H1
Private Const NIF_STATE As Long = &H8
Private Const NIF_TIP As Long = &H4
' dwMessage to Shell_NotifyIcon
Private Const NIM_ADD As Long = &H0
Private Const NIM_DELETE As Long = &H2
Private Const NIM_MODIFY As Long = &H1
Private Const NIM_SETFOCUS As Long = &H3
Private Const lngNIM_SETVERSION As Long = &H4
Private Const WM_MOUSEMOVE = &H200
Public Sub SetTrayIcon(ByRef IconData As NOTIFYICONDATA, ReceiveWindow As Long, szTip As String, hIcon As Long, szInfo As String, szInfoTitle As String)
With IconData
.cbSize = Len(IconData)
.hwnd = ReceiveWindow
.uid = 0
.uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE
.szTip = szTip & vbNullChar
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = hIcon
.dwState = 0
.dwStateMask = 0
.szInfo = szInfo & vbNullChar
.szInfoTitle = szInfoTitle & vbNullChar
.dwInfoFlags = 1
.uTimeoutOrVersion = 1000
End With
Shell_NotifyIcon NIM_ADD, IconData
End Sub
Public Sub RemoveTrayIcon(IconData As NOTIFYICONDATA)
Shell_NotifyIcon 2, IconData
End Sub
'***************************************************
' Example
'***************************************************
'Dim icondata1 As NOTIFYICONDATA
'Dim IconShowing As Boolean
'Private Sub Form_Load()
' IconShowing = false
' ' ...
'End Sub
'Private Sub Form_Resize()
' If Me.WindowState = 1 And Not IconShowing Then
' SetTrayIcon icondata1, Picture1.hwnd, "单击恢复窗口", Me.Icon.Handle, "在这里!在这里!在这里!", "已最小化"
' Me.Visible = False
' IconShowing = True
' End If
' ' ...
'End Sub
'Private Sub Form_Unload(Cancel As Integer)
' If IconShowing Then
' RemoveTrayIcon icondata1
' IconShowing = False
' End If
' ' ...
'End Sub
'Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If Button = 1 Then
' RemoveTrayIcon icondata1
' Me.WindowState = 0
' Me.Show
' IconShowing = False
' End If
'End Sub