在 64 位 VBA 中使用 TaskDialogIndirect [英] Using TaskDialogIndirect in 64-Bit VBA
问题描述
我尝试让代码在 64 位 VBA 下工作，而在 32 位 VBA 中工作正常.
I try to get code working under 64-Bit VBA which works fine in 32-Bit VBA.
它是关于通用控件任务对话框的.
It is regarding Common Controls TaskDialogs.
我使用 Microsoft Access，但问题在其他 VBA 主机中应该相同.
I use Microsoft Access, but the problem should be the same in other VBA hosts.
一部分在(32 位和 64 位)VBA 中都可以正常工作，另一部分则不能.
One part works fine in both (32- and 64-Bit) VBA, the other part doesn't.
您可以启动程序 TestTaskDlg 进行测试.
You can start the procedure TestTaskDlg for a test.
Option Explicit
'Original API definition:
'------------------------
'HRESULT TaskDialog(
' HWND hwndOwner,
' HINSTANCE hInstance,
' PCWSTR pszWindowTitle,
' PCWSTR pszMainInstruction,
' PCWSTR pszContent,
' TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons,
' PCWSTR pszIcon,
' int *pnButton
');
Private Declare PtrSafe Function TaskDialog Lib "Comctl32.dll" _
(ByVal hWndParent As LongPtr, _
ByVal hInstance As LongPtr, _
ByVal pszWindowTitle As LongPtr, _
ByVal pszMainInstruction As LongPtr, _
ByVal pszContent As LongPtr, _
ByVal dwCommonButtons As Long, _
ByVal pszIcon As LongPtr, _
ByRef pnButton As Long _
) As Long
'Works fine with 32-Bit VBA and 64-Bit VBA:
Public Sub TestTaskDlg()
Debug.Print TaskDlg("Title", "MainInstructionText", "ContentText")
End Sub
Public Function TaskDlg( _
sWindowTitle As String, _
sMainInstruction As String, _
sContent As String _
) As Long
On Local Error GoTo Catch
Dim clickedButton As Long
TaskDlg = TaskDialog(0, _
0, _
StrPtr(sWindowTitle), _
StrPtr(sMainInstruction), _
StrPtr(sContent), _
0, _
0, _
clickedButton)
Debug.Print "Clicked button:", clickedButton
Done:
Exit Function
Catch:
MsgBox Err.Description, , Err.Number
Resume Done
End Function
TaskDialogIndirect API 仅在 32 位 VBA 中运行良好
您可以启动过程 TestTaskDlgIndirect 进行测试.
TaskDialogIndirect API working well only in 32-Bit VBA
You can start the procedure TestTaskDlgIndirect for a test.
在 64 位 VBA 中，它返回 E_INVALIDARG (0x80070057 | -2147024809)，以某种方式指向无效参数...
In 64-Bit VBA it returns E_INVALIDARG (0x80070057 | -2147024809), pointing to invalid arguments somehow...
如果我使用 Len() 而不是 LenB() 并注释这三行代码，它会显示一个正确的(空)对话框，因此 LenB() 的调用code>TaskDialogIndirect 应该是正确的.
If I use Len() instead of LenB() and comment this three lines of code, it shows a proper (empty) dialog, so the call of TaskDialogIndirect should be correct.
tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
tdlgConfig.pszContent = StrPtr(sContent)
有人知道为什么它不能在 64 位 VBA 中工作吗?
Does anybody have an idea why it is not working in 64-bit VBA?
在我看来，我已经将类型从 Long 正确转换为 LongPtr.
In my opinion I already converted the types from Long to LongPtr properly.
我认为在运行时将存储在结构中的值/指针有问题.
I expect it is a problem with the values/pointers which will be stored in the structure at runtime.
也许是一些高/低字节的东西?
Maybe some Hi-/Low-Byte stuff?
任何帮助表示赞赏.:-)
Any help appreciated. :-)
Option Explicit
'Original API definition:
'------------------------
'typedef struct _TASKDIALOGCONFIG {
' UINT cbSize;
' HWND hwndParent;
' HINSTANCE hInstance;
' TASKDIALOG_FLAGS dwFlags;
' TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons;
' PCWSTR pszWindowTitle;
' union {
' HICON hMainIcon;
' PCWSTR pszMainIcon;
' } DUMMYUNIONNAME;
' PCWSTR pszMainInstruction;
' PCWSTR pszContent;
' UINT cButtons;
' const TASKDIALOG_BUTTON *pButtons;
' int nDefaultButton;
' UINT cRadioButtons;
' const TASKDIALOG_BUTTON *pRadioButtons;
' int nDefaultRadioButton;
' PCWSTR pszVerificationText;
' PCWSTR pszExpandedInformation;
' PCWSTR pszExpandedControlText;
' PCWSTR pszCollapsedControlText;
' union {
' HICON hFooterIcon;
' PCWSTR pszFooterIcon;
' } DUMMYUNIONNAME2;
' PCWSTR pszFooter;
' PFTASKDIALOGCALLBACK pfCallback;
' LONG_PTR lpCallbackData;
' UINT cxWidth;
'} TASKDIALOGCONFIG;
Public Type TASKDIALOGCONFIG
cbSize As Long 'UINT
hWndParent As LongPtr 'HWND
hInstance As LongPtr 'HINSTANCE
dwFlags As Long 'TASKDIALOG_FLAGS
dwCommonButtons As Long 'TASKDIALOG_COMMON_BUTTON_FLAGS
pszWindowTitle As LongPtr 'PCWSTR
' Union
' {
hMainIcon As LongPtr 'Union means that the biggest type has to be declared: So LongPtr
' hMainIcon 'HICON
' pszMainIcon 'PCWSTR
' };
pszMainInstruction As LongPtr 'PCWSTR
pszContent As LongPtr 'PCWSTR
cButtons As Long 'UINT
pButtons As LongPtr 'TASKDIALOG_BUTTON *pButtons;
nDefaultButton As Long 'INT
cRadioButtons As Long 'UINT
pRadioButtons As LongPtr 'TASKDIALOG_BUTTON *pRadioButtons;
nDefaultRadioButton As Long 'INT
pszVerificationText As LongPtr 'PCWSTR
pszExpandedInformation As LongPtr 'PCWSTR
pszExpandedControlText As LongPtr 'PCWSTR
pszCollapsedControlText As LongPtr 'PCWSTR
'Union
'{
hFooterIcon As LongPtr 'Union means that the biggest type has to be declared: So LongPtr
' hFooterIcon 'HICON
' pszFooterIcon 'PCWSTR
'};
pszFooter As LongPtr 'PCWSTR
pfCallback As LongPtr 'PFTASKDIALOGCALLBACK
lpCallbackData As LongPtr 'LONG_PTR
cxWidth As Long 'UINT
End Type
'Original API definition:
'------------------------
'HRESULT TaskDialogIndirect(
' const TASKDIALOGCONFIG *pTaskConfig,
' int *pnButton,
' int *pnRadioButton,
' BOOL *pfVerificationFlagChecked
');
Private Declare PtrSafe Function TaskDialogIndirect Lib "Comctl32.dll" ( _
ByRef pTaskConfig As TASKDIALOGCONFIG, _
ByRef pnButton As Long, _
ByRef pnRadioButton As Long, _
ByRef pfVerificationFlagChecked As Long _
) As Long
'Works fine with 32-Bit VBA. But with 64-Bit VBA it returns E_INVALIDARG (0x80070057 | -2147024809)
Public Sub TestTaskDlgIndirect()
Debug.Print TaskDlgIndirect("Title", "MainInstructionText", "ContentText")
End Sub
Public Function TaskDlgIndirect( _
sWindowTitle As String, _
sMainInstruction As String, _
sContent As String _
) As Long
On Local Error GoTo Catch
Dim tdlgConfig As TASKDIALOGCONFIG
tdlgConfig.cbSize = LenB(tdlgConfig)
'Usually LenB() should be the right way to use, but when I use Len() and comment the three texts below, it shows a proper empty dialog!
tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
tdlgConfig.pszContent = StrPtr(sContent)
Dim clickedButton As Long
Dim selectedRadio As Long
Dim verificationFlagChecked As Long
TaskDlgIndirect = TaskDialogIndirect(tdlgConfig, clickedButton, _
selectedRadio, verificationFlagChecked)
Debug.Print "Clicked button:", clickedButton
Done:
Exit Function
Catch:
MsgBox Err.Description, , Err.Number
Resume Done
End Function
更新
一些新见解:
似乎TASKDIALOGCONFIG 在内部使用了一个 1 字节的包装.
It seems that TASKDIALOGCONFIG uses a 1-byte packing internally.
在 32 位 VBA(对结构使用 4 字节填充)中，这无关紧要，因为结构的所有成员都是
Long类型，所以是 4 字节，所以没有完全发生了填充.
同样在这个星座中，使用Len(tdlgConfig)没有区别，它只计算数据类型的总和，以及LenB(tdlgConfig)，它计算实际大小确实是结构.
两者都在这里产生 96 个字节.
In 32-bit VBA (which uses 4-byte padding for structs) this didn't matter because all members of the struct were of type
Longand so 4 byte, so no padding occured at all.
Also in this constellation there is no difference in usingLen(tdlgConfig), which calculates the sum of the datatypes only, andLenB(tdlgConfig), which calculates the real size of the struct indeed.
Both result in 96 bytes here.
但是在 64 位 VBA(结构体使用 8 字节填充)中，结构体的一些成员是 Long 类型(4 字节)，一些是 LongLong(8 字节)(声明为 LongPtr 以实现 32 位兼容性).此结果对 VBA 应用填充，这就是 Len(tdlgConfig) 返回 160 和 LenB(tdlgConfig) 176 的原因.
But in 64-bit VBA (which uses 8-byte padding for structs) some members of the struct are of type Long (4 byte) and some are LongLong (8 byte) (declared as LongPtr for 32-bit compatibility).
This results to VBA applies padding and that is the reason why Len(tdlgConfig) returns 160 and LenB(tdlgConfig) 176.
所以因为我的测试没有提供任何文本(注释提到的 3 行代码)仅在我使用 Len(tdlgConfig)(而不是 LenB(tdlgConfig))) 得出相同的结论，即 64 位 API 只需要 160 字节的结构.
So because my test without providing any texts (commenting the mentioned 3 lines of code) displays a dialog only when I use Len(tdlgConfig) (instead of LenB(tdlgConfig)) leads to the same conclusion, that the 64-bit API expects a structure of 160 bytes only.
所以为了提供一个 160 字节的结构，我将其用于测试:
So to provide a struct of 160 bytes I used this for a test:
Public Type TASKDIALOGCONFIG
cbSize As Long
dummy2 As Long
dummy3 As Long
dummy4 As Long
dummy5 As Long
dummy6 As Long
dwCommonButtons As Long
dummy8 As Long
dummy9 As Long
dummy10 As Long
dummy11 As Long
dummy12 As Long
dummy13 As Long
dummy14 As Long
dummy15 As Long
dummy16 As Long
dummy17 As Long
dummy18 As Long
nDefaultButton As Long
dummy20 As Long
dummy21 As Long
dummy22 As Long
dummy23 As Long
dummy24 As Long
dummy25 As Long
dummy26 As Long
dummy27 As Long
dummy28 As Long
dummy29 As Long
dummy30 As Long
dummy31 As Long
dummy32 As Long
dummy33 As Long
dummy34 As Long
dummy35 As Long
dummy36 As Long
dummy37 As Long
dummy38 As Long
dummy39 As Long
dummy40 As Long
End Type
现在 Len(tdlgConfig) 和 LenB(tdlgConfig) 都返回 160.
Now both, Len(tdlgConfig) and LenB(tdlgConfig) return 160.
调用没有文本的空对话框仍然运行良好.
Calling the empty dialog without texts still runs well.
我现在可以设置 dwCommonButtons 和 nDefaultButton(都是 Long 类型)，到目前为止它工作正常.
And I now can set dwCommonButtons and nDefaultButton (both type Long) and it works correct so far.
例如:
Public Enum TD_COMMON_BUTTON_FLAGS
TDCBF_OK_BUTTON = &H1& '// Selected control returns value IDOK
TDCBF_YES_BUTTON = &H2& '// Selected control returns value IDYES
TDCBF_NO_BUTTON = &H4& '// Selected control returns value IDNO
TDCBF_CANCEL_BUTTON = &H8& '// Selected control returns value IDCANCEL
TDCBF_RETRY_BUTTON = &H10& '// Selected control returns value IDRETRY
TDCBF_CLOSE_BUTTON = &H20& '// Selected control returns value IDCLOSE
End Enum
'typedef DWORD TASKDIALOG_COMMON_BUTTON_FLAGS; // Note: _TASKDIALOG_COMMON_BUTTON_FLAGS is an int
Public Enum TD_COMMON_BUTTON_RETURN_CODES
IDOK = 1
IDCANCEL = 2
IDRETRY = 4
IDYES = 6
IDNO = 7
IDCLOSE = 8
End Enum
tdlgConfig.dwCommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON
tdlgConfig.nDefaultButton = IDNO
所以我可以期望结构的大小很好，现在我必须找出如何设置 LongLong (LongPtr) 类型...
So I can expect the size of the struct is fine and now I have to find out how to set the LongLong (LongPtr) types...
推荐答案
最后，我开始在 64 位 VBA 中设置要使用的图标和结构中的字符串.
Finally I got it working to set the icon to be used and a string in the struct in 64-Bit VBA.
这是新的结构体，我另外命名了主图标和主指令文本的成员:
This is the new struct, where I named the members for the main icon and the main instruction text additionally:
Public Type TASKDIALOGCONFIG
cbSize As Long
dummy2 As Long
dummy3 As Long
dummy4 As Long
dummy5 As Long
dummy6 As Long
dwCommonButtons As Long
dummy8 As Long
dummy9 As Long
hMainIcon1 As Long
hMainIcon2 As Long
pszMainInstruction1 As Long
pszMainInstruction2 As Long
dummy14 As Long
dummy15 As Long
dummy16 As Long
dummy17 As Long
dummy18 As Long
nDefaultButton As Long
dummy20 As Long
dummy21 As Long
dummy22 As Long
dummy23 As Long
dummy24 As Long
dummy25 As Long
dummy26 As Long
dummy27 As Long
dummy28 As Long
dummy29 As Long
dummy30 As Long
dummy31 As Long
dummy32 As Long
dummy33 As Long
dummy34 As Long
dummy35 As Long
dummy36 As Long
dummy37 As Long
dummy38 As Long
dummy39 As Long
dummy40 As Long
End Type
因为结构中的 LongLong 值现在都被拆分为单独的 Long 值，所以我无法以通用方式设置它们.
Because the LongLong values in the struct now all are split into separate Long values, I couldn't set them in a common way.
通过一些尝试和错误，我找到了一种设置图标的方法.以在 32 位 VBA 中必须完成的相同方式设置第一个 Long 值就足够了:
With some try and error I found a way to set the icon. It is enough to set the first Long value in the same way it has to be done in 32-Bit VBA:
Const TD_SECURITY_ICON_OK As Integer = -8
tdlgConfig.hMainIcon1 = &HFFFF And TD_SECURITY_ICON_OK
将指针设置为字符串也有点棘手.我终于声明了 CopyMemory API 子...
Setting the pointer to a string also was a bit tricky. I finally declare the CopyMemory API sub...
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByVal destination As LongPtr, _
ByVal source As LongPtr, _
ByVal dataLength As LongPtr)
...并像这样使用它在结构中设置字符串引用:
...and use it like this to set a string reference in the struct:
CopyMemory VarPtr(tdlgConfig.pszMainInstruction1), VarPtr(StrPtr("My main instruction")), 8
最后我可以像这样使用 TaskDialogIndirect 函数:
Finally I can use the function TaskDialogIndirect like this:
Dim clickedButton As Long
Dim selectedRadio As Long
Dim verificationFlagChecked As Long
Call TaskDialogIndirect(tdlgConfig, clickedButton, _
selectedRadio, verificationFlagChecked)
Debug.Print "Clicked button:", clickedButton
剩下的就是设置其他文本等，并使用大小写区分使代码在 32 位和 64 位可执行.
The rest is pure diligence to set the other texts etc. and make the code executable for 32-bit and 64-bit using case distinctions.
再次感谢 GSerg 的回复.
Thanks again to GSerg for replying.
这篇关于在 64 位 VBA 中使用 TaskDialogIndirect的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
