Using TaskDialogIndirect in 64-Bit VBA

3

Problem description

I try to get code working under 64-Bit VBA which works fine in 32-Bit VBA.

It is regarding Common Controls TaskDialogs.

I use Microsoft Access, but the problem should be the same in other VBA hosts.

One part works fine in both (32- and 64-Bit) VBA, the other part doesn't.

TaskDialog API working well in both (32- and 64-Bit) VBA

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 working well only in 32-Bit VBA

You can start the procedure TestTaskDlgIndirect for a test.

In 64-Bit VBA it returns E_INVALIDARG (0x80070057 | -2147024809), pointing to invalid arguments somehow...

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)

Does anybody have an idea why it is not working in 64-bit VBA?

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

Update

Some new insights:

It seems that TASKDIALOGCONFIG uses a 1-byte packing internally.

  • In 32-bit VBA (which uses 4-byte padding for structs) this didn't matter because all members of the struct were of type Long and so 4 byte, so no padding occured at all.
    Also in this constellation there is no difference in using Len(tdlgConfig), which calculates the sum of the datatypes only, and LenB(tdlgConfig), which calculates the real size of the struct indeed.
    Both result in 96 bytes here.

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

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

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

Now both, Len(tdlgConfig) and LenB(tdlgConfig) return 160.

Calling the empty dialog without texts still runs well.

And I now can set dwCommonButtons and nDefaultButton (both type Long) and it works correct so far.

For example:

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

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

vba
api
64-bit
comctl32
asked on Stack Overflow Apr 23, 2020 by Unhandled Exception • edited Apr 25, 2020 by Unhandled Exception

1 Answer

0

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

Because the LongLong values in the struct now all are split into separate Long values, I couldn't set them in a common way.

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

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

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

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.

Thanks again to GSerg for replying.

answered on Stack Overflow Apr 25, 2020 by Unhandled Exception

User contributions licensed under CC BY-SA 3.0