Описание проблемы
Я пытаюсь заставить работать код под 64-битным VBA, который прекрасно работает в 32-битном VBA.
Это касается Common Controls TaskDialogs.
Я использую Microsoft Access, но проблема должна быть такой же на других хостах VBA.
Одна часть отлично работает в обоих (32- и 64-битных) VBA, а другая - нет.
TaskDialog API хорошо работает в обоих (32- и 64-битных) VBA
Вы можете запустить процедуру TestTaskDlg для теста.
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 для теста.
В 64-битном VBA он возвращает E_INVALIDARG (0x80070057 | -2147024809), указывая каким-то образом на недопустимые аргументы .. .
Если я использую Len() вместо LenB() и прокомментирую эти три строки кода, он показывает правильное (пустое) диалоговое окно, поэтому вызов TaskDialogIndirect должен быть правильным.
tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
tdlgConfig.pszContent = StrPtr(sContent)
Кто-нибудь знает, почему он не работает в 64-битном VBA?
По-моему, я уже конвертировал типы из Long в LongPtr pro perly.
Я предполагаю, что это проблема со значениями / указателями, которые будут храниться в структуре во время выполнения.
Может быть, некоторые Hi- / Low-Byte вещи?
Любая помощь приветствуется. : -)
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-байтовую упаковку.
В 32-битном VBA (который использует 4-байтовое заполнение для структур) это не имело значения, потому что все члены структуры имели тип Long и, следовательно, 4 байта, поэтому нет Заполнение произошло вообще.
Также в этом созвездии нет разницы в использовании Len(tdlgConfig), который вычисляет сумму только типов данных, и LenB(tdlgConfig), который действительно вычисляет реальный размер структуры.
Оба в результате получается 96 байтов.
Но в 64-битном VBA (который использует 8-байтовое заполнение для структур) некоторые члены структуры имеют тип Long (4 байта) и некоторые из них LongLong (8 байт) (объявлены как LongPtr для 32-битной совместимости). Это приводит к тому, что VBA применяет заполнение, и именно поэтому Len(tdlgConfig) возвращает 160 и LenB(tdlgConfig) 176.
Так как мой тест без предоставления каких-либо текстов (комментируя упомянутые 3 строк кода) отображает диалоговое окно только тогда, когда я использую Len(tdlgConfig) (вместо LenB(tdlgConfig)) приводит к тому же выводу, что 64-битный API ожидает структуру только 160 байтов.
Таким образом, чтобы обеспечить структуру из 160 байтов, я использовал это для теста:
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.
Вызов пустого диалога без текстов по-прежнему работает хорошо.
И теперь я могу установить dwCommonButtons и nDefaultButton (оба типа Long), и пока он работает правильно.
Например:
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) типы ...