访问应用程序,带有表单任务栏图标的隐藏应用程序窗口

Bra*_*yer 6 api vba

我有一个主要表单的访问应用程序.当您打开应用程序时,AutoExec宏通过Windows API apiShowWindow隐藏应用程序.然后,AutoExec打开设置为Popup的主窗体.这一切都很美妙; 我的数据库内容被隐藏,表单打开,只是浮动.

但是,当访问数据库被隐藏时,您将丢失任务栏图标.我在Options\Current Database\Application Icon设置中设置了自定义图标.如果我不隐藏数据库,则此图标在任务栏中显示正常.

我找到了一个API解决方法,它将在任务栏中仅为表单显示一个图标.它有点像这样:

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 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

Public Sub AppTasklist(frmHwnd)
Dim WStyle  As Long
Dim Result  As Long

WStyle = GetWindowLong(frmHwnd, GWL_EXSTYLE)

WStyle = WStyle Or WS_EX_APPWINDOW

Result = SetWindowPos(frmHwnd, HWND_TOP, 0, 0, 0, 0, _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE Or _
                      SWP_NOACTIVATE Or _
                      SWP_HIDEWINDOW)

Result = SetWindowLong(frmHwnd, GWL_EXSTYLE, WStyle)
Debug.Print Result

Result = SetWindowPos(frmHwnd, HWND_TOP, 0, 0, 0, 0, _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE Or _
                      SWP_NOACTIVATE Or _
                      SWP_SHOWWINDOW)


End Sub
Run Code Online (Sandbox Code Playgroud)

这种方法确实有效; 我在任务栏中获得了一个专用于表单的图标.但是,任务栏中的图标是标准的Access图标.

为了解决这个问题,我使用SendMessageA添加了另一个API调用:

Public Declare Function SendMessage32 Lib"user32"Alias _"SendMessageA"(ByVal hWnd As Long,ByVal wMsg As Long,_ ByVal wParam As Long,ByVal lParam As Long)As Long

执行如下:

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Dim icoPth  As String: icoPth = CurrentProject.Path & "\MyAppIcon.ico"
Dim NewIco  As Long: NewIco = ExtractIcon32(0, icoPth, 0)
Dim frmHwnd As Long: frmHwnd = Me.hwnd 'the form's handle

SendMessage32 frmHwnd, WM_SETICON, ICON_SMALL, NewIco
SendMessage32 frmHwnd, WM_SETICON, ICON_BIG, NewIco

SendMessage32 hWndAccessApp, WM_SETICON, ICON_SMALL, NewIco
SendMessage32 hWndAccessApp, WM_SETICON, ICON_BIG, NewIco
Run Code Online (Sandbox Code Playgroud)

请记住,我已经在AppTasklist Sub的内部和外部,顶部和底部的各种顺序中尝试了上述四行"SendMessages",但无济于事.

它似乎确实在应用程序级别工作,但它似乎永远不会在表单级别工作.

对于那些熟悉这种特殊困境的人,让我列出一些我尝试过的VBA以外的其他选项.

1.)任务栏\属性\任务栏按钮.我已将此菜单选项更改为"从不组合"和"任务栏已满时组合".所以,基本上,这确实有效; 我现在只获取文件夹和小标签的图标.但是(!),它仅在用户在其末尾检查了这些设置时才有效.根据我的经验,除了"始终合并,隐藏标签"之外,几乎没有人使用任何选项.

2.)更改注册表设置.您可以更改以下注册表项以更改应用程序使用的默认图标:"HKEY_CLASSES_ROOT\Access.Application.14\DefaultIcon(默认)." 但是,大多数用户(包括我自己)无权访问注册表的HKEY_CLASSES_ROOT部分.此外,我必须编写一些代码来找到正确的密钥,然后更改它(我可以做)但是,目前还不清楚这种变化是否会立即发生 - 更不用说我退出时必须将其更改回来应用.

3.)右键单击固定的应用程序,然后右键单击菜单中的应用程序,会在"快捷方式"选项卡中为您提供一个属性菜单,其中包含一个名为"更改图标..."的按钮.但是,对于像Access这样的程序,此按钮显示为灰色.

我使用的是Windows 7和Access 2010.

是否可以将上述场景中的任务栏图标强制为标准Access图标以外的其他内容?

我觉得有一些我缺少的东西,或者可以使用的API函数,或者更好的SendMessage常量,或者说,它可能无法完成.

任何帮助将不胜感激.

此外,作为免责声明(我猜):显然上面的代码是从这个论坛和其他人的其他帖子中提取的.其中大部分都是从我得到的那里获得的.我已经做了一些小的调整,使其在Access中工作,而不是其他一些不断进入我的搜索结果的Microsoft软件,所以我不会在这里命名.

谢谢!

Bra*_*yer 2

好的。所以我要回答我自己的问题。显然,我真正需要的只是从行动中休息一下,然后把我的问题打出来。在我发布问题后不久,我又重新开始尝试更多的搜索词。我最终发现了一篇文章,一开始似乎并没有什么成果,因为我不清楚发帖者和我自己是否正在处理相同的场景。

我在这里找到了答案:

http://www.access-programmers.co.uk/forums/showthread.php?t=231422

首先,您的应用程序必须通过快捷方式打开。对我来说幸运的是,我从一开始就一直使用桌面快捷方式。

当我开始构建应用程序时,我从一开始就知道我将使用 VBScript 来安装应用程序(以及在发布新版本时进行更新)。在该脚本中,我创建了存储在用户文档目录中的应用程序的桌面快捷方式。我还将应用程序图标存储在附加到应用程序快捷方式的目录中。

如果您从未通过 vba/script 创建快捷方式,那么您基本上会执行类似以下操作(用 vbScript 编写):

Dim WinShell
Dim ShtCut

Set WinShell = CreateObject("WScript.Shell")
Set ShtCut = WinShell.CreateShortcut(strDesktopPath & "\MyCoolApp.lnk")

With ShtCut
     .TargetPath = (See below)
     .Arguments = (See below)
     .IconLocation = ...
     .Desciption = "This is the coolest app, yo!"
     .WorkingDirectory = strAppPath
     .WindowStyle = 1
     .Save
End With
Run Code Online (Sandbox Code Playgroud)

现在,快捷方式的目标开始是这样的:

"C:\Users\UserName\Public\Documents\MyCoolApp\MyCoolApp.accdb"
Run Code Online (Sandbox Code Playgroud)

显然,您的用户的文档位置可能有不同的企业结构......

上面的参考文章建议做的是将快捷方式转换为伪命令行脚本。

去做这个:

首先,您的实际目标将是用户访问版本(运行时或完整)的路径,如下所示:

"C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE"
Run Code Online (Sandbox Code Playgroud)

重要的!您必须将此目标用双引号引起来,即:

.TargetPath = Chr(34) & strAccessPath & Chr(34)
Run Code Online (Sandbox Code Playgroud)

接下来(您在上面的帖子中找不到这个,我必须弄清楚),您需要将参数设置为应用程序的目录,如下所示:

"C:\Users\UserName\Public\Documents\MyCoolApp\MyCoolApp.accdb"
Run Code Online (Sandbox Code Playgroud)

重要的!同样,您必须将参数用双引号引起来,即:

.Arguments = Chr(34) & strAppPath & Chr(34)
Run Code Online (Sandbox Code Playgroud)

同样重要的是,我希望你的应用程序很酷。

一旦你设置了这个快捷方式,基本上你就可以让你的应用程序在任务栏上有它自己的工作组。即,如果 Access 通常打开,您的应用程序将在任务栏上有它自己的组。该组将有与之相关联的很酷的自定义图标。作为一个意想不到的巨大好处,您将能够将快捷方式固定到 Access 之外的任务栏。亲爱的!

祝你好运!