[VB6] TaskDialogIndirect - Complete class implementation of Vista+ Task Dialogs

I think this addition also needs to be made

Code:

---

Public Sub Init()
'resets the entire module
...
tComboInit.iOverlay = 0
tComboInit.lpData = 0

---

I'm also experimenting with adding a 'NewIndex" property as that can be useful in some cases. For that I have added to the above code

Code:

---

tComboInit.iOverlay = 0
tComboInit.lpData = 0
nComboNewIndex = 0

---

and this in declaration

Code:

---

Private nComboIdx As Long
Private nComboNewIndex As Long

---

property

Code:

---

Public Property Get ComboHeight() As Long: ComboHeight = cyCombo: End Property

Public Property Get ComboNewIndex() As Long: ComboNewIndex = nComboNewIndex: End Property

Public Property Let SliderAlign(nAlign As TDInputBoxAlign): nSliderAlign = nAlign: End Property

---

and finally I made these changes to ComboAddItem and at the same time cut down on the use of UBound() to make the code a tad more efficient

Code:

---

Public Sub ComboAddItem(sText As String, Optional iImage As Long = -1, Optional iOverlay As Long = -1, Optional lParam As Long = 0)
If aComboItems(0).sText = "" Then
    aComboItems(0).sText = sText
    aComboItems(0).iImage = iImage
    aComboItems(0).iOverlay = iOverlay
    aComboItems(0).lpData = lParam
    Exit Sub
End If
nComboNewIndex = UBound(aComboItems) + 1
ReDim Preserve aComboItems(nComboNewIndex)
aComboItems(nComboNewIndex).sText = sText
aComboItems(nComboNewIndex).iImage = iImage
aComboItems(nComboNewIndex).iOverlay = iOverlay
aComboItems(nComboNewIndex).lpData = lParam
If hCombo Then
    CBX_InsertItem hCombo, sText, iImage, iOverlay, lParam
End If
End Sub

---

Maybe you prefer the repeated calls to UBound as your coding style, I just try to avoid unnecessary calls :-)

Hi again, I think I have found something at least I concider to be a bug.
In the ProcessCallback function, if the combostyle is editable and the combo text field is left empty when submitting the dialog (in this case clicking a custom button)

Code:

---

    Case TDN_DESTROYED
        If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW(hEditBox, WM_GETTEXT, lLen, ByVal sText)
                sEditText = StrConv(sText, vbFromUnicode)
            End If
        End If
        If hCombo Then
            sComboText = GetComboTextW(hEditCombo)

---

the sComboText variable will get assigned a Chr$(0) so you can never make the test

Code:

---

If len(Trim$(.ResultComboText)) > 0 Then

---

or

Code:

---

If Trim$(.ResultComboText) = "" Then

---

so I think the returned string somehow needs to be tested for Chr$(0) and removed if exists.

ah good call, I'd tend to fix it at the source, GetComboText was adding a 1 to the length even if it was 0. Can't recall if the extra 1 is needed for anything or not, but in case:

Code:

---

Private Function GetComboTextW(hEdit As Long) As String
Dim bytS() As Byte
Dim ch As Long
ch = SendMessageW(hEdit, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
If ch = 0& Then Exit Function
ch = ch + 1
ReDim Preserve bytS(ch)
ch = SendMessageW(hEdit, WM_GETTEXT, ch, ByVal VarPtr(bytS(0))) * 2 - 1
If ch >= 0 Then
    ReDim Preserve bytS(ch)
End If
GetComboTextW = CStr(bytS)

End Function

---

The return on that len=0 for empty boxes.

Will also add the other parts of the extra data you found, thanks.

Hi, I'm doing some quality control of my code as I'm setting up unit testing, and wonder is this a bug?

Code:

---

Public Property Get DefaultRadioButton() As Long: DefaultButton = uTDC.nDefaultRadioButton: End Property

---

shouldn't it be

Code:

---

Public Property Get DefaultRadioButton() As Long: DefaultRadioButton = uTDC.nDefaultRadioButton: End Property

---

?
in cTaskDialog

EDIT/ADDING:
and same with this

Code:

---

Public Property Get DateTimeAlign() As TDInputBoxAlign: ComboAlign = nDateTimeAlign: End Property

---

to be

Code:

---

Public Property Get DateTimeAlign() As TDInputBoxAlign: DateTimeAlign = nDateTimeAlign: End Property

---

and this

Code:

---

Public Property Get DateTimeAlignInButtons() As TDControlAlign: DateTimeAlignInFooter = nDTButtonAlign: End Property

---

to be

Code:

---

Public Property Get DateTimeAlignInButtons() As TDControlAlign: DateTimeAlignInButtons = nDTButtonAlign: End Property

---

ooou, another one maybe, at least the code doesn't make sense to me.

Code:

---

Public Sub EnableButton(ButtonID As Long, lEnable As Long)
'lEnable=0 disable; <>0 enable
...
    Else
        Dim lnew() As Long
        ReDim lnew(0)
        Dim i As Long, k As Long
        For i = 0 To UBound(lBtnDis)
            If lBtnDis(i) <> ButtonID Then
                ReDim Preserve lnew(k)
                lnew(k) = lBtnDis(i)
            End If
        Next
        lBtnDis = lnew
    End If
    ...
End Sub

---

doesn't variable k need to be incremented here? and is the first ReDim of lnew() really necessary?

Good catches, I'll update the project when I have a chance.

1st redim is probably not neccessary but I've gotten burned by trying to refer to ubound(array) only to be told it's out of bounds so many times I've gotten in the habit of immediately putting redim(0) after declaring an array since it will usually help and doesn't hurt.

Here is another one, SimpleDialog shouldn't it be 'As TDRESULT' rather than 'As TDBUTTONS' ? As it is now the intellisense gives wrong suggestions, which doesn't match with what's returned.

cTaskDialog v1.2 R2

i have a string conversion problem when using the class on a chinese windows system.

The function StrConv converts the characters from a string wrong:

BEFORE:
Attachment 182042

AFTER:
Attachment 182043

Everyone should avoid to use the function StrConv if your app will run on a windows system with unicode language like chinese, russian etc.

Do you have a replacement for the StrConv-function?
Maybe a self-written function to convert the wide-unicode-string to a VB-String?

The StrConv is used here in your code:

Code:

---

Public Property Get InputText() As String
    If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW(hEditBox, WM_GETTEXT, lLen, ByVal sText)
                sEditText = StrConv(sText, vbFromUnicode)
            Else
              sEditText = vbNullString
            End If
    End If
    InputText = sEditText
End Property

---

Code:

---

Case TDN_DESTROYED
        If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW(hEditBox, WM_GETTEXT, lLen, ByVal sText)
                sEditText = StrConv(sText, vbFromUnicode)
            End If
        End If

---

I fixed the problem with the wrong text conversion!

Now the TaskDialog returns the correct unicode string!

Can you add the fix to your next release?


I added this API declaration:

Code:

---

Private Declare Function SendMessageW2 Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, _
                                                  ByVal wMsg As Long, _
                                                  ByVal wParam As Long, _
                                                  ByVal lParam As Long) As Long

---

And changed the code from:

Code:

---

Case TDN_DESTROYED
        If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW(hEditBox, WM_GETTEXT, lLen, ByVal sText)
                sEditText = StrConv(sText, vbFromUnicode)
            End If
        End If

---

to

Code:

---

Case TDN_DESTROYED
        If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW(hEditBox, WM_GETTEXT, lLen, StrPtr(sText))
                sEditText = Left$(sText, InStr(sText, Chr$(0)) - 1)
            End If
        End If

---

and i changed this code:

Code:

---

Public Property Get InputText() As String
    If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW(hEditBox, WM_GETTEXT, lLen, ByVal sText)
                sEditText = StrConv(sText, vbFromUnicode)
            Else
              sEditText = vbNullString
            End If
    End If
    InputText = sEditText
End Property

---

to

Code:

---

Public Property Get InputText() As String
    If hEditBox Then
            Dim lLen As Long, sText As String
            lLen = SendMessageW(hEditBox, WM_GETTEXTLENGTH, 0, ByVal 0&) * 2
            If lLen Then
                sText = Space$(lLen)
                Call SendMessageW2(hEditBox, WM_GETTEXT, lLen, StrPtr(sText))
                sEditText = Left$(sText, InStr(sText, Chr$(0)) - 1)
            Else
              sEditText = vbNullString
            End If
    End If
    InputText = sEditText
End Property

---

If I set the .ComboStyle = cbtDropdownList property, then the .ResultComboText property always returns empty.

.ResultComboIndex returns correctly.

Code:

---

With TaskDialog1
    .Init
    .MainInstruction = "Duplicates"
    .Content = "If you want to exclude an Artists name from the search:"
    .Flags = TDF_COMBO_BOX
    .AddCustomButton 100, "Continue"
    .CommonButtons = TDCBF_CANCEL_BUTTON
    .ComboStyle = cbtDropdownList 'cbtDropdownEdit
    .IconMain = IDI_QUESTION
    .Title = "cTaskDialog Project"
    .ComboSetInitialState "", 5
    .ComboSetInitialItem 1
    .ComboAddItem "Item 1"
    .ComboAddItem "Item 2"
    .ComboAddItem "Item 3"
    .ParenthWnd = Me.hwnd
    .ShowDialog

    Label1.Caption = .ResultComboText
    Labe2.Caption = .ResultComboIndex

End With

---

@Mith, thanks, will add to next release.

@Visualman: This is expected behavior. .ResultComboText is only meant to return the text of a regular combobox, not the item text for the DropdownList style. If you need to refer back to the item text for a dropdownlist item, you can store the entries in a module-level variable before adding them to the class, then access that variable based on the returned index.

Hi
Kindly some one help with setting up Progressbar for Taskdialog.
I cannot figureout how to interact with progress to update it after it shows in my Sub.
You cannot open it as non-blocking so you can update progress manulayy whenever I need as required during my code is running.

There's an example of that in the set of examples in the first couple posts:

Attachment 185737

Quote:

---

The TaskDialog supports having a progress bar, both regular and marquee. To enable it, include the TDF_SHOW_PROGRESS_BAR or the TDF_SHOW_MARQUEE_PROGRESS_BAR flag (you can switch back and forth between them while the dialog is open if you want). Getting it to show up is the easy part, linking it to actual events in your program is where it gets a little tricky. There's some events that are provided that will help out...

TaskDialog_DialogCreated is triggered when the dialog is displayed, then all the buttons, the radio buttons, the expando button, the checkbox, and hyperlinks all have events when the user clicks them. In addition to that, TaskDialog_Timer is sent approximately every 200ms and includes a variable telling you how many ms has elapsed since the dialog appeared, or since it was reset with the .ResetTimer() call. The example shows a basic counter, but you can go further and enable/disable buttons and use hyperlinks to control things too.

---

Code:

---

Private bRunProgress As Boolean
Private lSecs As Long


With TaskDialog1
    .Init
    .MainInstruction = "You're about to do something stupid."
    .Content = "Are you absolutely sure you want to continue with this really bad idea? I'll give you a minute to think about it."
    .IconMain = TD_INFORMATION_ICON
    .Title = "cTaskDialog Project"
    .Footer = "Really, think about it."
    .Flags = TDF_USE_COMMAND_LINKS Or TDF_SHOW_PROGRESS_BAR Or TDF_CALLBACK_TIMER
    .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here."
    .AddCustomButton 102, "NEVER!!!"
    .AddCustomButton 103, "I dunno?"
    .VerifyText = "Hold up!"
    bRunProgress = True
   
    .ShowDialog
End With


Private Sub TaskDialog1_DialogCreated(ByVal hWnd As Long)
If bRunProgress Then
    Timer1.Interval = 1000
    Timer1.Enabled = True
    TaskDialog1.ProgressSetRange 0, 60
End If
End Sub


Private Sub TaskDialog1_Timer(ByVal TimerValue As Long)
If lSecs > 60 Then
    Timer1.Enabled = False
    bRunProgress = False
Else
    TaskDialog1.ProgressSetValue lSecs
    TaskDialog1.Footer = "You've been thinking for " & lSecs & " seconds now..."
End If

End Sub

Private Sub TaskDialog1_VerificationClicked(ByVal Value As Long)
If Value = 1 Then
    Timer1.Enabled = False
    bRunProgress = False
Else
    bRunProgress = True
    Timer1.Enabled = True
End If
End Sub

Private Sub Timer1_Timer()
lSecs = lSecs + 1
End Sub

---

Hi
Thanks for your quick response. This is what I have already explored and workin gok for examples for progressbars we have.
But my issue is I have subs in a Module (one example is attached for Microsoft Access). If I run the Taskdialog before the actual tasks in my subs, I cannot go back to update the progress as Taskdialog does not let even if I don't bind hwnd to nothing.

Secondly If I take all my sub into Taskdialog timer event, it's all gets crazy.
Is there no way to just open the dialog and then within my sub I just update the progress wheneve something is completed.
I'm using Statusbar progress monitor in my sub but I wan t to replace it with Taskdialog as I repaced all other messagebox with it.


Regards

Just like the MsgBox, the TaskDialog isn't asynchronous so the only option that doesn't involve doing it through the timer callback would be running it in a different thread. Which is very difficult in VB6 and I don't know if it can even be done in VBA; perhaps this kind of progress dialog is more appropriate for the task?

This project now has a Universal version that works in twinBASIC x86/x64 and VBA7 x84/x64, in addition to VB6 and VBA6.

For now I'm leaving the version in this thread up, but the next feature update will use the universal codebase (you could drop in cTaskDialog.cls and modTDHelper from the universal codebase into the VB6 version in this thread too).

[twinBASIC/VB6/VBA7] TaskDialogIndirect: cTaskDialog universal implementation x86/x64

There's a neat workaround for the fact alignment issues make it difficult to call in VBA7x64 :)

Hello, I'm here to report something.

This line (2361)

Code:

---

Public Function SimpleDialog(sMessage As String, Optional dwBtn As TDBUTTONS = TDCBF_OK_BUTTON, Optional sTitle As String, Optional sMainText As String, Optional dwIco As TDICONS, Optional hWndOwner As Long, Optional hinst As Long) As TDBUTTONS

---

Shouldn't it be

Code:

---

Public Function SimpleDialog(sMessage As String, Optional dwBtn As TDBUTTONS = TDCBF_OK_BUTTON, Optional sTitle As String, Optional sMainText As String, Optional dwIco As TDICONS, Optional hWndOwner As Long, Optional hinst As Long) As TDRESULT

---

If you go with the former, you'll get the wrong result. Like when you expect the result to be Cancel, you'll get Yes instead.

Thank you.

Yup you're right. I've been meaning to revisit this project to get the universal version working; will fix in next release.

I am trying to do a dialog with .Flags = TDF_COMBO_BOX Or TDF_INPUT_BOX Or TDF_DATETIME
all of them with the align set to TDIBA_Content
Looks like it will not work
is there any way around it?

It's not currently supported... it was very difficult to account for all positioning issues with just a single custom control; having multiple ones in the same area would greatly increase the complexity, and I haven't accounted for that in the current version. You can have any single custom control with any combination of built in controls, but just the one for now.

It *might* work ok if you put them in different alignment slots (ComboAlignInContent, InputAlignInContent, DateTimeAlignInContent), but I can't promise that.

Hi there....I just implemented the Task Dialog (Indirect)...I got most items working in the v1.0 version...the other versions kept giving me errors

anyway....my queston is...is there any way of changing the color of the button text:

Attachment 187529

I'm getting a light blue...any way to turn it black?

Thanks!

They're not traditional elements with hwnds; they're locked behind Microsoft's undocumented DirectUI rendering system, so there's no easy way to change their color I'm aware of. Your best option might be changing them globally through the Theme API (hopefully a Microsoft-provided theme or the color options for them will do it (right click desktop, personalize->themes), otherwise the options become complicated as MS locked themes down to prevent people from restoring the superior Windows 7 look). There might also be a way in through the accessibility APIs, though even if you did find the underlying control hwnd I don't know the renderer would respond to API-called based changes.

Can you tell me any more about the errors in more recent versions? The only issues I'm aware of involve using the universal versions in 64bit Office; quite a lot of testing was done while developing that version (based on the most recent v1.2 32bit-only) and it's been solid in VB6/tB.

Hey there...thanks for the quick reply...I'll pull in the 64bit and start feeding you the issues I saw...

Hey there...as far as the errors I'm getting on cTaskDialog124-64, when I compile, I get this error, Attachment 187530

Sorry I'm getting 'invalid attachment'... sometimes the attachment system here is a little wonky...

If you're using the x64 version one issue I can think of... mTDSample.bas, the module for Demo, isn't written to work in VB6, and you'd get syntax errors; you'd have to use the mTDSample.bas from the VB6 version, which goes with the forms since .twin files can't be opened in VB6. Or if you copy-pasted from tB into VB6 instead of loading the file from the export folder, it would have copied the hidden syntax that is in VB6 files but can't appear in the editor. Is one of these the issue? Just guessing here since I just compiled in VB6, tb 32bit, and tb 64bit again to test without issue and I couldn't see the attachment.

Edit: For the former issue you'll now find a VB6-Demo folder on the project GitHub, you can extract those files to the folder with cTaskDialog.cls and the images, and the mTDSample.bas there will work in VB6 (and twinBASIC 32/64bit, but not Office).

Let me reload it...

Hey there...as far as the errors I'm getting on cTaskDialog124-64, when I compile, I get this error,

Attachment 187532

as to the process I used to load - I unzipped the cTaskDialog124-64.zip and imported the cTaskDialog file.

Lets see if this works....LOL

Didn't work. Not sure what you're doing to upload it, but maybe just let me know error name and line by text?

In a new project you need cTaskDialog.cls and mTDHelper.bas.

ok...first error on compile I get

Ambiguious name detected: SldTickStyle

It highlights the Public Enum between Private CONST GDTR_MN and PRIVATE nSliderTickStyle as SldTickStyle

That's weird... it's definitely only defined once in clsTaskDialog.cls, unless maybe you have a different version somehow?

https://github.com/fafalone/cTaskDia...TaskDialog.cls


That's the current one.

Is this happening in the demo project? If not, could the project you're using it in have another enum, variable, or function named 'SldTickStyle'?

ok...installed both those files...I get on run "Compile Error: Variable not defined"

VB highlights AddressOfTaskDialogCallbackProc in Public Function ShowDialog():


'If m_cbMain = 0& Then m_cbMain = AddressOf ProcessCallback ' scb_SetCallbackAddr(5, 2)
'uTDC.pfCallback = m_cbMain
uTDC.pfCallback = tdFARPROC(AddressOfTaskDialogCallbackProc)

There was originally a space between AddressOf TaskDialogCallbackProc - I removed the space

Why would you remove the space? It's necessary for the AddressOf operator; AddressOf ProcedureName returns the memory address of the procedure, which is how the API sends data back while the dialog is open.

tdFARPROC is defined (line 2493), and TaskDialogCallbackProc is defined in mTDHelper.bas (line 8)-- did you add that? It has to be in a .bas; you can't just cut/paste mTDHelper's contents into the class.

ok...I added back the space...when I compile, I get "Compile Error: Syntax Error" under Private Sub Class_Initialize() on m_sTitle = App Title

I am using Access in Microsoft 365 Apps for Enterprise, I have updated to latest release.

under Modules I have BasDialogWrappers, basGTIPub_Lib, mTDHelper(1.2.4); under Class Modules I have cTaskDialog (1.2.4)

As I mentioned up above, I've been having a lot of problems getting it to work in Office.

For Access, currently I believe you'd be better off using Kevin Bell's 64bit port of cTaskDialog. It's all the same features, it's just an alternative 64bit port of the VB6 version, which for whatever bizarre reason I can't identify, doesn't have the crashes you're heading for even if you do fix the title (which is a known issue)...

(The title line should be changed to

Code:

---

#If ((VB6 <> 0) Or (VBA7 <> 0)) And (TWINBASIC = 0) Then
m_sTitle = "cTaskDialog"
#Else
m_sTitle = App.Title
#End If

---

since Office doesn't have an equivalent to App.Title; substitute your own title for cTaskDialog.

Great! Thanks...I'll try it out.

Thanks for all your help!

Hey there...question on message box close (an "x" in the top right corner) -

Sometimes when the code executes there is a close X in the upper right, sometimes there is not.

I've searched most of the code and I can't find anything that turns it on or off.

Is there something not executing?

If you've included the Cancel default button (TDCBF_CANCEL_BUTTON), then it will show the X, otherwise it will not, by default.

You can also show it by adding the TDF_ALLOW_DIALOG_CANCELLATION flag, if you want it to appear but don't want a Cancel button.

This is a native behavior of the API; it hasn't been customized in any way.

With VBA64 now fully working, I'm updating this post to v1.3.8 Universal. This attachment on this post contains the VB6 project and form sample updated to work with the universal version (LongPtr), as well as the twinBASIC demo project.

IMPORTANT: For compatibility, this version no longer uses self-subclassing, and like earlier versions, once again requires mTDHelper.bas in all projects. (mTDSample.bas is still only for the demo form).

You can also view this project on GitHub, but currently only this thread has the VB6 sample project/form (even though the code is the same in the cls and twinBASIC form).

is it more efficient using a interface class than write a zombie subrotine in cTaskDialog.cls?
https://www.vbforums.com/showthread....=1#post5618727

I don't believe making a whole new class for interfaces is more efficient, no. I'll add notes to the other 2 about not calling them, only one has that now.

Hi Fafalone
sorry for this stupid and newbie question.
I'm trying to launch your "TaskDialogIndirect" from the VB6 IDE in Win10, but I always get "Error 453, Unable to point entry to comctl32.dll"
The compiled version runs without problems.
How can I solve it? I tried with a manifest in the VB6 folder, but it doesn't work. I'm definitely doing something wrong

Thanks