VBA测试桌面组成

时间:2018-02-20 19:57:30

标签: vba excel-vba excel

我有一些利用userforms的excel项目。这些用户表单有一些使用Windows API调用来修改其样式的代码。这方面的一个例子可以在这里找到:

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hwnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare PtrSafe Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hwnd As Long, ByRef NEWMARGINS As MARGINS) As Long
Private UFSHADOW As Long
Private Type MARGINS
    leftWidth As Long
    rightWidth As Long
    topHeight As Long
    bottomHeight As Long
End Type

Sub all_userForms_AddShadow(frm As Object)
'Sub adds a shadow

Dim MARGINS As MARGINS

UFSHADOW = FindWindow("ThunderDFrame", vbNullString) 'Create a new Window

DwmSetWindowAttribute UFSHADOW, 2, 2, 4 'DWMAPI

'Determine Margins
With MARGINS
    .rightWidth = 1
    .leftWidth = 1
    .topHeight = 1
    .bottomHeight = 1
End With

DwmExtendFrameIntoClientArea UFSHADOW, MARGINS 'DWMAPI

'Resize
frm.Width = frm.Width - 1
frm.Height = frm.Height - 1

End Sub

问题是在某些客户端上,这将编译正常,但初始化userform时不会显示结果。我相信这是因为在某些客户端上,默认情况下禁用Windows设置“启用桌面组合”并且无法修改。我计划使用的解决方法是测试Desktop Composition是否已启用,如果不是,我将不会调用该子。

我的问题是我无法弄清楚如何测试这个。在此链接的备注部分https://msdn.microsoft.com/en-us/library/windows/desktop/aa969524(v=vs.85).aspx描述了DwmSetWindowAttribute函数失败时应返回的内容:DWM_E_COMPOSITIONDISABLED。我已经尝试将此函数设置为等于几个变量类型,但它不起作用。

示例:

禁用桌面组合 No Shadow Visible 桌面组合已启用

Shadow Visible

有什么建议吗?感谢

编辑:回应Mat's Mug的问题: 没有错误,它只是没有绘制阴影。

你可能没有得到预期的结果,因为我调用了一些其他的API函数,这些函数与“添加阴影”子有关,它转动了窗口标题而另一个关闭了边框。我也可以发布这些帖子,但这篇帖子很长。

我对使用Windows API函数有点新意,我不太清楚您对IF条件和VB签名的评论,但我现在正在研究它。

就位数而言,很可能会在32位和64位操作系统上访问此工具。更新..我刚刚测试了两个版本,我的本地机器有64位操作系统,问题版本有32位

0 个答案:

没有答案