如何让VB生成的工程最小化后在通知区域而任务栏不显示？

Posted 2023-05-02

其他问题：1、VB如何定义字符数组？2、如何自定义VB生成工程图标？

3个问题才给这么点分？呵呵……
1、VB如何定义字符数组——Dim S() As String
2、如何自定义VB生成工程图标——在启动的那个窗口设置属性ICON即可

如何让VB生成的工程最小化后在通知区域而任务栏不显示，要用到API函数。
在模块中写下面代码，然后调用这几个函数就可以了。
'系统托盘
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

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
Private TheData As NOTIFYICONDATA

'系统托盘处理过程
' 捕获托盘动作
Public Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = TRAY_CALLBACK Then
If lParam = WM_LBUTTONUP Then
If TheForm.WindowState = vbMinimized Then
TheForm.WindowState = vbNormal
End If
TheForm.Show
Exit Function
End If
If lParam = WM_RBUTTONUP Then
TheForm.PopupMenu TheForm.mnu_File
Exit Function
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam)
End Function

' 添加托盘图标
Public Sub AddToTray(frm As Form, Optional mnu As Menu)
Set TheForm = frm
Set TheMenu = mnu
OldWindowProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf NewWindowProc)
With TheData
.uID = 0
.hWnd = frm.hWnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON
.uCallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub

' 移除托盘图标
Public Sub RemoveFromTray()
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData
SetWindowLong TheForm.hWnd, GWL_WNDPROC, OldWindowProc
End Sub

' 设置托盘显示的文字
Public Sub SetTrayTip(tip As String)
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub 参考技术A -------------------------------------
1、VB如何定义字符数组？
dim X(标界) as [类型：integer / string…… ]
Public X(标界) as [类型:integer / string…… ]
private X(标界) as [类型:integer / string…… ]
例如： dim a(1) as integer
a(1) = "test1"
a(0) = "Test0"

PRIVATE v(3) as double
v(1) = "%"
v(0) = "!"
v(2) = &"

备：想用什么就用什么。
-------------------------------------
2、如何自定义VB生成工程图标？
窗体属性的ICON就可以。要是使用exe/dll文件请用：RESHACKER
-------------------------------------
3.如何让VB生成的工程最小化后在通知区域而任务栏不显示？

代码如下：（无菜单）
Option Explicit
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Const MAX_TOOLTIP As Integer = 64
Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONUP = &H205

Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type

Private Const MF_bitmap = &H4&
Private nfIconData As NOTIFYICONDATA

Private Sub Sys_Tray()
Dim Mnu_Hwnd As Long
Dim Mnu_Id As Long
Dim i As Long
nfIconData.hwnd = Me.hwnd
nfIconData.uID = Me.Icon
nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
nfIconData.uCallbackMessage = WM_MOUSEMOVE
nfIconData.hIcon = Me.Icon.Handle
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
nfIconData.szTip = "改成你想要的文字" & vbNullChar
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
nfIconData.cbSize = Len(nfIconData)
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub Form_Load()
Sys_Tray
With Me
.Visible = False
End With
End Sub

------------------------------
如何添加菜单？？？？？？？？
1.请添加菜单在“菜单编辑器”中添加。
然后FORM _MouseMove 事件中，添加如下代码：
‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘
Dim lMsg As Single
lMsg = x / Screen.TwipsPerPixelX
If lMsg = WM_RBUTTONUP Then
MyTrayMnu.Visible = True
Me.PopupMenu 需要的右键菜单（就是菜单）
End If
‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘

然后： 在菜单代码中添加如下代码：

On Error Resume Next
Me.Show

‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘

------------------------------------------
例子：
有一个： TaryMnu的主菜单
TaryMnu有“显示”/“隐藏“ 两个按钮：
就改成：
Dim lMsg As Single
lMsg = x / Screen.TwipsPerPixelX
If lMsg = WM_RBUTTONUP Then
TaryMnu.Visible = True
Me.PopupMenu TaryMnu
End If
------------------------------------
完

窗口最小化，任务栏不显示图标的解决办法

窗口最小化，任务栏不显示图标的解决办法   

具体症状：无论打开多少个浏览器窗口或文档或者是应用程序，任务栏上面一个都不显示，只要缩小窗口后就找不到了，要想关闭只能打开任务管理器从里面关闭 解决办法： 打开记事本，复制进下列虚线内的内容（不包括虚线）

--------------

'xp_taskbar_desktop_fixall.vbs - Repairs the Taskbar when minimized programs don't show.

' Kelly Theriot and Doug Knox - 8/22/2003

'翻译：Smallfrogs。翻译内容：将英文提示改为简体中文

'来源：Microsoft Windows XP NewsGroup



Set WSHShell = WScript.CreateObject("WScript.Shell")

Message = "本脚本用于修复Windows XP中当最小化程序时，无法在任务栏显示图标的问题。"& vbCR & vbCR

Message = Message & "为了正常工作，本脚本将关闭和重启 Windows Explorer 外壳，这个操作不会损坏你的系统。" & vbCR & vbCR

Message = Message & "请关闭所有杀毒软件的实时监控！并保存所有打开的文件。"& vbCR & vbCR

Message = Message & "是否继续？"



X = MsgBox(Message, vbYesNo+vbExclamation, "注意")



If X = 6 Then 



On Error Resume Next



WshShell.RegDelete "HKCUSoftwareMicrosoftWindowsCurrentVersionExplorerStuckRects2"

WshShell.RegDelete "HKCUSoftwareMicrosoftWindowsCurrentVersionExplorerStreamsMRU"

WshShell.RegDelete "HKCUSoftwareMicrosoftWindowsCurrentVersionExplorerStreamsDesktop"



WshShell.RegDelete "HKCUSoftwareMicrosoftInternet ExplorerExplorer Bars32683183-48a0-441b-a342-7c2a440a9478BarSize"



P1 = "HKCUSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer"



WshShell.RegWrite p1 & "NoBandCustomize", 0, "REG_DWORD"

WshShell.RegWrite p1 & "NoMovingBands", 0, "REG_DWORD"

WshShell.RegWrite p1 & "NoCloseDragDropBands", 0, "REG_DWORD"

WshShell.RegWrite p1 & "NoSetTaskbar", 0, "REG_DWORD"

WshShell.RegWrite p1 & "NoToolbarsOnTaskbar", 0, "REG_DWORD"

WshShell.RegWrite p1 & "NoSaveSettings",0,"REG_DWORD"

WshShell.RegWrite p1 & "NoToolbarsOnTaskbar", 0, "REG_DWORD"

WshShell.RegWrite p1 & "NoSetTaskbar",0,"REG_DWORD"

WshShell.RegWrite p1 & "NoActiveDesktop",0,"REG_DWORD"

WshShell.RegWrite p1 & "ClassicShell",0,"REG_DWORD"



p1 = "HKCUSoftwareMicrosoftWindowsCurrentVersionGroup Policy ObjectsLocalUserSoftwareMicrosoftWindowsCurrentVersionPoliciesExplorer"



WshShell.RegWrite p1 & "NoCloseDragDropBands", 0, "REG_DWORD"

WshShell.RegDelete p1 & "NoMovingBands"



p1 = "HKLMSoftwareMicrosoftWindows NTCurrentVersionWinlogonShell"



WshShell.RegWrite p1, "explorer.exe", "REG_SZ"



p1 = "HKCUSoftwareMicrosoftInternet ExplorerExplorer Bars32683183-48a0-441b-a342-7c2a440a9478"

WshShell.RegDelete p1 & "BarSize"

WshShell.RegWrite p1, "Media Band", "REG_SZ"



On Error Goto 0



For Each Process in GetObject("winmgmts:"). _

ExecQuery ("select * from Win32_Process where name='explorer.exe'")

  Process.terminate(0)

Next



MsgBox "完成！" & vbcr & vbcr & " Kelly Theriot and Doug Knox", 4096, "完成"



Else



MsgBox "没有对你的系统进行任何改变。" & vbcr & vbcr & " Kelly Theriot and Doug Knox", 4096, "用户取消了"



End If

--------------

保存该文件，在保存对话框的文件类型下拉菜单中选择“所有文件”，然后文件名一栏输入“1.vbs”，保存

接着双击该文件并运行

最后，任务栏上右键——工具——显示快速启动。