├── .gitattributes ├── Export ├── Resources │ ├── CUSTOM │ │ ├── ICO_CLIP │ │ ├── ICO_CLOCK │ │ └── ICO_HEART │ └── MANIFEST │ │ └── #1.xml ├── Settings └── Sources │ ├── Form1.frm.tbform │ ├── Form1.frm.twin │ ├── cTaskDialog.cls │ ├── mTDHelper.bas │ └── mTDSample.bas ├── Form1.frm ├── Form1.frm.tbform ├── Form1.frm.twin ├── ICO_CLIP.ico ├── ICO_CLOCK.ico ├── ICO_HEART.ico ├── README.md ├── cTaskDialog-x86Only.twinproj ├── cTaskDialog.cls ├── cTaskDialog.twinproj ├── cTaskDialog.vbp ├── disc24.png ├── disc256.png ├── disc32.png ├── disc48.png ├── editpaste.ico ├── mTDHelper.bas ├── mTDSample.bas ├── td.res ├── vbf.bmp ├── vbf.gif ├── vbf.jpg └── vbf2.bmp /.gitattributes: -------------------------------------------------------------------------------- 1 | *.twin linguist-language=vb6 2 | -------------------------------------------------------------------------------- /Export/Resources/CUSTOM/ICO_CLIP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/Export/Resources/CUSTOM/ICO_CLIP -------------------------------------------------------------------------------- /Export/Resources/CUSTOM/ICO_CLOCK: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/Export/Resources/CUSTOM/ICO_CLOCK -------------------------------------------------------------------------------- /Export/Resources/CUSTOM/ICO_HEART: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/Export/Resources/CUSTOM/ICO_HEART -------------------------------------------------------------------------------- /Export/Resources/MANIFEST/#1.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | cTaskDialog Comctl6 Manifest 10 | 11 | 12 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /Export/Settings: -------------------------------------------------------------------------------- 1 | { 2 | "configuration.inherits": "Defaults", 3 | "project.appTitle": "cTaskDialogDemo", 4 | "project.autoPrettify": true, 5 | "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", 6 | "project.buildType": "Standard EXE", 7 | "project.conditionalCompilationArguments": "", 8 | "project.description": "cTaskDialog Sample Project", 9 | "project.exportPathIsV2": true, 10 | "project.forceDpiAwarenessAtStartup": "NONE", 11 | "project.id": "{98476A03-DCCC-449D-A587-1A9CAF5752FB}", 12 | "project.licence": "MIT", 13 | "project.name": "cTaskDialogDemo", 14 | "project.optionExplicit": false, 15 | "project.references": [ 16 | { 17 | "hasBeenSplit": true, 18 | "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", 19 | "isCompilerPackage": true, 20 | "lcid": 0, 21 | "licence": "MIT", 22 | "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", 23 | "path32": "", 24 | "path64": "", 25 | "publisher": "TWINBASIC-COMPILER", 26 | "symbolId": "VB", 27 | "versionBuild": 0, 28 | "versionMajor": 0, 29 | "versionMinor": 0, 30 | "versionRevision": 31 31 | }, 32 | { 33 | "id": "{00020430-0000-0000-C000-000000000046}", 34 | "lcid": 0, 35 | "name": "OLE Automation", 36 | "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", 37 | "path64": "C:\\Windows\\System32\\stdole2.tlb", 38 | "symbolId": "stdole", 39 | "versionMajor": 2, 40 | "versionMinor": 0 41 | } 42 | ], 43 | "project.settingsVersion": 1, 44 | "project.startupObject": "Form1", 45 | "project.versionAutoIncrement": "Revision", 46 | "project.versionBuild": 3, 47 | "project.versionCompanyName": "Fafalonian Productions", 48 | "project.versionFileDescription": "cTaskDialog Demo App", 49 | "project.versionLegalCopyright": "©2014 -2022", 50 | "project.versionMajor": 1, 51 | "project.versionMinor": 5, 52 | "project.versionProductName": "cTaskDialog Sample Project", 53 | "project.versionRevision": 30, 54 | "project.warnings": { 55 | "errors": [], 56 | "hints": [], 57 | "ignored": [], 58 | "info": [], 59 | "warnings": [] 60 | }, 61 | "runtime.useUnicodeStandardLibrary": true 62 | } -------------------------------------------------------------------------------- /Export/Sources/Form1.frm.twin: -------------------------------------------------------------------------------- 1 | [FormDesignerId("6F7672BF-AA57-4571-B865-DDF762FD2B4C")] 2 | [PredeclaredId] 3 | Class Form1 4 | Attribute VB_Name = "Form1" 5 | Attribute VB_GlobalNameSpace = False 6 | Attribute VB_Creatable = False 7 | Attribute VB_PredeclaredId = True 8 | Attribute VB_Exposed = False 9 | Option Explicit 10 | 11 | 12 | 'cTaskDialog Samples 13 | 'Written by fafalone 14 | 'Feel free to use as you wish, with due credit 15 | 16 | 17 | 18 | Private WithEvents TaskDialog1 As cTaskDialog 19 | Attribute TaskDialog1.VB_VarHelpID = -1 20 | Private WithEvents TaskDialog2 As cTaskDialog 21 | Attribute TaskDialog2.VB_VarHelpID = -1 22 | Private WithEvents TaskDialog3 As cTaskDialog 23 | Attribute TaskDialog3.VB_VarHelpID = -1 24 | Private WithEvents TaskDialogPW As cTaskDialog 25 | Attribute TaskDialogPW.VB_VarHelpID = -1 26 | Private WithEvents TaskDialogPW2 As cTaskDialog 27 | Attribute TaskDialogPW2.VB_VarHelpID = -1 28 | Private WithEvents TaskDialogSC As cTaskDialog 29 | Attribute TaskDialogSC.VB_VarHelpID = -1 30 | Private WithEvents TaskDialogAC As cTaskDialog 31 | Attribute TaskDialogAC.VB_VarHelpID = -1 32 | Private WithEvents TaskDialogMPX1 As cTaskDialog 33 | Attribute TaskDialogMPX1.VB_VarHelpID = -1 34 | Private WithEvents TaskDialogMPX2 As cTaskDialog 35 | Attribute TaskDialogMPX2.VB_VarHelpID = -1 36 | Private WithEvents TaskDialogMPX3 As cTaskDialog 37 | Attribute TaskDialogMPX3.VB_VarHelpID = -1 38 | 39 | Private bRunProgress As Boolean 40 | Private bRunMarquee As Boolean 41 | Private bRunMarquee2 As Boolean 42 | Private lSecs As Long 43 | Private himlSys As LongPtr 44 | Private bPageExampleEx As Boolean 45 | Private sMPLogin As String 46 | 47 | Private sMPName As String 48 | 49 | Private Enum ShowWindowTypes 50 | SW_HIDE = 0 51 | SW_SHOWNORMAL = 1 52 | SW_NORMAL = 1 53 | SW_SHOWMINIMIZED = 2 54 | SW_SHOWMAXIMIZED = 3 55 | SW_MAXIMIZE = 3 56 | SW_SHOWNOACTIVATE = 4 57 | SW_SHOW = 5 58 | SW_MINIMIZE = 6 59 | SW_SHOWMINNOACTIVE = 7 60 | SW_SHOWNA = 8 61 | SW_RESTORE = 9 62 | SW_SHOWDEFAULT = 10 63 | End Enum 64 | 65 | Private Declare PtrSafe Function ShellExecuteW Lib "shell32.dll" (ByVal hWnd As LongPtr, ByVal lpOperation As LongPtr, ByVal lpFile As LongPtr, ByVal lpParameters As LongPtr, ByVal lpDirectory As LongPtr, ByVal nShowCmd As ShowWindowTypes) As LongPtr 66 | 67 | Private Declare PtrSafe Function MessageBeep Lib "user32" (ByVal wType As SysBeeps) As Long 68 | Private Enum SysBeeps 69 | MB_DEFAULTBEEP = -1 ' the default beep sound 70 | MB_ERROR = 16 ' for critical errors/problems 71 | MB_WARNING = 48 ' for conditions that might cause problems in the future 72 | MB_INFORMATION = 64 ' for informative messages only 73 | MB_QUESTION = 32 ' (no longer recommended to be used) 74 | 75 | End Enum 76 | Private Sub Command1_Click() 77 | Unload Me 78 | End 79 | End Sub 80 | 81 | Private Sub Command10_Click() 82 | With TaskDialog1 83 | .Init 84 | .MainInstruction = "You're about to do something stupid." 85 | .Content = "Are you absolutely sure you want to continue with this really bad idea? I'll give you a minute to think about it." 86 | .IconMain = TD_INFORMATION_ICON 87 | .Title = "cTaskDialog Project" 88 | .Footer = "Really, think about it." 89 | .Flags = TDF_USE_COMMAND_LINKS Or TDF_SHOW_PROGRESS_BAR Or TDF_CALLBACK_TIMER 90 | .ParenthWnd = Me.hWnd 91 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here." 92 | .AddCustomButton 102, "NEVER!!!" 93 | .AddCustomButton 103, "I dunno?" 94 | .VerifyText = "Hold up!" 95 | bRunProgress = True 96 | 97 | .ShowDialog 98 | 99 | bRunProgress = False 100 | 101 | Label1.Caption = "ID of button clicked: " & .ResultMain 102 | End With 103 | End Sub 104 | 105 | Private Sub Command11_Click() 106 | With TaskDialog1 107 | .Init 108 | .MainInstruction = "Show me the icons!" 109 | .Content = "Yeah, that's the stuff." 110 | .Footer = "Got some footer icon action here too." 111 | .Flags = TDF_USE_IMAGERES_ICONID 112 | .IconMain = 1401 113 | .IconFooter = 35 114 | .Title = "cTaskDialog Project" 115 | .CommonButtons = TDCBF_CLOSE_BUTTON 116 | 117 | .ShowDialog 118 | 119 | Label1.Caption = "ID of button clicked: " & .ResultMain 120 | 121 | End With 122 | End Sub 123 | 124 | Private Sub Command12_Click() 125 | Dim hIconM As LongPtr, hIconF As LongPtr 126 | hIconM = ResIconToHICON("ICO_CLOCK", 32, 32) 127 | hIconF = ResIconToHICON("ICO_HEART", 16, 16) 128 | With TaskDialog1 129 | .Init 130 | .MainInstruction = "Let's see it all!" 131 | .Content = "Lots and lots of features are possible, thanks Microsoft for everything!" 132 | ' .Content = "Lots and blah blah blah no link here" 133 | .IconMain = hIconM 134 | .IconFooter = hIconF 135 | .Flags = TDF_USE_HICON_MAIN Or TDF_USE_HICON_FOOTER Or TDF_ENABLE_HYPERLINKS Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_CAN_BE_MINIMIZED Or TDF_DATETIME 136 | .DateTimeType = dttDateTimeWithCheck 137 | .Title = "cTaskDialog Project" 138 | .Footer = "Have some footer text." 139 | .CollapsedControlText = "Click here for some more info." 140 | .ExpandedControlText = "Click again to hide that extra info." 141 | .ExpandedInfo = "Here's a whole bunch more information you probably don't need." 142 | .VerifyText = "Never ever show me this dialog again!" 143 | .CommonButtons = TDCBF_RETRY_BUTTON Or TDCBF_CANCEL_BUTTON Or TDCBF_CLOSE_BUTTON Or TDCBF_YES_BUTTON 144 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Some more information describing YeeHaw" 145 | .AddCustomButton 102, "NEVER!!!" 146 | .AddCustomButton 103, "I dunno?" & vbLf & "Or do i?" 147 | .AddRadioButton 110, "Let's do item 1" 148 | .AddRadioButton 111, "Or maybe 2" 149 | .AddRadioButton 112, "super secret option" 150 | .EnableRadioButton 112, 0 151 | .EnableButton 102, 0 152 | .SetButtonElevated TD_RETRY, 1 153 | bRunMarquee = True 154 | .ShowDialog 155 | bRunMarquee = False 156 | 157 | Label1.Caption = "ID of button clicked: " & .ResultMain 158 | Label2.Caption = "ID of radio button selected: " & .ResultRad 159 | Label3.Caption = "Verification box checked? " & .ResultVerify 160 | End With 161 | End Sub 162 | 163 | Private Sub Command13_Click() 164 | Dim td As TASKDIALOG_COMMON_BUTTON_FLAGS 165 | td = TaskDialog1.SimpleDialog("Is TaskDialogIndirect going to be better than this?", TDCBF_YES_BUTTON, App.Title, "This is regular old TaskDialog", TD_SHIELD_GRAY_ICON, Me.hWnd, App.hInstance) 166 | Label1.Caption = "ID of button clicked: " & td 167 | 168 | End Sub 169 | 170 | Private Sub Command14_Click() 171 | With TaskDialog2 172 | .Init 173 | .Content = "Working working working..." 174 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_RETRY_BUTTON 175 | .IconMain = TD_SHIELD_OK_ICON 176 | .Flags = TDF_SHOW_MARQUEE_PROGRESS_BAR 177 | .Title = "cTaskDialog Project - Page 2" 178 | bRunMarquee2 = True 179 | End With 180 | With TaskDialog1 181 | .Init 182 | .MainInstruction = "You can now have multiple pages." 183 | .Content = "Click Next Page to continue." 184 | .Flags = TDF_USE_COMMAND_LINKS 185 | .AddCustomButton 200, "Next Page" & vbLf & "Click here to continue to the next TaskDialog" 186 | .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON 187 | .IconMain = TD_SHIELD_WARNING_ICON 188 | .ParenthWnd = Me.hWnd 189 | .SetButtonHold 200 190 | .Title = "cTaskDialog Project - Page 1" 191 | .ShowDialog 192 | End With 193 | Label1.Caption = TaskDialog1.ResultMain 194 | bRunMarquee2 = False 195 | End Sub 196 | 197 | 198 | Private Sub Command15_Click() 199 | With TaskDialog1 200 | .Init 201 | .Content = "Input Required" 202 | .Flags = TDF_INPUT_BOX 203 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 204 | .IconMain = TD_INFORMATION_ICON 205 | .Title = "cTaskDialog Project" 206 | .ParenthWnd = Me.hWnd 207 | .ShowDialog 208 | 209 | Label5.Caption = .ResultInput 210 | If .ResultMain = TD_OK Then 211 | Label1.Caption = "Yes Yes Yes!" 212 | Else 213 | Label1.Caption = "Cancelled." 214 | End If 215 | End With 216 | 217 | End Sub 218 | 219 | Private Sub Command16_Click() 220 | Dim hIcon1 As LongPtr, hIcon2 As LongPtr 221 | ' hIcon1 = ResIconToHICON("ICO_CLOCK", 32, 32) 222 | ' 'hIcon2 = ResIconToHICON("ICO_HEART", 32, 32) 223 | ' hIcon2 = ResIconToHICON("ICO_HEART", 32, 32) 224 | hIcon1 = LoadImageA(0, App.Path & "\ICO_CLOCK.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE) 225 | hIcon2 = LoadImageA(0, App.Path & "\ICO_HEART.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE) 226 | With TaskDialog1 227 | .Init 228 | .MainInstruction = "Look at the pretty icons." 229 | .IconMain = TD_SHIELD_GRADIENT_ICON 230 | .Title = "cTaskDialog Project" 231 | ' .Flags = TDF_USE_COMMAND_LINKS_NO_ICON 232 | .CommonButtons = TDCBF_CLOSE_BUTTON Or TDCBF_NO_BUTTON 233 | .AddCustomButton 103, "Button 1", hIcon2 234 | .AddCustomButton 102, "Button 2" 235 | .SetCommonButtonIcon TDCBF_NO_BUTTON, hIcon1 236 | .ShowDialog 237 | Call DestroyIcon(hIcon1) 238 | 239 | Label1.Caption = "ID of button clicked: " & .ResultMain 240 | End With 241 | End Sub 242 | 243 | Private Sub Command17_Click() 244 | 245 | With TaskDialog1 246 | .Init 247 | .Content = "Something somesuch hows-it what-eva" '& vbCrLf & vbCrLf & vbCrLf & vbCrLf 248 | .Flags = TDF_INPUT_BOX Or TDF_USE_COMMAND_LINKS 'Or TDF_EXPAND_FOOTER_AREA 249 | .InputAlign = TDIBA_Footer 250 | .AddCustomButton 101, "Test" & vbLf & "blah" 251 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 252 | ' .IconFooter = TD_INFORMATION_ICON 253 | .VerifyText = "Check mate" 254 | .ExpandedControlText = "Gimme some more" 255 | .ExpandedInfo = "Here you are sir." 256 | .Title = "cTaskDialog Project" 257 | .Footer = "$input" 258 | .IconFooter = TD_INFORMATION_ICON 259 | .ParenthWnd = Me.hWnd 260 | .ShowDialog 261 | 262 | Label5.Caption = .ResultInput 263 | If .ResultMain = TD_OK Then 264 | Label1.Caption = "Yes Yes Yes!" 265 | Else 266 | Label1.Caption = "Cancelled." 267 | End If 268 | End With 269 | End Sub 270 | 271 | Private Sub Command18_Click() 272 | Set TaskDialogPW = New cTaskDialog 273 | With TaskDialogPW 274 | .Init 275 | .MainInstruction = "Authorization Required" 276 | .Content = "The password is: password" 277 | .Flags = TDF_INPUT_BOX 278 | .InputIsPassword = True 279 | .InputAlign = TDIBA_Buttons 280 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 281 | .SetButtonElevated TD_OK, 1 282 | .SetButtonHold TD_OK 283 | .Footer = "Enter your password then press OK to continue." 284 | .IconFooter = TD_INFORMATION_ICON 285 | .IconMain = TD_SHIELD_ERROR_ICON 286 | .Title = "cTaskDialog Project" 287 | .ParenthWnd = Me.hWnd 288 | .ShowDialog 289 | 290 | Label5.Caption = .ResultInput 291 | If .ResultMain = TD_OK Then 292 | Label1.Caption = "Got correct PW!" 293 | Else 294 | Label1.Caption = "Cancelled." 295 | End If 296 | End With 297 | End Sub 298 | 299 | Private Sub Command19_Click() 300 | With TaskDialog1 301 | .Init 302 | .MainInstruction = "Duplicates" 303 | .Content = "If you want to exclude an Artists name from the search:" '& vbCrLf & vbCrLf 304 | .Flags = TDF_INPUT_BOX Or TDF_VERIFICATION_FLAG_CHECKED 305 | .AddCustomButton 100, "Continue" 306 | .CommonButtons = TDCBF_CANCEL_BUTTON 307 | .IconMain = TD_INFORMATION_ICON 308 | .Title = "cTaskDialog Project" 309 | .InputText = "Enter Artist name here." 310 | .VerifyText = "Exclude Jingles" 311 | .ParenthWnd = Me.hWnd 312 | .ShowDialog 313 | 314 | Label5.Caption = .ResultInput 315 | If .ResultMain = 100 Then 316 | Label1.Caption = "Yes Yes Yes!" 317 | Else 318 | Label1.Caption = "Cancelled." 319 | End If 320 | End With 321 | 322 | 323 | 324 | End Sub 325 | 326 | Private Sub Command2_Click() 327 | Set TaskDialog1 = New cTaskDialog 328 | With TaskDialog1 329 | .Content = "Message text" 330 | .CommonButtons = TDCBF_ABORT_BUTTON Or TDCBF_IGNORE_BUTTON Or TDCBF_TRYAGAIN_BUTTON Or TDCBF_CONTINUE_BUTTON Or TDCBF_HELP_BUTTON 331 | .Flags = TDF_POSITION_RELATIVE_TO_WINDOW Or TDF_CAN_BE_MINIMIZED Or TDF_ALLOW_DIALOG_CANCELLATION 332 | '.ParenthWnd = Me.hWnd 333 | .ShowDialog 334 | 'If .ResultMain = TD_OK Then 335 | Debug.Print "You clicked " & .ResultMain 336 | 'Else 337 | ' Debug.Print "Canceled." 338 | 'End If 339 | End With 340 | ' With TaskDialog1 341 | ' .Init 342 | ' .MainInstruction = "test" 343 | ' ' .Flags = TDF_CAN_BE_MINIMIZED 'TDF_KILL_SHIELD_ICON 344 | ' ' .Flags = TDF_ALLOW_DIALOG_CANCELLATION 345 | ' .Content = "This is a simple dialog." 346 | ' .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_CLOSE_BUTTON Or TDF_ALLOW_DIALOG_CANCELLATION 'Or TDCBF_CANCEL_BUTTON 347 | ' .IconMain = IDI_ERROR 348 | ' .Title = "cTaskDialog Project" 349 | ' .ParenthWnd = Me.hWnd 350 | ' ' .hinst = 0 351 | ' .ShowDialog 352 | 353 | ' If .ResultMain = TD_YES Then 354 | ' Label1.Caption = "Yes Yes Yes!" 355 | ' ElseIf .ResultMain = TD_NO Then 356 | ' Label1.Caption = "Nope. No. Non. Nein." 357 | ' Else 358 | ' Label1.Caption = "Cancelled." 359 | ' End If 360 | ' End With 361 | End Sub 362 | Private Sub TaskDialog1_DialogCreated(ByVal hWnd As LongPtr) 363 | If bRunMarquee Then 364 | TaskDialog1.ProgressStartMarquee() 365 | End If 366 | End Sub 367 | Private Sub Command20_Click() 368 | With TaskDialog1 369 | .Init 370 | .MainInstruction = "Input Required" 371 | .Content = "Tell me what I want to know!" & vbCrLf & vbCrLf 372 | .Flags = TDF_INPUT_BOX 373 | .InputAlign = TDIBA_Buttons 374 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 375 | .IconMain = TD_INFORMATION_ICON 376 | .Title = "cTaskDialog Project" 377 | .ParenthWnd = Me.hWnd 378 | .ShowDialog 379 | 380 | Label5.Caption = .ResultInput 381 | If .ResultMain = TD_OK Then 382 | Label1.Caption = "Yes Yes Yes!" 383 | Else 384 | Label1.Caption = "Cancelled." 385 | End If 386 | End With 387 | End Sub 388 | 389 | Private Sub Command21_Click() 390 | With TaskDialog1 391 | .Init 392 | .MainInstruction = "You're about to do something stupid." 393 | .Content = "First, tell me why?" 394 | .IconMain = TD_INFORMATION_ICON 395 | .Title = "cTaskDialog Project" 396 | .Flags = TDF_USE_COMMAND_LINKS Or TDF_INPUT_BOX 397 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here." 398 | .AddCustomButton 102, "NEVER!!!" 399 | .AddCustomButton 103, "I dunno?" 400 | 401 | .ShowDialog 402 | 403 | Label5.Caption = .ResultInput 404 | Label1.Caption = "ID of button clicked: " & .ResultMain 405 | End With 406 | End Sub 407 | 408 | Private Sub Command22_Click() 409 | With TaskDialog1 410 | .Init 411 | .MainInstruction = "Sliding on down" 412 | .Content = "Pick a number" '& vbCrLf & vbCrLf 413 | .Flags = TDF_SLIDER Or TDF_INPUT_BOX ' Or TDF_EXPANDED_BY_DEFAULTTDF_EXPAND_FOOTER_AREA Or 414 | .SliderAlign = TDIBA_Buttons 415 | .Footer = "$input" 416 | .InputAlign = TDIBA_Footer 417 | .InputWidth = -1 418 | .IconFooter = TD_INFORMATION_ICON 419 | ' .ExpandedControlText = "Show more" 420 | ' .ExpandedInfo = "Line1" 421 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 422 | .IconMain = TD_INFORMATION_ICON 423 | .Title = "cTaskDialog Project" 424 | .ParenthWnd = Me.hWnd 425 | .ShowDialog 426 | 427 | Label15.Caption = .ResultSlider 428 | If .ResultMain = TD_OK Then 429 | Label1.Caption = "Yes Yes Yes!" 430 | Else 431 | Label1.Caption = "Cancelled." 432 | End If 433 | End With 434 | End Sub 435 | 436 | Private Sub Command23_Click() 437 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 438 | With TaskDialog3 439 | .Init 440 | .MainInstruction = "Duplicates" 441 | .Content = "If you want to exclude an Artists name from the search:" 442 | .Flags = TDF_VERIFICATION_FLAG_CHECKED Or TDF_COMBO_BOX 'Or TDF_INPUT_BOX 443 | ' .InputAlign = TDIBA_Footer 444 | .AddCustomButton 100, "Continue" 445 | .CommonButtons = TDCBF_CANCEL_BUTTON 446 | .IconMain = TD_SHIELD_ICON 447 | .Title = "cTaskDialog Project" 448 | .ComboCueBanner = "Cue Banner Text" 449 | .ComboSetInitialState "", 5 450 | ' .ComboSetInitialItem 1 451 | .ComboImageList = himlSys 452 | .ComboAddItem "Item 1", 6 453 | .ComboAddItem "Item 2", 7 454 | .ComboAddItem "Item 3", 8 455 | .VerifyText = "Exclude Jingles" 456 | .ParenthWnd = Me.hWnd 457 | .ShowDialog 458 | 459 | Label3.Caption = "Checked? " & .ResultVerify 460 | Label7.Caption = .ResultComboText 461 | Label9.Caption = .ResultComboIndex 462 | If .ResultMain = 100 Then 463 | Label1.Caption = "Continue!" 464 | Else 465 | Label1.Caption = "Cancelled." 466 | End If 467 | End With 468 | End Sub 469 | 470 | Private Sub Command24_Click() 471 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 472 | With TaskDialog1 473 | .Init 474 | .MainInstruction = "Making a list..." 475 | .Content = "...and checking it twice" & vbCrLf & vbCrLf 476 | .Flags = TDF_COMBO_BOX 477 | .ComboStyle = cbtDropdownList 478 | .AddCustomButton 100, "Continue" 479 | .CommonButtons = TDCBF_CANCEL_BUTTON 480 | .IconMain = TD_INFORMATION_ICON 481 | .Title = "cTaskDialog Project" 482 | .ComboSetInitialItem 0 483 | .ComboImageList = himlSys 484 | .ComboAddItem "Item 1", 6 485 | .ComboAddItem "Item 2", 7 486 | .ComboAddItem "Item 3", 8 487 | ' .Footer = "Have you been naughty or nice?" 488 | ' .IconFooter = IDI_QUESTION 489 | .ParenthWnd = Me.hWnd 490 | .ShowDialog 491 | 492 | Label7.Caption = .ResultComboText 493 | Label9.Caption = .ResultComboIndex 494 | If .ResultMain = 100 Then 495 | Label1.Caption = "Yes Yes Yes!" 496 | Else 497 | Label1.Caption = "Cancelled." 498 | End If 499 | End With 500 | 501 | End Sub 502 | 503 | Private Sub Command25_Click() 504 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 505 | Set TaskDialogPW2 = New cTaskDialog 506 | With TaskDialogPW2 507 | .Init 508 | .MainInstruction = "Authorization Required" 509 | .Content = "The password is: 'password' + user number, e.g. password1" '& vbCrLf & vbCrLf 510 | .Flags = TDF_INPUT_BOX Or TDF_COMBO_BOX 511 | .ComboStyle = cbtDropdownList 512 | .InputIsPassword = True 513 | .InputAlign = TDIBA_Buttons 514 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 515 | .SetButtonElevated TD_OK, 1 516 | .SetButtonHold TD_OK 517 | .ComboAlign = TDIBA_Content 518 | .ComboSetInitialItem 0 519 | .ComboImageList = himlSys 520 | .ComboAddItem "User 1", 6 521 | .ComboAddItem "User 2", 7 522 | .ComboAddItem "User 3", 8 523 | .Footer = "Enter your password then press OK to continue." 524 | .IconFooter = TD_INFORMATION_ICON 525 | .IconMain = TD_SHIELD_ERROR_ICON 526 | .Title = "cTaskDialog Project" 527 | .ParenthWnd = Me.hWnd 528 | .ShowDialog 529 | 530 | Label5.Caption = .ResultInput 531 | Label9.Caption = .ResultComboIndex 532 | If .ResultMain = TD_YES Then 533 | Label1.Caption = "Yes Yes Yes!" 534 | Else 535 | Label1.Caption = "Cancelled." 536 | End If 537 | End With 538 | End Sub 539 | 540 | Private Sub Command26_Click() 541 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 542 | Set TaskDialogPW2 = New cTaskDialog 543 | With TaskDialogPW2 544 | .Init 545 | .MainInstruction = "Authorization Required" 546 | .Content = "Select a user and password." & vbCrLf & "The password is: 'password' + user number, e.g. password1" 547 | .Flags = TDF_INPUT_BOX Or TDF_COMBO_BOX 548 | .InputIsPassword = True 549 | .InputAlign = TDIBA_Footer 550 | .InputWidth = -1 551 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON Or TDCBF_RETRY_BUTTON 552 | .SetButtonElevated TD_OK, 1 553 | .SetButtonHold TD_OK 554 | .ComboSetInitialItem 0 555 | .ComboAlign = TDIBA_Buttons 556 | .ComboImageList = himlSys 557 | .ComboStyle = cbtDropdownList 558 | .ComboAddItem "User 1", 6 559 | .ComboAddItem "User 2", 7 560 | .ComboAddItem "User 3", 8 561 | .Footer = "$input" 562 | .IconFooter = TD_INFORMATION_ICON 563 | .IconMain = TD_SHIELD_ERROR_ICON 564 | .Title = "cTaskDialog Project" 565 | .ParenthWnd = Me.hWnd 566 | .ShowDialog 567 | 568 | Label5.Caption = .ResultInput 569 | Label9.Caption = .ResultComboIndex 570 | If .ResultMain = TD_YES Then 571 | Label1.Caption = "Yes Yes Yes!" 572 | Else 573 | Label1.Caption = "Cancelled." 574 | End If 575 | End With 576 | End Sub 577 | 578 | Private Sub Command27_Click() 579 | With TaskDialog1 580 | .Init 581 | .MainInstruction = "Hello World" 582 | .Content = "Pick a day, any day" 583 | .Flags = TDF_DATETIME 584 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 585 | .IconMain = TD_INFORMATION_ICON 586 | .Title = "cTaskDialog Project" 587 | .ParenthWnd = Me.hWnd 588 | .ShowDialog 589 | 590 | Label11.Caption = .ResultDateTime 591 | If .ResultMain = TD_OK Then 592 | Label1.Caption = "Yes Yes Yes!" 593 | Else 594 | Label1.Caption = "Cancelled." 595 | End If 596 | End With 597 | End Sub 598 | 599 | Private Sub Command28_Click() 600 | With TaskDialog1 601 | .Init 602 | .MainInstruction = "Hello World" 603 | .Content = "Yo u got the time bro?" '& vbCrLf & vbCrLf 604 | .Flags = TDF_DATETIME 605 | .DateTimeType = dttTime 606 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 607 | .IconMain = TD_INFORMATION_ICON 608 | .Title = "cTaskDialog Project" 609 | .ParenthWnd = Me.hWnd 610 | .ShowDialog 611 | 612 | Label11.Caption = .ResultDateTime 613 | If .ResultMain = TD_OK Then 614 | Label1.Caption = "Yes Yes Yes!" 615 | Else 616 | Label1.Caption = "Cancelled." 617 | End If 618 | End With 619 | 620 | End Sub 621 | 622 | Private Sub Command29_Click() 623 | With TaskDialog1 624 | .Init 625 | .MainInstruction = "Hello World" 626 | .Content = "Hey when u wanna do dis?" '& vbCrLf & vbCrLf 627 | .Flags = TDF_DATETIME 628 | .DateTimeType = dttDateWithCheck 629 | .DateTimeAlign = TDIBA_Footer 630 | .IconFooter = TD_INFORMATION_ICON 631 | .Footer = "$input" 632 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 633 | .IconMain = TD_INFORMATION_ICON 634 | .Title = "cTaskDialog Project" 635 | .ParenthWnd = Me.hWnd 636 | .ShowDialog 637 | 638 | Label11.Caption = .ResultDateTime 639 | Label13.Caption = .ResultDateTimeChecked 640 | If .ResultMain = TD_OK Then 641 | Label1.Caption = "Yes Yes Yes!" 642 | Else 643 | Label1.Caption = "Cancelled." 644 | End If 645 | End With 646 | End Sub 647 | 648 | Private Sub Command3_Click() 649 | With TaskDialog1 650 | .Init 651 | .MainInstruction = "You're about to do something stupid." 652 | .Content = "Are you absolutely sure you want to continue with this really bad idea?" 653 | .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON 654 | .IconMain = TD_SHIELD_WARNING_ICON 'TD_INFORMATION_ICON 655 | .Title = "cTaskDialog Project" 656 | 657 | .ShowDialog 658 | 659 | If .ResultMain = TD_YES Then 660 | Label1.Caption = "Yes Yes Yes!" 661 | ElseIf .ResultMain = TD_NO Then 662 | Label1.Caption = "Nope. No. Non. Nein." 663 | Else 664 | Label1.Caption = "Cancelled." 665 | End If 666 | End With 667 | End Sub 668 | 669 | Private Sub Command30_Click() 670 | With TaskDialog1 671 | .Init 672 | .MainInstruction = "Hello World" 673 | .Content = "Pick a day, any day" 674 | .Flags = TDF_DATETIME Or TDF_USE_COMMAND_LINKS 675 | .AddCustomButton 100, "CmdLnk" 676 | .DateTimeType = dttDateTime 677 | ' .DateTimeAlign = TDIBA_Buttons 678 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 679 | .IconMain = TD_INFORMATION_ICON 680 | .Title = "cTaskDialog Project" 681 | .ParenthWnd = Me.hWnd 682 | .ShowDialog 683 | 684 | Label11.Caption = .ResultDateTime 685 | If .ResultMain = TD_OK Then 686 | Label1.Caption = "Yes Yes Yes!" 687 | Else 688 | Label1.Caption = "Cancelled." 689 | End If 690 | End With 691 | End Sub 692 | 693 | Private Sub Command31_Click() 694 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 695 | With TaskDialog1 696 | .Init 697 | .MainInstruction = "Schedule Event" 698 | .Content = "Pick action to schedule:" '& vbCrLf & vbCrLf 699 | .Flags = TDF_DATETIME Or TDF_COMBO_BOX 'Or TDF_USE_COMMAND_LINKS 700 | '.AddCustomButton 101, "CommandL" 701 | .DateTimeType = dttDateTime 702 | .DateTimeAlign = TDIBA_Buttons 703 | .Width = 200 * .DPIScaleX 704 | .ComboStyle = cbtDropdownList 705 | .ComboSetInitialItem 0 706 | .ComboImageList = himlSys 707 | .ComboAddItem "Do One Thing", 6 708 | .ComboAddItem "Do Something Else", 7 709 | .ComboAddItem "Run and hide", 8 710 | .ComboAlign = TDIBA_Content 711 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 712 | .VerifyText = "Verify" 713 | .Footer = "Some reminder about these actions." 714 | .IconMain = TD_SHIELD_ICON 715 | .IconFooter = TD_INFORMATION_ICON 716 | .Title = "cTaskDialog Project" 717 | .ParenthWnd = Me.hWnd 718 | .ShowDialog 719 | Label7.Caption = .ResultComboText 720 | Label9.Caption = .ResultComboIndex 721 | Label11.Caption = .ResultDateTime 722 | If .ResultMain = TD_OK Then 723 | Label1.Caption = "Yes Yes Yes!" 724 | Else 725 | Label1.Caption = "Cancelled." 726 | End If 727 | End With 728 | End Sub 729 | 730 | Private Sub AddCbxItems(cdg As cTaskDialog) 731 | 732 | End Sub 733 | Private Sub Command32_Click() 734 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 735 | Dim hIconF As LongPtr 736 | hIconF = IconToHICON(LoadResData("ICO_CLIP", "CUSTOM"), 16, 16) 737 | Dim hBmp As LongPtr 738 | Dim sImg As String 739 | sImg = App.Path & "\vbf.jpg" 740 | Dim CX As Long, CY As Long 741 | hBmp = hBitmapFromFile(sImg, CX, CY) 742 | With TaskDialog1 743 | .Init 744 | .MainInstruction = "Perform Event" 745 | .Content = "Pick action to perform. You can schedule execution for later or enter a custom label below." 746 | .Flags = TDF_USE_COMMAND_LINKS Or TDF_COMBO_BOX Or TDF_DATETIME Or TDF_USE_HICON_FOOTER Or TDF_USE_SHELL32_ICONID Or TDF_KILL_SHIELD_ICON Or TDF_CAN_BE_MINIMIZED 747 | ' .ExpandedControlText = "Expando ABCDEFGHIJKL" Or TDF_INPUT_BOX 748 | ' .ExpandedInfo = "Test" 749 | .DateTimeType = dttDateTimeWithCheckTimeOnly 750 | .DateTimeAlign = TDIBA_Buttons 751 | .DateTimeAlignInButtons = tdcaRight 752 | .ComboAlign = TDIBA_Content 753 | .ComboStyle = cbtDropdownList 754 | .ComboSetInitialItem 1 755 | .ComboImageList = himlSys 756 | .ComboAddItem "Do Thing #1", 2 757 | .ComboAddItem "Do Thing #2", 7 758 | .ComboAddItem "Do Thing #3", 8 759 | .CommonButtons = TDCBF_CANCEL_BUTTON Or TDCBF_OK_BUTTON 'Or TDCBF_CLOSE_BUTTON Or TDCBF_OK_BUTTON 760 | ' .InputText = "New Event 1" 761 | ' .InputAlign = TDIBA_Buttons 762 | ' .InputWidth = 140 763 | ' .InputAlignInFooter = tdcaCenter 764 | .Footer = "Now you can say something else here." 765 | ' .VerifyText = "Perform event later:" 766 | .IconMain = TD_SHIELD_GRADIENT_ICON 767 | .IconFooter = hIconF 768 | .IconReplaceGradient = 276 769 | .Title = "cTaskDialog Project" 770 | ' .ParenthWnd = Me.hwnd 771 | .AddCustomButton 102, "Schedule" & vbLf & "Additional information here." 772 | .AddRadioButton 110, "Apply to this account only." 773 | .AddRadioButton 111, "Apply to all accounts." 774 | .SetLogoImage hBmp, LogoBitmap, LogoTopRight, 0, 0 775 | .ShowDialog 776 | 777 | Label2.Caption = "Radio: " & .ResultRad 778 | Label5.Caption = .ResultInput 779 | Label7.Caption = .ResultComboText 780 | Label9.Caption = .ResultComboIndex 781 | Label11.Caption = .ResultDateTime 782 | If .ResultDateTimeChecked = 0 Then 783 | Label13.Caption = "Time unchecked." 784 | Else 785 | Label13.Caption = "Time checked." 786 | End If 787 | If .ResultMain = 102 Then 788 | Label1.Caption = "Scheduled." 789 | Else 790 | Label1.Caption = "Cancelled." 791 | End If 792 | End With 793 | DeleteObject hBmp 794 | End Sub 795 | 796 | Private Sub Command33_Click() 797 | Dim dTimeMin As Date, dTimeMax As Date 798 | 799 | dTimeMin = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(13, 0, 0) 800 | dTimeMax = DateAdd("d", 7, dTimeMin) 801 | dTimeMax = DateAdd("h", 4, dTimeMax) 802 | 803 | With TaskDialog1 804 | .Init 805 | .MainInstruction = "Date Ranges" 806 | .Content = "Pick a time, limited to sometime in the next 7 days, between 1pm and 6pm" 807 | .Flags = TDF_DATETIME Or TDF_INPUT_BOX Or TDF_USE_COMMAND_LINKS 808 | .DateTimeType = dttDateTime 809 | .DateTimeAlign = TDIBA_Content 810 | .DateTimeSetRange True, True, dTimeMin, dTimeMax 811 | .DateTimeSetInitial dTimeMin 812 | .InputAlign = TDIBA_Buttons 813 | .InputCueBanner = "Add an optional note to whatever." 814 | .AddCustomButton 101, "Set Date" & vbLf & "Apply this date and time to whatever it is you're doing." 815 | .CommonButtons = TDCBF_CANCEL_BUTTON 816 | .IconMain = TD_INFORMATION_ICON 817 | .Title = "cTaskDialog Project" 818 | .ParenthWnd = Me.hWnd 819 | .ShowDialog 820 | 821 | Label11.Caption = .ResultDateTime 822 | If .ResultMain = 101 Then 823 | Label1.Caption = "Date Set" 824 | Else 825 | Label1.Caption = "Cancelled." 826 | End If 827 | End With 828 | End Sub 829 | 830 | Private Sub Command34_Click() 831 | With TaskDialog1 832 | .Init 833 | .MainInstruction = "Sup" 834 | .Content = "Note that if you want date/time in the buttons, there may not be enough room depending on number of buttons and whether there's checkboxes. This examples manually sets the width because they'd be truncated otherwise." '& vbCrLf & vbCrLf 835 | .Flags = TDF_DATETIME 836 | .DateTimeType = dttDateTimeWithCheck 'TimeOnly 837 | .DateTimeAlign = TDIBA_Buttons 838 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 839 | .IconMain = TD_INFORMATION_ICON 840 | .Title = "cTaskDialog Project" 841 | .ParenthWnd = Me.hWnd 842 | .Width = 300 843 | .ShowDialog 844 | 845 | Label11.Caption = .ResultDateTime 846 | Select Case .ResultDateTimeChecked 847 | Case 0: Label13.Caption = "Neither box checked." 848 | Case 2: Label13.Caption = "Time checked, date unchecked." 849 | Case 3: Label13.Caption = "Date checked, time unchecked." 850 | Case 4: Label13.Caption = "Both checked." 851 | End Select 852 | If .ResultMain = TD_OK Then 853 | Label1.Caption = "Yes Yes Yes!" 854 | Else 855 | Label1.Caption = "Cancelled." 856 | End If 857 | End With 858 | End Sub 859 | 860 | Private Sub Command35_Click() 861 | With TaskDialog1 862 | .Init 863 | .MainInstruction = "Sliding on down" 864 | .Content = "Pick a number" 865 | .Flags = TDF_SLIDER Or TDF_USE_COMMAND_LINKS 866 | .SliderSetRange 0, 100, 10 867 | .SliderSetChangeValues 10, 20 868 | .SliderTickStyle = SldTickStyleBoth 869 | .SliderValue = 50 870 | .SliderAlign = TDIBA_Content 871 | .ExpandedControlText = "ExpandMe" 872 | .ExpandedInfo = "Expanded" 873 | .AddCustomButton 100, "CommandLink" 874 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 875 | .IconMain = TD_INFORMATION_ICON 876 | .Title = "cTaskDialog Project" 877 | .ParenthWnd = Me.hWnd 878 | .ShowDialog 879 | 880 | Label15.Caption = .ResultSlider 881 | If .ResultMain = TD_OK Then 882 | Label1.Caption = "Yes Yes Yes!" 883 | Else 884 | Label1.Caption = "Cancelled." 885 | End If 886 | End With 887 | End Sub 888 | 889 | Private Sub Command36_Click() 890 | With TaskDialog1 891 | .Init 892 | .MainInstruction = "Hello World" 893 | .Content = "Input Required" 894 | .Flags = TDF_INPUT_BOX Or TDF_EXPAND_FOOTER_AREA Or TDF_EXPANDED_BY_DEFAULT ' Or TDF_SHOW_PROGRESS_BAROr TDF_USE_COMMAND_LINKS ' 895 | ' .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 896 | ' .AddCustomButton 102, "CommandLink2" 897 | .AddRadioButton 103, "Radio 1" 898 | .AddRadioButton 104, "Radio 2" 899 | .ExpandedControlText = "Expando" 900 | .ExpandedInfo = "Expanded information." 901 | ' .VerifyText = "Verification check." 902 | .InputAlign = TDIBA_Footer 903 | ' .InputAlignInFooter = tdcaCenter 904 | 905 | ' .InputWidth = 100 906 | ' .Footer = "$input" 907 | .IconFooter = TD_INFORMATION_ICON 908 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 'Or TDCBF_RETRY_BUTTON Or TDCBF_CLOSE_BUTTON 909 | .IconMain = TD_INFORMATION_ICON 910 | .Title = "cTaskDialog Project" 911 | .ParenthWnd = Me.hWnd 912 | .ShowDialog 913 | 914 | Label5.Caption = .ResultInput 915 | If .ResultMain = TD_OK Then 916 | Label1.Caption = "Yes Yes Yes!" 917 | Else 918 | Label1.Caption = "Cancelled." 919 | End If 920 | End With 921 | End Sub 922 | 923 | Private Sub Command37_Click() 924 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 925 | With TaskDialog3 926 | .Init 927 | .MainInstruction = "Main Instruct" 928 | .Content = "Content goes here." 929 | .Flags = TDF_COMBO_BOX Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_MARQUEE_PROGRESS_BAR 'Or TDF_EXPANDED_BY_DEFAULT Or TDF_EXPAND_FOOTER_AREA ' 930 | .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON 931 | .IconMain = TD_SHIELD_ICON 932 | .Title = "cTaskDialog Project" 933 | .ComboCueBanner = "Cue Banner Text" 934 | .ComboSetInitialState "", 5 935 | .ComboAlign = TDIBA_Footer 936 | ' .ComboAlignInFooter = tdcaCenter 937 | ' .ComboSetInitialItem 1 938 | .ComboImageList = himlSys 939 | ' .ComboStyle = cbtDropdownList 940 | .ComboAddItem "Item 1", 6 941 | .ComboAddItem "Item 2", 7 942 | .ComboAddItem "Item 3", 8 943 | .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 944 | .AddCustomButton 102, "CommandLink2" 945 | ' .AddRadioButton 103, "Radio 1" 946 | ' .AddRadioButton 104, "Radio 2" 947 | .ExpandedControlText = "Expando" 948 | .ExpandedInfo = "Expanded information." 949 | .VerifyText = "Verification check." 950 | .IconFooter = TD_ERROR_ICON 951 | .ParenthWnd = Me.hWnd 952 | .ShowDialog 953 | 954 | Label7.Caption = .ResultComboText 955 | Label9.Caption = .ResultComboIndex 956 | If .ResultMain = 100 Then 957 | Label1.Caption = "Yes Yes Yes!" 958 | Else 959 | Label1.Caption = "Cancelled." 960 | End If 961 | End With 962 | End Sub 963 | 964 | Private Sub Command38_Click() 965 | With TaskDialog1 966 | .Init 967 | ' .MainInstruction = "Hello World" 968 | .Content = "Pick a day, any day." 969 | .Flags = TDF_DATETIME Or TDF_EXPANDED_BY_DEFAULT Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_EXPANDED_BY_DEFAULT 'TDF_EXPAND_FOOTER_AREA ' 970 | .DateTimeType = dttDateTimeWithCheckTimeOnly 971 | .DateTimeAlign = TDIBA_Footer 972 | .DateTimeAlignInFooter = tdcaRight 973 | .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 974 | .AddCustomButton 102, "CommandLink2" 975 | .AddRadioButton 103, "Radio 1" 976 | .AddRadioButton 104, "Radio 2" 977 | .ExpandedControlText = "Expando blah blah" 978 | .ExpandedInfo = "Expanded information." 979 | ' .VerifyText = "Verification check.sggsgdggggggg" 980 | 981 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 982 | .IconMain = TD_INFORMATION_ICON 983 | .IconFooter = TD_ERROR_ICON 984 | .Title = "cTaskDialog Project" 985 | .ParenthWnd = Me.hWnd 986 | .ShowDialog 987 | 988 | Label11.Caption = .ResultDateTime 989 | If .ResultMain = TD_OK Then 990 | Label1.Caption = "Yes Yes Yes!" 991 | Else 992 | Label1.Caption = "Cancelled." 993 | End If 994 | End With 995 | End Sub 996 | 997 | Private Sub Command39_Click() 998 | With TaskDialog1 999 | .Init 1000 | .MainInstruction = "Sliding on down" 1001 | .Content = "Pick a number" 1002 | .Flags = TDF_SLIDER Or TDF_USE_COMMAND_LINKS Or TDF_EXPANDED_BY_DEFAULT ' Or TDF_EXPAND_FOOTER_AREA TDF_SHOW_MARQUEE_PROGRESS_BAR Or 1003 | ' .SliderTickStyle = SldTickStyleBoth 1004 | ' .SliderAlign = TDIBA_Footer 1005 | .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 1006 | .AddCustomButton 102, "CommandLink2" 1007 | ' .AddRadioButton 103, "Radio 1" 1008 | ' .AddRadioButton 104, "Radio 2" 1009 | .ExpandedControlText = "Expando" 1010 | .ExpandedInfo = "Expanded information." 1011 | ' .VerifyText = "Verification check." 1012 | .IconFooter = TD_INFORMATION_ICON 1013 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 1014 | .IconMain = TD_INFORMATION_ICON 1015 | .Title = "cTaskDialog Project" 1016 | .ParenthWnd = Me.hWnd 1017 | .ShowDialog 1018 | 1019 | Label15.Caption = .ResultSlider 1020 | If .ResultMain = TD_OK Then 1021 | Label1.Caption = "Yes Yes Yes!" 1022 | Else 1023 | Label1.Caption = "Cancelled." 1024 | End If 1025 | End With 1026 | 1027 | End Sub 1028 | 1029 | Private Sub Command4_Click() 1030 | With TaskDialog1 1031 | .Init 1032 | .MainInstruction = "You're about to do something stupid." 1033 | .Content = "Are you absolutely sure you want to continue with this really bad idea?" 1034 | .IconMain = TD_ERROR_ICON 1035 | .Title = "cTaskDialog Project" 1036 | .AddCustomButton 101, "YeeHaw!" 1037 | .AddCustomButton 102, "NEVER!!!" 1038 | .AddCustomButton 103, "I dunno?" 1039 | 1040 | .ShowDialog 1041 | 1042 | Label1.Caption = "ID of button clicked: " & .ResultMain 1043 | End With 1044 | End Sub 1045 | 1046 | Private Sub Command40_Click() 1047 | Dim hIco16 As LongPtr 1048 | hIco16 = ResIconToHICON("ICO_HEART", 16, 16) 'IconToHICON(LoadResData("ICO_CLIP", "CUSTOM"), 16, 16) 1049 | Set TaskDialogSC = New cTaskDialog 1050 | With TaskDialogSC 1051 | .Init 1052 | .Flags = TDF_INPUT_BOX 'TDF_KILL_SHIELD_ICON 'Or TDF_USE_IMAGERES_ICONID 1053 | ' .CommonButtons = TDCBF_NO_BUTTON 1054 | .Title = "TestTitle" 1055 | .Content = "TestContent" 1056 | .ParenthWnd = Me.hWnd 1057 | .MainInstruction = "TestInstruction" 1058 | .IconMain = TD_INFORMATION_ICON 1059 | ' .AddCustomButton 122, "Button 1" 1060 | .AddCustomButton 123, "SuperButton ", hIco16 1061 | ' .AddCustomButton 124, "Button 3" 1062 | .SetSplitButton 123 1063 | .ShowDialog 1064 | Label1.Caption = .ResultMain 1065 | Label5.Caption = .ResultInput 1066 | 1067 | End With 1068 | 1069 | End Sub 1070 | 1071 | 1072 | 1073 | Private Sub Command41_Click() 1074 | Dim dTimeMin As Date, dTimeMax As Date 1075 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 1076 | 1077 | dTimeMin = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(13, 0, 0) 1078 | dTimeMax = DateAdd("d", 7, dTimeMin) 1079 | dTimeMax = DateAdd("h", 4, dTimeMax) 1080 | Dim hBmp As LongPtr 1081 | Dim sImg As String 1082 | Dim CX As Long, CY As Long 1083 | If TaskDialog1.DPIScaleX > 1 Then 1084 | sImg = App.Path & "\disc48.png" 1085 | Else 1086 | sImg = App.Path & "\disc32.png" 1087 | End If 1088 | hBmp = hBitmapFromFile(sImg, CX, CY) 1089 | ' hBmp = LoadImageW(0, StrPtr(simg), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE) 1090 | Debug.Print "hBmp=" & hBmp '& ",cx=" & cx & ",cy=" & cy 1091 | With TaskDialog1 1092 | .Init 1093 | .MainInstruction = "Set Action" 1094 | ' .Content = "Pick a time, limited to sometime in the next 7 days, between 1pm and 6pm" 1095 | .Content = "Execute this action now or choose a new time below." & vbCrLf & "For additional help: Microsoft on the web - MSDN on the web" 1096 | .Flags = TDF_DATETIME Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_INPUT_BOX Or TDF_KILL_SHIELD_ICON Or TDF_ENABLE_HYPERLINKS Or TDF_COMBO_BOX 'Or TDF_USE_COMMAND_LINKS 1097 | ' .AddRadioButton 501, "Radio 1" 1098 | ' .AddRadioButton 502, "Radio 2" 1099 | ' .ExpandedControlText = "ExpandMe!" 1100 | ' .ExpandedInfo = "blahdy blah blah" 1101 | .DateTimeType = dttDateTime 1102 | .DateTimeAlign = TDIBA_Footer 1103 | ' .DateTimeAlignInContent = tdcaCenter 1104 | .DateTimeAlignInFooter = tdcaRight 1105 | .DateTimeSetRange True, True, dTimeMin, dTimeMax 1106 | .DateTimeSetInitial dTimeMin 1107 | .InputAlign = TDIBA_Content 1108 | .InputCueBanner = "Add an optional note to whatever." 1109 | .ComboAlign = TDIBA_Buttons 1110 | .ComboCueBanner = "Cue Banner Text" 1111 | .ComboSetInitialState "", 5 1112 | ' .ComboSetInitialItem 2 1113 | .ComboImageList = himlSys 1114 | .ComboAddItem "Item 1", 6 1115 | .ComboAddItem "Item 2", 7 1116 | .ComboAddItem "Item 3", 8 1117 | .ComboWidth = -1 1118 | ' .DefaultButton = TD_CANCEL 1119 | ' .VerifyText = "Confirm something or another." 1120 | .IconFooter = TD_INFORMATION_ICON 1121 | .Footer = "Choose date and time:" 1122 | .AddCustomButton 101, "Set Date" ' & vbLf & "Apply this date and time to whatever it is you're doing." 1123 | .CommonButtons = TDCBF_CANCEL_BUTTON 1124 | .IconMain = TD_SHIELD_GRAY_ICON 1125 | ' .hinst = 0 1126 | ' .Footer = "Microsoft on the web" & _ 1127 | ' " - MSDN on the web" 1128 | .Title = "cTaskDialog Project" 1129 | .ParenthWnd = Me.hWnd 1130 | .SetLogoImage hBmp, LogoBitmap, LogoTopRight, 4, 4 'LogoButtons 1131 | bRunMarquee = True 1132 | .ShowDialog 1133 | bRunMarquee = False 1134 | 1135 | Label11.Caption = .ResultDateTime 1136 | If .ResultMain = 101 Then 1137 | Label1.Caption = "Date Set" 1138 | Else 1139 | Label1.Caption = "Cancelled." 1140 | End If 1141 | End With 1142 | Call DeleteObject(hBmp) 1143 | 1144 | End Sub 1145 | 1146 | Private Sub Command42_Click() 1147 | Dim dTimeMin As Date, dTimeMax As Date 1148 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 1149 | 1150 | dTimeMin = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(13, 0, 0) 1151 | dTimeMax = DateAdd("d", 7, dTimeMin) 1152 | dTimeMax = DateAdd("h", 4, dTimeMax) 1153 | Dim hBmp As LongPtr 1154 | Dim sImg As String 1155 | sImg = App.Path & "\vbf.jpg" 1156 | Dim CX As Long, CY As Long 1157 | hBmp = hBitmapFromFile(sImg, CX, CY) 1158 | ' hBmp = LoadImageW(0, StrPtr(simg), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE) 1159 | Debug.Print "hBmp=" & hBmp '& ",cx=" & cx & ",cy=" & cy 1160 | With TaskDialog1 1161 | .Init 1162 | .MainInstruction = "Set Action" 1163 | ' .Content = "Pick a time, limited to sometime in the next 7 days, between 1pm and 6pm" 1164 | .Content = "Execute this action now or choose a new time below." & vbCrLf & "For additional help: Microsoft on the web - MSDN on the web" 1165 | .Flags = TDF_DATETIME Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_INPUT_BOX Or TDF_ENABLE_HYPERLINKS ' Or TDF_COMBO_BOX 'Or TDF_USE_COMMAND_LINKS 1166 | ' .AddRadioButton 501, "Radio 1" 1167 | ' .AddRadioButton 502, "Radio 2" 1168 | ' .ExpandedControlText = "ExpandMe!" 1169 | ' .ExpandedInfo = "blahdy blah blah" 1170 | .DateTimeType = dttDateTime 1171 | .DateTimeAlign = TDIBA_Footer 1172 | ' .DateTimeAlignInContent = tdcaCenter 1173 | .DateTimeAlignInFooter = tdcaRight 1174 | .DateTimeSetRange True, True, dTimeMin, dTimeMax 1175 | .DateTimeSetInitial dTimeMin 1176 | .InputAlign = TDIBA_Content 1177 | .InputCueBanner = "Add an optional note to whatever." 1178 | .ComboAlign = TDIBA_Content 1179 | .ComboCueBanner = "Cue Banner Text" 1180 | .ComboSetInitialState "", 5 1181 | ' .ComboSetInitialItem 2 1182 | .ComboImageList = himlSys 1183 | .ComboAddItem "Item 1", 6 1184 | .ComboAddItem "Item 2", 7 1185 | .ComboAddItem "Item 3", 8 1186 | .ComboWidth = -1 1187 | ' .DefaultButton = TD_CANCEL 1188 | ' .VerifyText = "Confirm something or another." 1189 | .IconFooter = TD_INFORMATION_ICON 1190 | .Footer = "Choose date and time:" 1191 | .AddCustomButton 101, "Set Date" ' & vbLf & "Apply this date and time to whatever it is you're doing." 1192 | .CommonButtons = TDCBF_CANCEL_BUTTON 1193 | .IconMain = TD_ERROR_ICON 1194 | ' .hinst = 0 1195 | ' .Footer = "Microsoft on the web" & _ 1196 | ' " - MSDN on the web" 1197 | .Title = "cTaskDialog Project" 1198 | .ParenthWnd = Me.hWnd 1199 | .SetLogoImage hBmp, LogoBitmap, LogoButtons 1200 | bRunMarquee = True 1201 | .ShowDialog 1202 | bRunMarquee = False 1203 | 1204 | Label11.Caption = .ResultDateTime 1205 | If .ResultMain = 101 Then 1206 | Label1.Caption = "Date Set" 1207 | Else 1208 | Label1.Caption = "Cancelled." 1209 | End If 1210 | End With 1211 | Call DeleteObject(hBmp) 1212 | End Sub 1213 | 1214 | Private Sub Command43_Click() 1215 | Set TaskDialogMPX1 = New cTaskDialog 1216 | Set TaskDialogMPX2 = New cTaskDialog 1217 | Set TaskDialogMPX3 = New cTaskDialog 1218 | sMPLogin = "" 1219 | With TaskDialogMPX3 1220 | .Init 1221 | .PageIndex = 3 1222 | .MainInstruction = "dummy" 1223 | .Content = "We're now doing stuff..." 1224 | .CommonButtons = TDCBF_OK_BUTTON 1225 | .IconMain = TD_SHIELD_OK_ICON 1226 | .Flags = TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_USE_COMMAND_LINKS 1227 | .AddCustomButton 310, "Restart process" & vbLf & "Click to return to the previous page." 1228 | .SetButtonHold 310 1229 | .Title = "cTaskDialog Project - Page 3" 1230 | End With 1231 | With TaskDialogMPX2 1232 | .Init 1233 | .PageIndex = 2 1234 | .MainInstruction = "Log In" 1235 | .Content = "The password is: 'password' + user number, e.g. password1" '& vbCrLf & vbCrLf 1236 | .Flags = TDF_INPUT_BOX Or TDF_COMBO_BOX 1237 | .ComboStyle = cbtDropdownList 1238 | .InputIsPassword = True 1239 | .InputAlign = TDIBA_Buttons 1240 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 1241 | .SetButtonElevated TD_OK, 1 1242 | .SetButtonHold TD_OK 1243 | .ComboAlign = TDIBA_Content 1244 | .ComboSetInitialItem 0 1245 | If (himlSys = 0) Then himlSys = GetSystemImagelist(SHGFI_SMALLICON) 1246 | .ComboImageList = himlSys 1247 | .ComboAddItem "User 1", 6 1248 | .ComboAddItem "User 2", 7 1249 | .ComboAddItem "User 3", 8 1250 | .Footer = "Enter your password then press OK to continue." 1251 | .IconFooter = TD_INFORMATION_ICON 1252 | .IconMain = TD_SHIELD_GRAY_ICON 1253 | .Title = "cTaskDialog Project - Page 2" 1254 | .ParenthWnd = Me.hWnd 1255 | End With 1256 | With TaskDialogMPX1 1257 | .Init 1258 | .PageIndex = 1 1259 | .MainInstruction = "Mutli-page Testing" 1260 | .Content = "Choose how you want to proceed." 1261 | .Flags = TDF_USE_COMMAND_LINKS 1262 | .AddCustomButton 200, "Proceed anonymously" & vbLf & "Click here to continue without logging in." 1263 | .AddCustomButton 201, "Set log in information" & vbLf & "Select your username." 1264 | .CommonButtons = TDCBF_CANCEL_BUTTON 1265 | .IconMain = TD_SHIELD_ICON 1266 | .ParenthWnd = Me.hWnd 1267 | .SetButtonHold 200 1268 | .SetButtonHold 201 1269 | .Title = "cTaskDialog Project - Page 1" 1270 | bPageExampleEx = True 1271 | .ShowDialog 1272 | bPageExampleEx = False 1273 | Label1.Caption = .ResultMain 1274 | Label5.Caption = .ResultInput 1275 | Label17.Caption = .PageIndex 1276 | End With 1277 | Label1.Caption = TaskDialog1.ResultMain 1278 | End Sub 1279 | 1280 | Private Sub Command44_Click() 1281 | With TaskDialogAC 1282 | .Init 1283 | .MainInstruction = "Do you wish to do somethingsomesuch?" 1284 | .Flags = TDF_CALLBACK_TIMER Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_PROGRESS_BAR 1285 | .Content = "Execute it then, otherwise I'm gonna peace out." 1286 | .AddCustomButton 101, "Let's Go!" & vbLf & "Really, let's go." 1287 | .CommonButtons = TDCBF_CLOSE_BUTTON 1288 | .IconMain = IDI_QUESTION 1289 | .IconFooter = TD_ERROR_ICON 1290 | .Footer = "Closing in 15 seconds..." 1291 | .Title = "cTaskDialog Project" 1292 | .AutocloseTime = 15 'seconds 1293 | .ParenthWnd = Me.hWnd 1294 | ' .hinst = 0 1295 | .ShowDialog 1296 | 1297 | If .ResultMain = TD_YES Then 1298 | Label1.Caption = "Yes Yes Yes!" 1299 | ElseIf .ResultMain = TD_NO Then 1300 | Label1.Caption = "Nope. No. Non. Nein." 1301 | Else 1302 | Label1.Caption = "Cancelled." 1303 | End If 1304 | End With 1305 | End Sub 1306 | 1307 | Private Sub Command5_Click() 1308 | With TaskDialog1 1309 | .Init 1310 | .MainInstruction = "You're about to do something stupid." 1311 | .Content = "Are you absolutely sure you want to continue with this really bad idea? So just exactly how damn wide are you son of bitching bastards planning on making this before you get around to wrapping my text?" 1312 | .IconMain = TD_INFORMATION_ICON 1313 | .Title = "cTaskDialog Project" 1314 | .AddCustomButton 101, "YeeHaw!" 1315 | .AddCustomButton 102, "NEVER!!!" 1316 | .AddCustomButton 103, "I dunno?" 1317 | .AddRadioButton 110, "Let's do item 1" 1318 | .AddRadioButton 111, "Or maybe 2" 1319 | .AddRadioButton 112, "super secret option" 1320 | .Flags = TDF_SIZE_TO_CONTENT 1321 | .Width = 50 1322 | .ShowDialog 1323 | 1324 | Label1.Caption = "ID of button clicked: " & .ResultMain 1325 | Label2.Caption = "ID of radio button selected: " & .ResultRad 1326 | 1327 | End With 1328 | End Sub 1329 | 1330 | Private Sub Command6_Click() 1331 | With TaskDialog1 1332 | .Init 1333 | .MainInstruction = "Let's see some hyperlinking!" 1334 | .Content = "Where else to link to but Microsoft.com" 1335 | .IconMain = TD_INFORMATION_ICON 1336 | .Title = "cTaskDialog Project" 1337 | .CommonButtons = TDCBF_CLOSE_BUTTON 1338 | .Flags = TDF_ENABLE_HYPERLINKS 1339 | .ParenthWnd = Me.hWnd 1340 | .ShowDialog 1341 | 1342 | Label1.Caption = "ID of button clicked: " & .ResultMain 1343 | Label2.Caption = "ID of radio button selected: " & .ResultRad 1344 | 1345 | End With 1346 | End Sub 1347 | 1348 | Private Sub Command7_Click() 1349 | Dim hIconM As LongPtr, hIconF As LongPtr 1350 | hIconM = IconToHICON(LoadResData("ICO_CLIP", "CUSTOM"), 32, 32) 1351 | 'hIconM = ResIconToHICON("ICO_CLOCK", 32, 32) 1352 | hIconF = ResIconToHICON("ICO_HEART", 16, 16) 1353 | With TaskDialog1 1354 | .Init 1355 | .MainInstruction = "What time is it?" 1356 | .Content = "Is is party time yet???" 1357 | .Footer = "Don't you love TaskDialogIndirect?" 1358 | .Flags = TDF_USE_HICON_MAIN Or TDF_USE_HICON_FOOTER 1359 | .IconMain = hIconM 1360 | .IconFooter = hIconF 1361 | .Title = "cTaskDialog Project" 1362 | .CommonButtons = TDCBF_CLOSE_BUTTON 1363 | 1364 | .ShowDialog 1365 | 1366 | Label1.Caption = "ID of button clicked: " & .ResultMain 1367 | End With 1368 | Call DestroyIcon(hIconM) 1369 | Call DestroyIcon(hIconF) 1370 | 1371 | End Sub 1372 | 1373 | Private Sub Command8_Click() 1374 | With TaskDialog1 1375 | .Init 1376 | .MainInstruction = "Let's see all the basic fields." 1377 | .Content = "We can really fit in a lot of organized information now." 1378 | .Title = "cTaskDialog Project" 1379 | .Footer = "Have some footer text." 1380 | ' .CollapsedControlText = "Click here for some more info." 1381 | .ExpandedControlText = "Click again to hide that extra info." 1382 | .ExpandedInfo = "Here's some more info we don't really need." 1383 | .VerifyText = "Never ever show me this dialog again!" 1384 | 1385 | .IconMain = TD_INFORMATION_ICON 1386 | .IconFooter = TD_ERROR_ICON 1387 | 1388 | .ShowDialog 1389 | 1390 | Label1.Caption = "ID of button clicked: " & .ResultMain 1391 | Label2.Caption = "Box checked? " & .ResultVerify 1392 | End With 1393 | End Sub 1394 | 1395 | Private Sub Command9_Click() 1396 | 1397 | With TaskDialog1 1398 | .Init 1399 | .MainInstruction = "You're about to do something stupid." 1400 | .Content = "Are you absolutely sure you want to continue with this really bad idea?" 1401 | .IconMain = TD_INFORMATION_ICON 1402 | .Title = "cTaskDialog Project" 1403 | .CommonButtons = TDCBF_CANCEL_BUTTON 1404 | .Flags = TDF_USE_COMMAND_LINKS 1405 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here." 1406 | .AddCustomButton 102, "NEVER!!!" 1407 | .AddCustomButton 103, "I dunno?" 1408 | 1409 | .ShowDialog 1410 | 1411 | Label1.Caption = "ID of button clicked: " & .ResultMain 1412 | End With 1413 | End Sub 1414 | 1415 | Private Sub Form_Unload(Cancel As Integer) 1416 | Set TaskDialog1 = Nothing 1417 | Set TaskDialog2 = Nothing 1418 | FreeGDIPlus gdipInitToken 1419 | 1420 | End Sub 1421 | 1422 | 1423 | Private Sub TaskDialog1_ButtonClick(ByVal ButtonID As Long) 1424 | Debug.Print "TaskDialog1_ButtonClick " & ButtonID 1425 | If ButtonID = 200 Then 1426 | TaskDialog1.NavigatePage TaskDialog2 1427 | End If 1428 | End Sub 1429 | 1430 | 1431 | Private Sub TaskDialog1_ComboItemChanged(ByVal iNewItem As Long) 1432 | Debug.Print "ComboItmChg " & iNewItem 1433 | End Sub 1434 | 1435 | Private Sub TaskDialog1_DateTimeChange(ByVal dtNew As Date, ByVal lCheckStatus As Long) 1436 | Debug.Print "DateTimeChange " & dtNew 1437 | 1438 | End Sub 1439 | 1440 | Private Sub TaskDialog1_DialogDestroyed() 1441 | Timer1.Enabled = False 1442 | bRunProgress = False 1443 | End Sub 1444 | 1445 | Private Sub TaskDialog1_HyperlinkClick(ByVal lPtr As LongPtr) 1446 | 1447 | Call ShellExecuteW(0, 0, lPtr, 0, 0, SW_SHOWNORMAL) 1448 | 1449 | End Sub 1450 | Private Sub Form_Load() 1451 | gdipInitToken = InitGDIPlus 1452 | Set TaskDialog1 = New cTaskDialog 1453 | Set TaskDialog2 = New cTaskDialog 1454 | Set TaskDialog3 = New cTaskDialog 1455 | Set TaskDialogAC = New cTaskDialog 1456 | Set TaskDialogMPX1 = New cTaskDialog 1457 | Set TaskDialogMPX2 = New cTaskDialog 1458 | End Sub 1459 | 1460 | 1461 | 1462 | 1463 | Private Sub TaskDialog1_InputBoxChange(sText As String) 1464 | Debug.Print "InputChange=" & sText 1465 | End Sub 1466 | 1467 | 1468 | Private Sub TaskDialog1_SliderChange(ByVal lNewValue As Long) 1469 | Debug.Print "SliderChange=" & lNewValue 1470 | End Sub 1471 | 1472 | Private Sub TaskDialog1_Timer(ByVal TimerValue As Long) 1473 | 1474 | If lSecs > 60 Then 1475 | Timer1.Enabled = False 1476 | bRunProgress = False 1477 | Else 1478 | TaskDialog1.ProgressSetValue lSecs 1479 | TaskDialog1.Footer = "You've been thinking for " & lSecs & " seconds now..." 1480 | End If 1481 | 1482 | End Sub 1483 | 1484 | Private Sub TaskDialog1_VerificationClicked(ByVal Value As Long) 1485 | If Value = 1 Then 1486 | Timer1.Enabled = False 1487 | bRunProgress = False 1488 | Else 1489 | bRunProgress = True 1490 | Timer1.Enabled = True 1491 | End If 1492 | End Sub 1493 | 1494 | Private Sub TaskDialog2_ButtonClick(ByVal ButtonID As Long) 1495 | Debug.Print "TaskDialog2_ButtonClick " & ButtonID 1496 | 1497 | End Sub 1498 | 1499 | Private Sub TaskDialog2_DialogConstucted(ByVal hWnd As LongPtr) 1500 | Debug.Print "TaskDialog2_DialogConstucted" 1501 | 1502 | End Sub 1503 | 1504 | Private Sub TaskDialog2_DialogCreated(ByVal hWnd As LongPtr) 1505 | Debug.Print "TaskDialog2_DialogCreated" 1506 | 1507 | 1508 | End Sub 1509 | 1510 | Private Sub TaskDialog2_DropdownButtonClicked(ByVal hWnd As LongPtr) 1511 | Debug.Print "TD2 ButtonDropdown" 1512 | End Sub 1513 | 1514 | Private Sub TaskDialog2_InputBoxChange(sText As String) 1515 | Debug.Print "TD2 Input=" & sText 1516 | End Sub 1517 | 1518 | Private Sub TaskDialog3_DialogCreated(ByVal hWnd As LongPtr) 1519 | 'Call SendMessageW(TaskDialog3.hWndCombo, CB_SETDROPPEDWIDTH, 900&, ByVal 0&) 1520 | End Sub 1521 | 1522 | Private Sub TaskDialog3_InputBoxChange(sText As String) 1523 | Debug.Print "InputChange=" & sText 1524 | 1525 | End Sub 1526 | 1527 | Private Sub TaskDialogAC_DialogCreated(ByVal hWnd As LongPtr) 1528 | TaskDialogAC.ProgressSetRange 0, 15 1529 | TaskDialogAC.ProgressSetState ePBST_ERROR 1530 | End Sub 1531 | 1532 | Private Sub TaskDialogAC_Timer(ByVal TimerValue As Long) 1533 | On Error Resume Next 1534 | TaskDialogAC.Footer = "Closing in " & TaskDialogAC.AutocloseTime & " seconds..." 1535 | TaskDialogAC.ProgressSetValue 15 - TaskDialogAC.AutocloseTime 1536 | On Error GoTo 0 1537 | End Sub 1538 | 1539 | Private Sub TaskDialogMPX1_ButtonClick(ByVal ButtonID As Long) 1540 | Debug.Print "TaskDialogMPX1_ButtonClick id=" & ButtonID & ",page=" & TaskDialogMPX1.PageIndex 1541 | If bPageExampleEx Then 1542 | If TaskDialogMPX1.PageIndex = 1 Then 1543 | If ButtonID = 201 Then 1544 | TaskDialogMPX1.NavigatePage TaskDialogMPX2 1545 | ElseIf ButtonID = 200 Then 1546 | sMPLogin = "Anonymous" 1547 | TaskDialogMPX1.NavigatePage TaskDialogMPX3 1548 | End If 1549 | End If 1550 | End If 1551 | End Sub 1552 | 1553 | Private Sub TaskDialogPW_ButtonClick(ByVal ButtonID As Long) 1554 | Debug.Print "TaskDialogPW_ButtonClick " & ButtonID 1555 | If ButtonID = TD_OK Then 1556 | If TaskDialogPW.InputText = "password" Then 1557 | TaskDialogPW.CloseDialog 1558 | Else 1559 | MessageBeep MB_ERROR 1560 | TaskDialogPW.Footer = "Wrong password, please try again." 1561 | TaskDialogPW.IconFooter = TD_ERROR_ICON 1562 | End If 1563 | End If 1564 | End Sub 1565 | 1566 | Private Sub TaskDialogPW2_ButtonClick(ByVal ButtonID As Long) 1567 | Dim sPW As String 1568 | If ButtonID = TD_OK Then 1569 | Select Case TaskDialogPW2.ComboIndex 1570 | Case 0: sPW = "password1" 1571 | Case 1: sPW = "password2" 1572 | Case 2: sPW = "password3" 1573 | End Select 1574 | If TaskDialogPW2.InputText = sPW Then 1575 | TaskDialogPW2.CloseDialog 1576 | Else 1577 | MessageBeep MB_ERROR 1578 | TaskDialogPW2.Footer = "Wrong password, try again." 1579 | TaskDialogPW2.IconFooter = TD_ERROR_ICON 1580 | End If 1581 | End If 1582 | End Sub 1583 | 1584 | Private Sub TaskDialogSC_DropdownButtonClicked(ByVal hWnd As LongPtr) 1585 | Debug.Print "Got DropDown Button!" 1586 | End Sub 1587 | 1588 | Private Sub Timer1_Timer() 1589 | lSecs = lSecs + 1 1590 | End Sub 1591 | 1592 | Private Sub TaskDialogSC_DialogCreated(ByVal hWnd As LongPtr) Handles TaskDialogSC.DialogCreated 1593 | 1594 | End Sub 1595 | 1596 | Private Sub TaskDialogMPX2_DialogCreated(ByVal hWnd As LongPtr) Handles TaskDialogMPX2.DialogCreated 1597 | 1598 | End Sub 1599 | 1600 | Private Sub TaskDialogMPX2_ButtonClick(ByVal ButtonID As Long) Handles TaskDialogMPX2.ButtonClick 1601 | If bPageExampleEx Then 1602 | Dim sPW As String 1603 | If ButtonID = TD_OK Then 1604 | Select Case TaskDialogMPX2.ComboIndex 1605 | Case 0: sPW = "password1" 1606 | Case 1: sPW = "password2" 1607 | Case 2: sPW = "password3" 1608 | End Select 1609 | If TaskDialogMPX2.InputText = sPW Then 1610 | sMPLogin = "User " & (TaskDialogMPX2.ComboIndex + 1) 1611 | TaskDialogMPX2.NavigatePage TaskDialogMPX3 1612 | Else 1613 | MessageBeep MB_ERROR 1614 | Debug.Print TaskDialogMPX1.IconFooter 1615 | TaskDialogMPX2.Footer = "Wrong password, try again." 1616 | TaskDialogMPX2.IconFooter = TD_ERROR_ICON 1617 | End If 1618 | End If 1619 | End If 1620 | 1621 | End Sub 1622 | 1623 | Private Sub TaskDialogMPX2_Navigated() Handles TaskDialogMPX2.Navigated 1624 | Debug.Print "TDMPX2 NAV" 1625 | End Sub 1626 | 1627 | Private Sub TaskDialogMPX3_DialogCreated(ByVal hWnd As LongPtr) Handles TaskDialogMPX3.DialogCreated 1628 | 1629 | End Sub 1630 | 1631 | Private Sub TaskDialogMPX3_ButtonClick(ByVal ButtonID As Long) Handles TaskDialogMPX3.ButtonClick 1632 | If bPageExampleEx Then 1633 | If TaskDialogMPX3.PageIndex = 3 Then 1634 | If ButtonID = 310 Then 'Reset to page 1 1635 | With TaskDialogMPX1 1636 | .Init 1637 | .PageIndex = 1 1638 | .MainInstruction = "Mutli-page Testing" 1639 | .Content = "Choose how you want to proceed." 1640 | .Flags = TDF_USE_COMMAND_LINKS 1641 | .AddCustomButton 200, "Proceed anonymously" & vbLf & "Click here to continue without logging in." 1642 | .AddCustomButton 201, "Set log in information" & vbLf & "Select your username." 1643 | .CommonButtons = TDCBF_CANCEL_BUTTON 1644 | .IconMain = TD_SHIELD_ICON 1645 | .ParenthWnd = Me.hWnd 1646 | .SetButtonHold 200 1647 | .SetButtonHold 201 1648 | .Title = "cTaskDialog Project - Page 1" 1649 | End With 1650 | TaskDialogMPX3.NavigatePage TaskDialogMPX1 1651 | End If 1652 | End If 1653 | End If 1654 | 1655 | 1656 | End Sub 1657 | 1658 | Private Sub TaskDialogMPX3_Navigated() Handles TaskDialogMPX3.Navigated 1659 | TaskDialogMPX3.ProgressStartMarquee 1660 | TaskDialogMPX3.MainInstruction = "Logged in as " & sMPLogin 1661 | End Sub 1662 | 1663 | Private Sub TaskDialog3_Navigated() Handles TaskDialog3.Navigated 1664 | 1665 | End Sub 1666 | 1667 | Private Sub TaskDialog2_Navigated() Handles TaskDialog2.Navigated 1668 | If bRunMarquee2 Then 1669 | TaskDialog2.ProgressStartMarquee 1670 | End If 1671 | End Sub 1672 | 1673 | 1674 | End Class 1675 | -------------------------------------------------------------------------------- /Export/Sources/mTDHelper.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "mTDHelper" 2 | Option Explicit 3 | 'mTDHelper: Helper module for cTaskDialog.cls 4 | 'Must be included with the class. 5 | #If (VBA7 = 0) Then 'Adds LongPtr variable support to VB6 6 | Public Enum LongPtr 7 | [_] 8 | End Enum 9 | #End If 10 | Public Sub MagicalTDInitFunction() 11 | 'The trick is a GENIUS! 12 | 'He identified the bug in VBA64 that had been causing the crashing. 13 | 'As if by magic, calling this from Class_Initialize resolves the problem. 14 | End Sub 15 | Public Function TaskDialogCallbackProc(ByVal hwnd As LongPtr, ByVal uNotification As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal lpRefData As cTaskDialog) As LongPtr 16 | TaskDialogCallbackProc = lpRefData.zz_ProcessCallback(hwnd, uNotification, wParam, lParam) 17 | End Function 18 | Public Function TaskDialogEnumChildProc(ByVal hwnd As LongPtr, ByVal lParam As cTaskDialog) As Long 19 | TaskDialogEnumChildProc = lParam.zz_ProcessEnumCallback(hwnd) 20 | End Function 21 | Public Function TaskDialogSubclassProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As cTaskDialog) As LongPtr 22 | TaskDialogSubclassProc = dwRefData.zz_ProcessSubclass(hwnd, uMsg, wParam, lParam, uIdSubclass) 23 | End Function -------------------------------------------------------------------------------- /Export/Sources/mTDSample.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "mTDSample" 2 | Option Explicit 3 | 'mTDSample.bas 4 | 'Module for cTaskDialog Demo 5 | 'This module is only required for some actions performed by the demos 6 | 'It is not required to use cTaskDialog.cls. 7 | 8 | 9 | 10 | 'Icon code was mostly written by Leandro Ascierto, from his clsMenuImage. 11 | 'I've simply modified the resource->hicon function to stand alone 12 | #If VBA7 Then 13 | Public Declare PtrSafe Function DestroyIcon Lib "user32.dll" (ByVal hIcon As LongPtr) As Long 14 | Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) 15 | Private Declare PtrSafe Function CreateIconFromResourceEx Lib "user32.dll" (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As LongPtr 16 | Private Declare PtrSafe Function CreateIconFromResource Lib "user32.dll" (ByVal presbits As LongPtr, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long) As LongPtr 17 | Private Declare PtrSafe Function LookupIconIdFromDirectoryEx Lib "user32.dll" (ByVal presbits As LongPtr, ByVal fIcon As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long 18 | Private Declare PtrSafe Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As SHGFI_flags) As LongPtr 19 | Public Declare PtrSafe Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal FileName As LongPtr, GpImage As LongPtr) As Long 20 | Public Declare PtrSafe Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As LongPtr, Width As Long) As Long 21 | Public Declare PtrSafe Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As LongPtr, Height As Long) As Long 22 | Public Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long 23 | Public Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long 24 | Public Declare PtrSafe Function GdiplusStartup Lib "gdiplus" (ByRef token As LongPtr, ByRef lpInput As GdiplusStartupInput, ByRef lpOutput As Long) As Long 25 | Public Declare PtrSafe Function GdiplusShutdown Lib "gdiplus" (ByVal token As LongPtr) As Long 26 | Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr 27 | Public Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long 28 | Public Declare PtrSafe Function LoadImageA Lib "user32" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal dwImageType As ImageTypes, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As LoadResourceFlags) As LongPtr 29 | #Else 30 | Public Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As LongPtr) As Long 31 | Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) 32 | Private Declare Function CreateIconFromResourceEx Lib "user32.dll" (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As LongPtr 33 | Private Declare Function CreateIconFromResource Lib "user32.dll" (ByVal presbits As LongPtr, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long) As LongPtr 34 | Private Declare Function LookupIconIdFromDirectoryEx Lib "user32.dll" (ByVal presbits As LongPtr, ByVal fIcon As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long 35 | Private Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As SHGFI_flags) As LongPtr 36 | Public Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal FileName As LongPtr, GpImage As LongPtr) As Long 37 | Public Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As LongPtr, Width As Long) As Long 38 | Public Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As LongPtr, Height As Long) As Long 39 | Public Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long 40 | Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long 41 | Public Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As LongPtr, ByRef lpInput As GdiplusStartupInput, ByRef lpOutput As Long) As Long 42 | Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As LongPtr) As Long 43 | Public Declare Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr 44 | Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long 45 | Public Declare Function LoadImageA Lib "user32" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal dwImageType As ImageTypes, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As LoadResourceFlags) As LongPtr 46 | #End If 47 | Public gdipInitToken As LongPtr 48 | Private Const MAX_PATH = 260 49 | 50 | Private Type IconHeader 51 | ihReserved As Integer 52 | ihType As Integer 53 | ihCount As Integer 54 | End Type 55 | 56 | Private Type IconEntry 57 | ieWidth As Byte 58 | ieHeight As Byte 59 | ieColorCount As Byte 60 | ieReserved As Byte 61 | iePlanes As Integer 62 | ieBitCount As Integer 63 | ieBytesInRes As Long 64 | ieImageOffset As Long 65 | End Type 66 | Private Type SHFILEINFO ' shfi 67 | hIcon As Long 68 | iIcon As Long 69 | dwAttributes As Long 70 | szDisplayName As String * MAX_PATH 71 | szTypeName As String * 80 72 | End Type 73 | Public Enum SHGFI_flags 74 | SHGFI_LARGEICON = &H0 ' sfi.hIcon is large icon 75 | SHGFI_SMALLICON = &H1 ' sfi.hIcon is small icon 76 | SHGFI_OPENICON = &H2 ' sfi.hIcon is open icon 77 | SHGFI_SHELLICONSIZE = &H4 ' sfi.hIcon is shell size (not system size), rtns BOOL 78 | SHGFI_PIDL = &H8 ' pszPath is pidl, rtns BOOL 79 | ' Indicates that the function should not attempt to access the file specified by pszPath. 80 | ' Rather, it should act as if the file specified by pszPath exists with the file attributes 81 | ' passed in dwFileAttributes. This flag cannot be combined with the SHGFI_ATTRIBUTES, 82 | ' SHGFI_EXETYPE, or SHGFI_PIDL flags <---- !!! 83 | SHGFI_USEFILEATTRIBUTES = &H10 ' pretend pszPath exists, rtns BOOL 84 | SHGFI_ICON = &H100 ' fills sfi.hIcon, rtns BOOL, use DestroyIcon 85 | SHGFI_DISPLAYNAME = &H200 ' isf.szDisplayName is filled (SHGDN_NORMAL), rtns BOOL 86 | SHGFI_TYPENAME = &H400 ' isf.szTypeName is filled, rtns BOOL 87 | SHGFI_ATTRIBUTES = &H800 ' rtns IShellFolder::GetAttributesOf SFGAO_* flags 88 | SHGFI_ICONLOCATION = &H1000 ' fills sfi.szDisplayName with filename 89 | ' containing the icon, rtns BOOL 90 | SHGFI_EXETYPE = &H2000 ' rtns two ASCII chars of exe type 91 | SHGFI_SYSICONINDEX = &H4000 ' sfi.iIcon is sys il icon index, rtns hImagelist 92 | SHGFI_LINKOVERLAY = &H8000& ' add shortcut overlay to sfi.hIcon 93 | SHGFI_SELECTED = &H10000 ' sfi.hIcon is selected icon 94 | SHGFI_ATTR_SPECIFIED = &H20000 ' get only attributes specified in sfi.dwAttributes 95 | End Enum 96 | Public Type GdiplusStartupInput 97 | GdiplusVersion As Long 98 | DebugEventCallback As LongPtr 99 | SuppressBackgroundThread As Long 100 | SuppressExternalCodecs As Long 101 | End Type 102 | 103 | Public Enum ImageTypes 104 | IMAGE_BITMAP = 0 105 | IMAGE_ICON = 1 106 | IMAGE_CURSOR = 2 107 | IMAGE_ENHMETAFILE = 3 108 | End Enum 109 | Public Enum LoadResourceFlags 110 | LR_DEFAULTCOLOR = &H0 111 | LR_MONOCHROME = &H1 112 | LR_COLOR = &H2 113 | LR_COPYRETURNORG = &H4 114 | LR_COPYDELETEORG = &H8 115 | LR_LOADFROMFILE = &H10 116 | LR_LOADTRANSPARENT = &H20 117 | LR_DEFAULTSIZE = &H40 118 | LR_VGACOLOR = &H80 119 | LR_LOADMAP3DCOLORS = &H1000 120 | LR_CREATEDIBSECTION = &H2000 121 | LR_COPYFROMRESOURCE = &H4000 122 | LR_SHARED = &H8000& 123 | End Enum 124 | 125 | 126 | Public Function InitGDIPlus() As LongPtr 127 | Dim Token As LongPtr 128 | Dim gdipInit As GdiplusStartupInput 129 | 130 | gdipInit.GdiplusVersion = 1 131 | GdiplusStartup Token, gdipInit, ByVal 0& 132 | InitGDIPlus = Token 133 | End Function 134 | 135 | ' Frees GDI Plus 136 | Public Sub FreeGDIPlus(Token As LongPtr) 137 | GdiplusShutdown Token 138 | End Sub 139 | Public Function hBitmapFromFile(PicFile As String, Width As Long, Height As Long, Optional ByVal BackColor As Long = vbWhite, Optional RetainRatio As Boolean = False) As LongPtr 140 | Dim hDC As LongPtr 141 | Dim hBitmap As LongPtr 142 | Dim Img As LongPtr 143 | 144 | If gdipInitToken = 0 Then 145 | gdipInitToken = InitGDIPlus() 146 | End If 147 | ' Load the image 148 | If GdipLoadImageFromFile(StrPtr(PicFile), Img) <> 0 Then 149 | ' Err.Raise 999, "GDI+ Module", "Error loading picture " & PicFile 150 | Exit Function 151 | End If 152 | Debug.Print "gdip himage=" & Img 153 | GdipCreateHBITMAPFromBitmap Img, hBitmap, &H0 154 | ' Calculate picture's width and height if not specified 155 | ' If Width = -1 Or Height = -1 Then 156 | ' GdipGetImageWidth Img, Width 157 | ' GdipGetImageHeight Img, Height 158 | ' End If 159 | ' 160 | ' ' Initialise the hDC 161 | ' InitDC hDC, hBitmap, BackColor, Width, Height 162 | ' 163 | ' ' Resize the picture 164 | ' 'gdipResize Img, hDC, Width, Height, RetainRatio 165 | ' gdipDrawCentered Img, hDC, Width, Height, True 166 | GdipDisposeImage Img 167 | ' 168 | ' ' Get the bitmap back 169 | ' GetBitmap hDC, hBitmap 170 | 171 | hBitmapFromFile = hBitmap 172 | End Function 173 | 174 | 175 | 176 | 177 | Public Function ResIconToHICON(id As String, Optional CX As Long = 24, Optional CY As Long = 24) As LongPtr 178 | 'returns an hIcon from an icon in the resource file 179 | 'Icons must be added as a custom resource 180 | 181 | Dim tIconHeader As IconHeader 182 | Dim tIconEntry() As IconEntry 183 | Dim MaxBitCount As Long 184 | Dim MaxSize As Long 185 | Dim Aproximate As Long 186 | Dim IconID As Long 187 | Dim hIcon As LongPtr 188 | Dim i As Long 189 | Dim bytIcoData() As Byte 190 | 191 | On Error GoTo e0 192 | 193 | bytIcoData = LoadResData(id, "CUSTOM") 194 | 195 | Call CopyMemory(tIconHeader, bytIcoData(0), Len(tIconHeader)) 196 | 197 | If tIconHeader.ihCount >= 1 Then 198 | 199 | ReDim tIconEntry(tIconHeader.ihCount - 1) 200 | 201 | Call CopyMemory(tIconEntry(0), bytIcoData(Len(tIconHeader)), Len(tIconEntry(0)) * tIconHeader.ihCount) 202 | 203 | IconID = -1 204 | 205 | For i = 0 To tIconHeader.ihCount - 1 206 | If tIconEntry(i).ieBitCount > MaxBitCount Then MaxBitCount = tIconEntry(i).ieBitCount 207 | Next 208 | 209 | 210 | For i = 0 To tIconHeader.ihCount - 1 211 | If MaxBitCount = tIconEntry(i).ieBitCount Then 212 | MaxSize = CLng(tIconEntry(i).ieWidth) + CLng(tIconEntry(i).ieHeight) 213 | If MaxSize > Aproximate And MaxSize <= (CX + CY) Then 214 | Aproximate = MaxSize 215 | IconID = i 216 | End If 217 | End If 218 | Next 219 | 220 | If IconID = -1 Then Exit Function 221 | 222 | With tIconEntry(IconID) 223 | hIcon = CreateIconFromResourceEx(bytIcoData(.ieImageOffset), .ieBytesInRes, 1, &H30000, CX, CY, &H0) 224 | If hIcon <> 0 Then 225 | ResIconToHICON = hIcon 226 | End If 227 | End With 228 | 229 | End If 230 | 'Debug.Print "Res hIcon=" & hIcon 231 | 232 | On Error GoTo 0 233 | Exit Function 234 | 235 | e0: 236 | Debug.Print "modIcon.ResIconTohIcon.Error->" & Err.Description & " (" & Err.Number & ")" 237 | 238 | End Function 239 | 240 | Public Function IconToHICON(IcoData() As Byte, DesiredX As Long, DesiredY As Long) As LongPtr 241 | Dim lPtrSrc As Long, lPtrDst As Long, lID As Long 242 | Dim icDir() As Byte, LB As Long 243 | Dim tIconHeader As IconHeader 244 | Dim tIconEntry As IconEntry 245 | Dim ICRESVER As Long 246 | ICRESVER = &H30000 247 | LB = LBound(IcoData) ' just in case a non-zero LBound array passed 248 | ' convert 16 byte IconDir to 14 byte IconDir 249 | CopyMemory tIconHeader, IcoData(LB), Len(tIconHeader) 250 | ReDim icDir(0 To tIconHeader.ihCount * Len(tIconEntry) + Len(tIconHeader) - 1&) 251 | CopyMemory icDir(0), tIconHeader, Len(tIconHeader) 252 | lPtrDst = Len(tIconHeader) 253 | lPtrSrc = LB + lPtrDst 254 | For lID = 1& To tIconHeader.ihCount 255 | CopyMemory tIconEntry, IcoData(lPtrSrc), 12& ' size of standard tIconEntry less last 4 bytes 256 | tIconEntry.ieImageOffset = lID 257 | CopyMemory icDir(lPtrDst), tIconEntry, 14& ' size of DLL tIconEntry 258 | lPtrDst = lPtrDst + 14&: lPtrSrc = lPtrSrc + Len(tIconEntry) 259 | Next 260 | lID = LookupIconIdFromDirectoryEx(VarPtr(icDir(0)), True, DesiredX, DesiredY, 0&) 261 | Erase icDir() 262 | If lID > 0& Then 263 | CopyMemory tIconEntry, IcoData(LB + (lID - 1&) * Len(tIconEntry) + Len(tIconHeader)), Len(tIconEntry) 264 | 265 | IconToHICON = CreateIconFromResource(VarPtr(IcoData(LB + tIconEntry.ieImageOffset)), tIconEntry.ieBytesInRes, True, ICRESVER) 266 | End If 267 | End Function 268 | Public Function LoadIcoFile(sFile As String) As Byte() 269 | Dim f As Long 270 | 'Dim b() As Byte 271 | 272 | f = FreeFile() 273 | Open sFile For Binary As f 274 | ReDim LoadIcoFile(LOF(f)) 275 | Get f,, LoadIcoFile 276 | Close f 277 | End Function 278 | Public Function GetSystemImagelist(uSize As Long) As LongPtr 279 | Dim sfi As SHFILEINFO 280 | Dim wd As String 281 | wd = Environ("WINDIR") 282 | wd = Left(wd, 3) 283 | ' Any valid file system path can be used to retrieve system image list handles. 284 | GetSystemImagelist = SHGetFileInfo(wd, 0, sfi, Len(sfi), SHGFI_SYSICONINDEX Or uSize) 285 | End Function 286 | 287 | #If False Then 288 | Dim SHGFI_LARGEICON, SHGFI_SMALLICON, SHGFI_OPENICON, SHGFI_SHELLICONSIZE, SHGFI_PIDL, _ 289 | SHGFI_USEFILEATTRIBUTES, SHGFI_ICON, SHGFI_DISPLAYNAME, SHGFI_TYPENAME, SHGFI_ATTRIBUTES, _ 290 | SHGFI_ICONLOCATION, SHGFI_EXETYPE, SHGFI_SYSICONINDEX, SHGFI_LINKOVERLAY, SHGFI_SELECTED, _ 291 | SHGFI_ATTR_SPECIFIED 292 | #End If 293 | 294 | -------------------------------------------------------------------------------- /Form1.frm.twin: -------------------------------------------------------------------------------- 1 | [FormDesignerId("6F7672BF-AA57-4571-B865-DDF762FD2B4C")] 2 | [PredeclaredId] 3 | Class Form1 4 | Attribute VB_Name = "Form1" 5 | Attribute VB_GlobalNameSpace = False 6 | Attribute VB_Creatable = False 7 | Attribute VB_PredeclaredId = True 8 | Attribute VB_Exposed = False 9 | Option Explicit 10 | 11 | 12 | 'cTaskDialog Samples 13 | 'Written by fafalone 14 | 'Feel free to use as you wish, with due credit 15 | 16 | 17 | 18 | Private WithEvents TaskDialog1 As cTaskDialog 19 | Attribute TaskDialog1.VB_VarHelpID = -1 20 | Private WithEvents TaskDialog2 As cTaskDialog 21 | Attribute TaskDialog2.VB_VarHelpID = -1 22 | Private WithEvents TaskDialog3 As cTaskDialog 23 | Attribute TaskDialog3.VB_VarHelpID = -1 24 | Private WithEvents TaskDialogPW As cTaskDialog 25 | Attribute TaskDialogPW.VB_VarHelpID = -1 26 | Private WithEvents TaskDialogPW2 As cTaskDialog 27 | Attribute TaskDialogPW2.VB_VarHelpID = -1 28 | Private WithEvents TaskDialogSC As cTaskDialog 29 | Attribute TaskDialogSC.VB_VarHelpID = -1 30 | Private WithEvents TaskDialogAC As cTaskDialog 31 | Attribute TaskDialogAC.VB_VarHelpID = -1 32 | Private WithEvents TaskDialogMPX1 As cTaskDialog 33 | Attribute TaskDialogMPX1.VB_VarHelpID = -1 34 | Private WithEvents TaskDialogMPX2 As cTaskDialog 35 | Attribute TaskDialogMPX2.VB_VarHelpID = -1 36 | Private WithEvents TaskDialogMPX3 As cTaskDialog 37 | Attribute TaskDialogMPX3.VB_VarHelpID = -1 38 | 39 | Private bRunProgress As Boolean 40 | Private bRunMarquee As Boolean 41 | Private bRunMarquee2 As Boolean 42 | Private lSecs As Long 43 | Private himlSys As LongPtr 44 | Private bPageExampleEx As Boolean 45 | Private sMPLogin As String 46 | 47 | Private sMPName As String 48 | 49 | Private Enum ShowWindowTypes 50 | SW_HIDE = 0 51 | SW_SHOWNORMAL = 1 52 | SW_NORMAL = 1 53 | SW_SHOWMINIMIZED = 2 54 | SW_SHOWMAXIMIZED = 3 55 | SW_MAXIMIZE = 3 56 | SW_SHOWNOACTIVATE = 4 57 | SW_SHOW = 5 58 | SW_MINIMIZE = 6 59 | SW_SHOWMINNOACTIVE = 7 60 | SW_SHOWNA = 8 61 | SW_RESTORE = 9 62 | SW_SHOWDEFAULT = 10 63 | End Enum 64 | 65 | Private Declare PtrSafe Function ShellExecuteW Lib "shell32.dll" (ByVal hWnd As LongPtr, ByVal lpOperation As LongPtr, ByVal lpFile As LongPtr, ByVal lpParameters As LongPtr, ByVal lpDirectory As LongPtr, ByVal nShowCmd As ShowWindowTypes) As LongPtr 66 | 67 | Private Declare PtrSafe Function MessageBeep Lib "user32" (ByVal wType As SysBeeps) As Long 68 | Private Enum SysBeeps 69 | MB_DEFAULTBEEP = -1 ' the default beep sound 70 | MB_ERROR = 16 ' for critical errors/problems 71 | MB_WARNING = 48 ' for conditions that might cause problems in the future 72 | MB_INFORMATION = 64 ' for informative messages only 73 | MB_QUESTION = 32 ' (no longer recommended to be used) 74 | 75 | End Enum 76 | Private Sub Command1_Click() 77 | Unload Me 78 | End 79 | End Sub 80 | 81 | Private Sub Command10_Click() 82 | With TaskDialog1 83 | .Init 84 | .MainInstruction = "You're about to do something stupid." 85 | .Content = "Are you absolutely sure you want to continue with this really bad idea? I'll give you a minute to think about it." 86 | .IconMain = TD_INFORMATION_ICON 87 | .Title = "cTaskDialog Project" 88 | .Footer = "Really, think about it." 89 | .Flags = TDF_USE_COMMAND_LINKS Or TDF_SHOW_PROGRESS_BAR Or TDF_CALLBACK_TIMER 90 | .ParenthWnd = Me.hWnd 91 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here." 92 | .AddCustomButton 102, "NEVER!!!" 93 | .AddCustomButton 103, "I dunno?" 94 | .VerifyText = "Hold up!" 95 | bRunProgress = True 96 | 97 | .ShowDialog 98 | 99 | bRunProgress = False 100 | 101 | Label1.Caption = "ID of button clicked: " & .ResultMain 102 | End With 103 | End Sub 104 | 105 | Private Sub Command11_Click() 106 | With TaskDialog1 107 | .Init 108 | .MainInstruction = "Show me the icons!" 109 | .Content = "Yeah, that's the stuff." 110 | .Footer = "Got some footer icon action here too." 111 | .Flags = TDF_USE_IMAGERES_ICONID 112 | .IconMain = 1401 113 | .IconFooter = 35 114 | .Title = "cTaskDialog Project" 115 | .CommonButtons = TDCBF_CLOSE_BUTTON 116 | 117 | .ShowDialog 118 | 119 | Label1.Caption = "ID of button clicked: " & .ResultMain 120 | 121 | End With 122 | End Sub 123 | 124 | Private Sub Command12_Click() 125 | Dim hIconM As LongPtr, hIconF As LongPtr 126 | hIconM = ResIconToHICON("ICO_CLOCK", 32, 32) 127 | hIconF = ResIconToHICON("ICO_HEART", 16, 16) 128 | With TaskDialog1 129 | .Init 130 | .MainInstruction = "Let's see it all!" 131 | .Content = "Lots and lots of features are possible, thanks Microsoft for everything!" 132 | ' .Content = "Lots and blah blah blah no link here" 133 | .IconMain = hIconM 134 | .IconFooter = hIconF 135 | .Flags = TDF_USE_HICON_MAIN Or TDF_USE_HICON_FOOTER Or TDF_ENABLE_HYPERLINKS Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_CAN_BE_MINIMIZED Or TDF_DATETIME 136 | .DateTimeType = dttDateTimeWithCheck 137 | .Title = "cTaskDialog Project" 138 | .Footer = "Have some footer text." 139 | .CollapsedControlText = "Click here for some more info." 140 | .ExpandedControlText = "Click again to hide that extra info." 141 | .ExpandedInfo = "Here's a whole bunch more information you probably don't need." 142 | .VerifyText = "Never ever show me this dialog again!" 143 | .CommonButtons = TDCBF_RETRY_BUTTON Or TDCBF_CANCEL_BUTTON Or TDCBF_CLOSE_BUTTON Or TDCBF_YES_BUTTON 144 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Some more information describing YeeHaw" 145 | .AddCustomButton 102, "NEVER!!!" 146 | .AddCustomButton 103, "I dunno?" & vbLf & "Or do i?" 147 | .AddRadioButton 110, "Let's do item 1" 148 | .AddRadioButton 111, "Or maybe 2" 149 | .AddRadioButton 112, "super secret option" 150 | .EnableRadioButton 112, 0 151 | .EnableButton 102, 0 152 | .SetButtonElevated TD_RETRY, 1 153 | bRunMarquee = True 154 | .ShowDialog 155 | bRunMarquee = False 156 | 157 | Label1.Caption = "ID of button clicked: " & .ResultMain 158 | Label2.Caption = "ID of radio button selected: " & .ResultRad 159 | Label3.Caption = "Verification box checked? " & .ResultVerify 160 | End With 161 | End Sub 162 | 163 | Private Sub Command13_Click() 164 | Dim td As TASKDIALOG_COMMON_BUTTON_FLAGS 165 | td = TaskDialog1.SimpleDialog("Is TaskDialogIndirect going to be better than this?", TDCBF_YES_BUTTON, App.Title, "This is regular old TaskDialog", TD_SHIELD_GRAY_ICON, Me.hWnd, App.hInstance) 166 | Label1.Caption = "ID of button clicked: " & td 167 | 168 | End Sub 169 | 170 | Private Sub Command14_Click() 171 | With TaskDialog2 172 | .Init 173 | .Content = "Working working working..." 174 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_RETRY_BUTTON 175 | .IconMain = TD_SHIELD_OK_ICON 176 | .Flags = TDF_SHOW_MARQUEE_PROGRESS_BAR 177 | .Title = "cTaskDialog Project - Page 2" 178 | bRunMarquee2 = True 179 | End With 180 | With TaskDialog1 181 | .Init 182 | .MainInstruction = "You can now have multiple pages." 183 | .Content = "Click Next Page to continue." 184 | .Flags = TDF_USE_COMMAND_LINKS 185 | .AddCustomButton 200, "Next Page" & vbLf & "Click here to continue to the next TaskDialog" 186 | .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON 187 | .IconMain = TD_SHIELD_WARNING_ICON 188 | .ParenthWnd = Me.hWnd 189 | .SetButtonHold 200 190 | .Title = "cTaskDialog Project - Page 1" 191 | .ShowDialog 192 | End With 193 | Label1.Caption = TaskDialog1.ResultMain 194 | bRunMarquee2 = False 195 | End Sub 196 | 197 | 198 | Private Sub Command15_Click() 199 | With TaskDialog1 200 | .Init 201 | .Content = "Input Required" 202 | .Flags = TDF_INPUT_BOX 203 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 204 | .IconMain = TD_INFORMATION_ICON 205 | .Title = "cTaskDialog Project" 206 | .ParenthWnd = Me.hWnd 207 | .ShowDialog 208 | 209 | Label5.Caption = .ResultInput 210 | If .ResultMain = TD_OK Then 211 | Label1.Caption = "Yes Yes Yes!" 212 | Else 213 | Label1.Caption = "Cancelled." 214 | End If 215 | End With 216 | 217 | End Sub 218 | 219 | Private Sub Command16_Click() 220 | Dim hIcon1 As LongPtr, hIcon2 As LongPtr 221 | ' hIcon1 = ResIconToHICON("ICO_CLOCK", 32, 32) 222 | ' 'hIcon2 = ResIconToHICON("ICO_HEART", 32, 32) 223 | ' hIcon2 = ResIconToHICON("ICO_HEART", 32, 32) 224 | hIcon1 = LoadImageA(0, App.Path & "\ICO_CLOCK.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE) 225 | hIcon2 = LoadImageA(0, App.Path & "\ICO_HEART.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE) 226 | With TaskDialog1 227 | .Init 228 | .MainInstruction = "Look at the pretty icons." 229 | .IconMain = TD_SHIELD_GRADIENT_ICON 230 | .Title = "cTaskDialog Project" 231 | ' .Flags = TDF_USE_COMMAND_LINKS_NO_ICON 232 | .CommonButtons = TDCBF_CLOSE_BUTTON Or TDCBF_NO_BUTTON 233 | .AddCustomButton 103, "Button 1", hIcon2 234 | .AddCustomButton 102, "Button 2" 235 | .SetCommonButtonIcon TDCBF_NO_BUTTON, hIcon1 236 | .ShowDialog 237 | Call DestroyIcon(hIcon1) 238 | 239 | Label1.Caption = "ID of button clicked: " & .ResultMain 240 | End With 241 | End Sub 242 | 243 | Private Sub Command17_Click() 244 | 245 | With TaskDialog1 246 | .Init 247 | .Content = "Something somesuch hows-it what-eva" '& vbCrLf & vbCrLf & vbCrLf & vbCrLf 248 | .Flags = TDF_INPUT_BOX Or TDF_USE_COMMAND_LINKS 'Or TDF_EXPAND_FOOTER_AREA 249 | .InputAlign = TDIBA_Footer 250 | .AddCustomButton 101, "Test" & vbLf & "blah" 251 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 252 | ' .IconFooter = TD_INFORMATION_ICON 253 | .VerifyText = "Check mate" 254 | .ExpandedControlText = "Gimme some more" 255 | .ExpandedInfo = "Here you are sir." 256 | .Title = "cTaskDialog Project" 257 | .Footer = "$input" 258 | .IconFooter = TD_INFORMATION_ICON 259 | .ParenthWnd = Me.hWnd 260 | .ShowDialog 261 | 262 | Label5.Caption = .ResultInput 263 | If .ResultMain = TD_OK Then 264 | Label1.Caption = "Yes Yes Yes!" 265 | Else 266 | Label1.Caption = "Cancelled." 267 | End If 268 | End With 269 | End Sub 270 | 271 | Private Sub Command18_Click() 272 | Set TaskDialogPW = New cTaskDialog 273 | With TaskDialogPW 274 | .Init 275 | .MainInstruction = "Authorization Required" 276 | .Content = "The password is: password" 277 | .Flags = TDF_INPUT_BOX 278 | .InputIsPassword = True 279 | .InputAlign = TDIBA_Buttons 280 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 281 | .SetButtonElevated TD_OK, 1 282 | .SetButtonHold TD_OK 283 | .Footer = "Enter your password then press OK to continue." 284 | .IconFooter = TD_INFORMATION_ICON 285 | .IconMain = TD_SHIELD_ERROR_ICON 286 | .Title = "cTaskDialog Project" 287 | .ParenthWnd = Me.hWnd 288 | .ShowDialog 289 | 290 | Label5.Caption = .ResultInput 291 | If .ResultMain = TD_OK Then 292 | Label1.Caption = "Got correct PW!" 293 | Else 294 | Label1.Caption = "Cancelled." 295 | End If 296 | End With 297 | End Sub 298 | 299 | Private Sub Command19_Click() 300 | With TaskDialog1 301 | .Init 302 | .MainInstruction = "Duplicates" 303 | .Content = "If you want to exclude an Artists name from the search:" '& vbCrLf & vbCrLf 304 | .Flags = TDF_INPUT_BOX Or TDF_VERIFICATION_FLAG_CHECKED 305 | .AddCustomButton 100, "Continue" 306 | .CommonButtons = TDCBF_CANCEL_BUTTON 307 | .IconMain = TD_INFORMATION_ICON 308 | .Title = "cTaskDialog Project" 309 | .InputText = "Enter Artist name here." 310 | .VerifyText = "Exclude Jingles" 311 | .ParenthWnd = Me.hWnd 312 | .ShowDialog 313 | 314 | Label5.Caption = .ResultInput 315 | If .ResultMain = 100 Then 316 | Label1.Caption = "Yes Yes Yes!" 317 | Else 318 | Label1.Caption = "Cancelled." 319 | End If 320 | End With 321 | 322 | 323 | 324 | End Sub 325 | 326 | Private Sub Command2_Click() 327 | Set TaskDialog1 = New cTaskDialog 328 | With TaskDialog1 329 | .Content = "Message text" 330 | .CommonButtons = TDCBF_ABORT_BUTTON Or TDCBF_IGNORE_BUTTON Or TDCBF_TRYAGAIN_BUTTON Or TDCBF_CONTINUE_BUTTON Or TDCBF_HELP_BUTTON 331 | .Flags = TDF_POSITION_RELATIVE_TO_WINDOW Or TDF_CAN_BE_MINIMIZED Or TDF_ALLOW_DIALOG_CANCELLATION 332 | '.ParenthWnd = Me.hWnd 333 | .ShowDialog 334 | 'If .ResultMain = TD_OK Then 335 | Debug.Print "You clicked " & .ResultMain 336 | 'Else 337 | ' Debug.Print "Canceled." 338 | 'End If 339 | End With 340 | ' With TaskDialog1 341 | ' .Init 342 | ' .MainInstruction = "test" 343 | ' ' .Flags = TDF_CAN_BE_MINIMIZED 'TDF_KILL_SHIELD_ICON 344 | ' ' .Flags = TDF_ALLOW_DIALOG_CANCELLATION 345 | ' .Content = "This is a simple dialog." 346 | ' .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_CLOSE_BUTTON Or TDF_ALLOW_DIALOG_CANCELLATION 'Or TDCBF_CANCEL_BUTTON 347 | ' .IconMain = IDI_ERROR 348 | ' .Title = "cTaskDialog Project" 349 | ' .ParenthWnd = Me.hWnd 350 | ' ' .hinst = 0 351 | ' .ShowDialog 352 | 353 | ' If .ResultMain = TD_YES Then 354 | ' Label1.Caption = "Yes Yes Yes!" 355 | ' ElseIf .ResultMain = TD_NO Then 356 | ' Label1.Caption = "Nope. No. Non. Nein." 357 | ' Else 358 | ' Label1.Caption = "Cancelled." 359 | ' End If 360 | ' End With 361 | End Sub 362 | Private Sub TaskDialog1_DialogCreated(ByVal hWnd As LongPtr) 363 | If bRunMarquee Then 364 | TaskDialog1.ProgressStartMarquee() 365 | End If 366 | End Sub 367 | Private Sub Command20_Click() 368 | With TaskDialog1 369 | .Init 370 | .MainInstruction = "Input Required" 371 | .Content = "Tell me what I want to know!" & vbCrLf & vbCrLf 372 | .Flags = TDF_INPUT_BOX 373 | .InputAlign = TDIBA_Buttons 374 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 375 | .IconMain = TD_INFORMATION_ICON 376 | .Title = "cTaskDialog Project" 377 | .ParenthWnd = Me.hWnd 378 | .ShowDialog 379 | 380 | Label5.Caption = .ResultInput 381 | If .ResultMain = TD_OK Then 382 | Label1.Caption = "Yes Yes Yes!" 383 | Else 384 | Label1.Caption = "Cancelled." 385 | End If 386 | End With 387 | End Sub 388 | 389 | Private Sub Command21_Click() 390 | With TaskDialog1 391 | .Init 392 | .MainInstruction = "You're about to do something stupid." 393 | .Content = "First, tell me why?" 394 | .IconMain = TD_INFORMATION_ICON 395 | .Title = "cTaskDialog Project" 396 | .Flags = TDF_USE_COMMAND_LINKS Or TDF_INPUT_BOX 397 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here." 398 | .AddCustomButton 102, "NEVER!!!" 399 | .AddCustomButton 103, "I dunno?" 400 | 401 | .ShowDialog 402 | 403 | Label5.Caption = .ResultInput 404 | Label1.Caption = "ID of button clicked: " & .ResultMain 405 | End With 406 | End Sub 407 | 408 | Private Sub Command22_Click() 409 | With TaskDialog1 410 | .Init 411 | .MainInstruction = "Sliding on down" 412 | .Content = "Pick a number" '& vbCrLf & vbCrLf 413 | .Flags = TDF_SLIDER Or TDF_INPUT_BOX ' Or TDF_EXPANDED_BY_DEFAULTTDF_EXPAND_FOOTER_AREA Or 414 | .SliderAlign = TDIBA_Buttons 415 | .Footer = "$input" 416 | .InputAlign = TDIBA_Footer 417 | .InputWidth = -1 418 | .IconFooter = TD_INFORMATION_ICON 419 | ' .ExpandedControlText = "Show more" 420 | ' .ExpandedInfo = "Line1" 421 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 422 | .IconMain = TD_INFORMATION_ICON 423 | .Title = "cTaskDialog Project" 424 | .ParenthWnd = Me.hWnd 425 | .ShowDialog 426 | 427 | Label15.Caption = .ResultSlider 428 | If .ResultMain = TD_OK Then 429 | Label1.Caption = "Yes Yes Yes!" 430 | Else 431 | Label1.Caption = "Cancelled." 432 | End If 433 | End With 434 | End Sub 435 | 436 | Private Sub Command23_Click() 437 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 438 | With TaskDialog3 439 | .Init 440 | .MainInstruction = "Duplicates" 441 | .Content = "If you want to exclude an Artists name from the search:" 442 | .Flags = TDF_VERIFICATION_FLAG_CHECKED Or TDF_COMBO_BOX 'Or TDF_INPUT_BOX 443 | ' .InputAlign = TDIBA_Footer 444 | .AddCustomButton 100, "Continue" 445 | .CommonButtons = TDCBF_CANCEL_BUTTON 446 | .IconMain = TD_SHIELD_ICON 447 | .Title = "cTaskDialog Project" 448 | .ComboCueBanner = "Cue Banner Text" 449 | .ComboSetInitialState "", 5 450 | ' .ComboSetInitialItem 1 451 | .ComboImageList = himlSys 452 | .ComboAddItem "Item 1", 6 453 | .ComboAddItem "Item 2", 7 454 | .ComboAddItem "Item 3", 8 455 | .VerifyText = "Exclude Jingles" 456 | .ParenthWnd = Me.hWnd 457 | .ShowDialog 458 | 459 | Label3.Caption = "Checked? " & .ResultVerify 460 | Label7.Caption = .ResultComboText 461 | Label9.Caption = .ResultComboIndex 462 | If .ResultMain = 100 Then 463 | Label1.Caption = "Continue!" 464 | Else 465 | Label1.Caption = "Cancelled." 466 | End If 467 | End With 468 | End Sub 469 | 470 | Private Sub Command24_Click() 471 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 472 | With TaskDialog1 473 | .Init 474 | .MainInstruction = "Making a list..." 475 | .Content = "...and checking it twice" & vbCrLf & vbCrLf 476 | .Flags = TDF_COMBO_BOX 477 | .ComboStyle = cbtDropdownList 478 | .AddCustomButton 100, "Continue" 479 | .CommonButtons = TDCBF_CANCEL_BUTTON 480 | .IconMain = TD_INFORMATION_ICON 481 | .Title = "cTaskDialog Project" 482 | .ComboSetInitialItem 0 483 | .ComboImageList = himlSys 484 | .ComboAddItem "Item 1", 6 485 | .ComboAddItem "Item 2", 7 486 | .ComboAddItem "Item 3", 8 487 | ' .Footer = "Have you been naughty or nice?" 488 | ' .IconFooter = IDI_QUESTION 489 | .ParenthWnd = Me.hWnd 490 | .ShowDialog 491 | 492 | Label7.Caption = .ResultComboText 493 | Label9.Caption = .ResultComboIndex 494 | If .ResultMain = 100 Then 495 | Label1.Caption = "Yes Yes Yes!" 496 | Else 497 | Label1.Caption = "Cancelled." 498 | End If 499 | End With 500 | 501 | End Sub 502 | 503 | Private Sub Command25_Click() 504 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 505 | Set TaskDialogPW2 = New cTaskDialog 506 | With TaskDialogPW2 507 | .Init 508 | .MainInstruction = "Authorization Required" 509 | .Content = "The password is: 'password' + user number, e.g. password1" '& vbCrLf & vbCrLf 510 | .Flags = TDF_INPUT_BOX Or TDF_COMBO_BOX 511 | .ComboStyle = cbtDropdownList 512 | .InputIsPassword = True 513 | .InputAlign = TDIBA_Buttons 514 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 515 | .SetButtonElevated TD_OK, 1 516 | .SetButtonHold TD_OK 517 | .ComboAlign = TDIBA_Content 518 | .ComboSetInitialItem 0 519 | .ComboImageList = himlSys 520 | .ComboAddItem "User 1", 6 521 | .ComboAddItem "User 2", 7 522 | .ComboAddItem "User 3", 8 523 | .Footer = "Enter your password then press OK to continue." 524 | .IconFooter = TD_INFORMATION_ICON 525 | .IconMain = TD_SHIELD_ERROR_ICON 526 | .Title = "cTaskDialog Project" 527 | .ParenthWnd = Me.hWnd 528 | .ShowDialog 529 | 530 | Label5.Caption = .ResultInput 531 | Label9.Caption = .ResultComboIndex 532 | If .ResultMain = TD_YES Then 533 | Label1.Caption = "Yes Yes Yes!" 534 | Else 535 | Label1.Caption = "Cancelled." 536 | End If 537 | End With 538 | End Sub 539 | 540 | Private Sub Command26_Click() 541 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 542 | Set TaskDialogPW2 = New cTaskDialog 543 | With TaskDialogPW2 544 | .Init 545 | .MainInstruction = "Authorization Required" 546 | .Content = "Select a user and password." & vbCrLf & "The password is: 'password' + user number, e.g. password1" 547 | .Flags = TDF_INPUT_BOX Or TDF_COMBO_BOX 548 | .InputIsPassword = True 549 | .InputAlign = TDIBA_Footer 550 | .InputWidth = -1 551 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON Or TDCBF_RETRY_BUTTON 552 | .SetButtonElevated TD_OK, 1 553 | .SetButtonHold TD_OK 554 | .ComboSetInitialItem 0 555 | .ComboAlign = TDIBA_Buttons 556 | .ComboImageList = himlSys 557 | .ComboStyle = cbtDropdownList 558 | .ComboAddItem "User 1", 6 559 | .ComboAddItem "User 2", 7 560 | .ComboAddItem "User 3", 8 561 | .Footer = "$input" 562 | .IconFooter = TD_INFORMATION_ICON 563 | .IconMain = TD_SHIELD_ERROR_ICON 564 | .Title = "cTaskDialog Project" 565 | .ParenthWnd = Me.hWnd 566 | .ShowDialog 567 | 568 | Label5.Caption = .ResultInput 569 | Label9.Caption = .ResultComboIndex 570 | If .ResultMain = TD_YES Then 571 | Label1.Caption = "Yes Yes Yes!" 572 | Else 573 | Label1.Caption = "Cancelled." 574 | End If 575 | End With 576 | End Sub 577 | 578 | Private Sub Command27_Click() 579 | With TaskDialog1 580 | .Init 581 | .MainInstruction = "Hello World" 582 | .Content = "Pick a day, any day" 583 | .Flags = TDF_DATETIME 584 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 585 | .IconMain = TD_INFORMATION_ICON 586 | .Title = "cTaskDialog Project" 587 | .ParenthWnd = Me.hWnd 588 | .ShowDialog 589 | 590 | Label11.Caption = .ResultDateTime 591 | If .ResultMain = TD_OK Then 592 | Label1.Caption = "Yes Yes Yes!" 593 | Else 594 | Label1.Caption = "Cancelled." 595 | End If 596 | End With 597 | End Sub 598 | 599 | Private Sub Command28_Click() 600 | With TaskDialog1 601 | .Init 602 | .MainInstruction = "Hello World" 603 | .Content = "Yo u got the time bro?" '& vbCrLf & vbCrLf 604 | .Flags = TDF_DATETIME 605 | .DateTimeType = dttTime 606 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 607 | .IconMain = TD_INFORMATION_ICON 608 | .Title = "cTaskDialog Project" 609 | .ParenthWnd = Me.hWnd 610 | .ShowDialog 611 | 612 | Label11.Caption = .ResultDateTime 613 | If .ResultMain = TD_OK Then 614 | Label1.Caption = "Yes Yes Yes!" 615 | Else 616 | Label1.Caption = "Cancelled." 617 | End If 618 | End With 619 | 620 | End Sub 621 | 622 | Private Sub Command29_Click() 623 | With TaskDialog1 624 | .Init 625 | .MainInstruction = "Hello World" 626 | .Content = "Hey when u wanna do dis?" '& vbCrLf & vbCrLf 627 | .Flags = TDF_DATETIME 628 | .DateTimeType = dttDateWithCheck 629 | .DateTimeAlign = TDIBA_Footer 630 | .IconFooter = TD_INFORMATION_ICON 631 | .Footer = "$input" 632 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 633 | .IconMain = TD_INFORMATION_ICON 634 | .Title = "cTaskDialog Project" 635 | .ParenthWnd = Me.hWnd 636 | .ShowDialog 637 | 638 | Label11.Caption = .ResultDateTime 639 | Label13.Caption = .ResultDateTimeChecked 640 | If .ResultMain = TD_OK Then 641 | Label1.Caption = "Yes Yes Yes!" 642 | Else 643 | Label1.Caption = "Cancelled." 644 | End If 645 | End With 646 | End Sub 647 | 648 | Private Sub Command3_Click() 649 | With TaskDialog1 650 | .Init 651 | .MainInstruction = "You're about to do something stupid." 652 | .Content = "Are you absolutely sure you want to continue with this really bad idea?" 653 | .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON 654 | .IconMain = TD_SHIELD_WARNING_ICON 'TD_INFORMATION_ICON 655 | .Title = "cTaskDialog Project" 656 | 657 | .ShowDialog 658 | 659 | If .ResultMain = TD_YES Then 660 | Label1.Caption = "Yes Yes Yes!" 661 | ElseIf .ResultMain = TD_NO Then 662 | Label1.Caption = "Nope. No. Non. Nein." 663 | Else 664 | Label1.Caption = "Cancelled." 665 | End If 666 | End With 667 | End Sub 668 | 669 | Private Sub Command30_Click() 670 | With TaskDialog1 671 | .Init 672 | .MainInstruction = "Hello World" 673 | .Content = "Pick a day, any day" 674 | .Flags = TDF_DATETIME Or TDF_USE_COMMAND_LINKS 675 | .AddCustomButton 100, "CmdLnk" 676 | .DateTimeType = dttDateTime 677 | ' .DateTimeAlign = TDIBA_Buttons 678 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 679 | .IconMain = TD_INFORMATION_ICON 680 | .Title = "cTaskDialog Project" 681 | .ParenthWnd = Me.hWnd 682 | .ShowDialog 683 | 684 | Label11.Caption = .ResultDateTime 685 | If .ResultMain = TD_OK Then 686 | Label1.Caption = "Yes Yes Yes!" 687 | Else 688 | Label1.Caption = "Cancelled." 689 | End If 690 | End With 691 | End Sub 692 | 693 | Private Sub Command31_Click() 694 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 695 | With TaskDialog1 696 | .Init 697 | .MainInstruction = "Schedule Event" 698 | .Content = "Pick action to schedule:" '& vbCrLf & vbCrLf 699 | .Flags = TDF_DATETIME Or TDF_COMBO_BOX 'Or TDF_USE_COMMAND_LINKS 700 | '.AddCustomButton 101, "CommandL" 701 | .DateTimeType = dttDateTime 702 | .DateTimeAlign = TDIBA_Buttons 703 | .Width = 200 * .DPIScaleX 704 | .ComboStyle = cbtDropdownList 705 | .ComboSetInitialItem 0 706 | .ComboImageList = himlSys 707 | .ComboAddItem "Do One Thing", 6 708 | .ComboAddItem "Do Something Else", 7 709 | .ComboAddItem "Run and hide", 8 710 | .ComboAlign = TDIBA_Content 711 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 712 | .VerifyText = "Verify" 713 | .Footer = "Some reminder about these actions." 714 | .IconMain = TD_SHIELD_ICON 715 | .IconFooter = TD_INFORMATION_ICON 716 | .Title = "cTaskDialog Project" 717 | .ParenthWnd = Me.hWnd 718 | .ShowDialog 719 | Label7.Caption = .ResultComboText 720 | Label9.Caption = .ResultComboIndex 721 | Label11.Caption = .ResultDateTime 722 | If .ResultMain = TD_OK Then 723 | Label1.Caption = "Yes Yes Yes!" 724 | Else 725 | Label1.Caption = "Cancelled." 726 | End If 727 | End With 728 | End Sub 729 | 730 | Private Sub AddCbxItems(cdg As cTaskDialog) 731 | 732 | End Sub 733 | Private Sub Command32_Click() 734 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 735 | Dim hIconF As LongPtr 736 | hIconF = IconToHICON(LoadResData("ICO_CLIP", "CUSTOM"), 16, 16) 737 | Dim hBmp As LongPtr 738 | Dim sImg As String 739 | sImg = App.Path & "\vbf.jpg" 740 | Dim CX As Long, CY As Long 741 | hBmp = hBitmapFromFile(sImg, CX, CY) 742 | With TaskDialog1 743 | .Init 744 | .MainInstruction = "Perform Event" 745 | .Content = "Pick action to perform. You can schedule execution for later or enter a custom label below." 746 | .Flags = TDF_USE_COMMAND_LINKS Or TDF_COMBO_BOX Or TDF_DATETIME Or TDF_USE_HICON_FOOTER Or TDF_USE_SHELL32_ICONID Or TDF_KILL_SHIELD_ICON Or TDF_CAN_BE_MINIMIZED 747 | ' .ExpandedControlText = "Expando ABCDEFGHIJKL" Or TDF_INPUT_BOX 748 | ' .ExpandedInfo = "Test" 749 | .DateTimeType = dttDateTimeWithCheckTimeOnly 750 | .DateTimeAlign = TDIBA_Buttons 751 | .DateTimeAlignInButtons = tdcaRight 752 | .ComboAlign = TDIBA_Content 753 | .ComboStyle = cbtDropdownList 754 | .ComboSetInitialItem 1 755 | .ComboImageList = himlSys 756 | .ComboAddItem "Do Thing #1", 2 757 | .ComboAddItem "Do Thing #2", 7 758 | .ComboAddItem "Do Thing #3", 8 759 | .CommonButtons = TDCBF_CANCEL_BUTTON Or TDCBF_OK_BUTTON 'Or TDCBF_CLOSE_BUTTON Or TDCBF_OK_BUTTON 760 | ' .InputText = "New Event 1" 761 | ' .InputAlign = TDIBA_Buttons 762 | ' .InputWidth = 140 763 | ' .InputAlignInFooter = tdcaCenter 764 | .Footer = "Now you can say something else here." 765 | ' .VerifyText = "Perform event later:" 766 | .IconMain = TD_SHIELD_GRADIENT_ICON 767 | .IconFooter = hIconF 768 | .IconReplaceGradient = 276 769 | .Title = "cTaskDialog Project" 770 | ' .ParenthWnd = Me.hwnd 771 | .AddCustomButton 102, "Schedule" & vbLf & "Additional information here." 772 | .AddRadioButton 110, "Apply to this account only." 773 | .AddRadioButton 111, "Apply to all accounts." 774 | .SetLogoImage hBmp, LogoBitmap, LogoTopRight, 0, 0 775 | .ShowDialog 776 | 777 | Label2.Caption = "Radio: " & .ResultRad 778 | Label5.Caption = .ResultInput 779 | Label7.Caption = .ResultComboText 780 | Label9.Caption = .ResultComboIndex 781 | Label11.Caption = .ResultDateTime 782 | If .ResultDateTimeChecked = 0 Then 783 | Label13.Caption = "Time unchecked." 784 | Else 785 | Label13.Caption = "Time checked." 786 | End If 787 | If .ResultMain = 102 Then 788 | Label1.Caption = "Scheduled." 789 | Else 790 | Label1.Caption = "Cancelled." 791 | End If 792 | End With 793 | DeleteObject hBmp 794 | End Sub 795 | 796 | Private Sub Command33_Click() 797 | Dim dTimeMin As Date, dTimeMax As Date 798 | 799 | dTimeMin = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(13, 0, 0) 800 | dTimeMax = DateAdd("d", 7, dTimeMin) 801 | dTimeMax = DateAdd("h", 4, dTimeMax) 802 | 803 | With TaskDialog1 804 | .Init 805 | .MainInstruction = "Date Ranges" 806 | .Content = "Pick a time, limited to sometime in the next 7 days, between 1pm and 6pm" 807 | .Flags = TDF_DATETIME Or TDF_INPUT_BOX Or TDF_USE_COMMAND_LINKS 808 | .DateTimeType = dttDateTime 809 | .DateTimeAlign = TDIBA_Content 810 | .DateTimeSetRange True, True, dTimeMin, dTimeMax 811 | .DateTimeSetInitial dTimeMin 812 | .InputAlign = TDIBA_Buttons 813 | .InputCueBanner = "Add an optional note to whatever." 814 | .AddCustomButton 101, "Set Date" & vbLf & "Apply this date and time to whatever it is you're doing." 815 | .CommonButtons = TDCBF_CANCEL_BUTTON 816 | .IconMain = TD_INFORMATION_ICON 817 | .Title = "cTaskDialog Project" 818 | .ParenthWnd = Me.hWnd 819 | .ShowDialog 820 | 821 | Label11.Caption = .ResultDateTime 822 | If .ResultMain = 101 Then 823 | Label1.Caption = "Date Set" 824 | Else 825 | Label1.Caption = "Cancelled." 826 | End If 827 | End With 828 | End Sub 829 | 830 | Private Sub Command34_Click() 831 | With TaskDialog1 832 | .Init 833 | .MainInstruction = "Sup" 834 | .Content = "Note that if you want date/time in the buttons, there may not be enough room depending on number of buttons and whether there's checkboxes. This examples manually sets the width because they'd be truncated otherwise." '& vbCrLf & vbCrLf 835 | .Flags = TDF_DATETIME 836 | .DateTimeType = dttDateTimeWithCheck 'TimeOnly 837 | .DateTimeAlign = TDIBA_Buttons 838 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 839 | .IconMain = TD_INFORMATION_ICON 840 | .Title = "cTaskDialog Project" 841 | .ParenthWnd = Me.hWnd 842 | .Width = 300 843 | .ShowDialog 844 | 845 | Label11.Caption = .ResultDateTime 846 | Select Case .ResultDateTimeChecked 847 | Case 0: Label13.Caption = "Neither box checked." 848 | Case 2: Label13.Caption = "Time checked, date unchecked." 849 | Case 3: Label13.Caption = "Date checked, time unchecked." 850 | Case 4: Label13.Caption = "Both checked." 851 | End Select 852 | If .ResultMain = TD_OK Then 853 | Label1.Caption = "Yes Yes Yes!" 854 | Else 855 | Label1.Caption = "Cancelled." 856 | End If 857 | End With 858 | End Sub 859 | 860 | Private Sub Command35_Click() 861 | With TaskDialog1 862 | .Init 863 | .MainInstruction = "Sliding on down" 864 | .Content = "Pick a number" 865 | .Flags = TDF_SLIDER Or TDF_USE_COMMAND_LINKS 866 | .SliderSetRange 0, 100, 10 867 | .SliderSetChangeValues 10, 20 868 | .SliderTickStyle = SldTickStyleBoth 869 | .SliderValue = 50 870 | .SliderAlign = TDIBA_Content 871 | .ExpandedControlText = "ExpandMe" 872 | .ExpandedInfo = "Expanded" 873 | .AddCustomButton 100, "CommandLink" 874 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 875 | .IconMain = TD_INFORMATION_ICON 876 | .Title = "cTaskDialog Project" 877 | .ParenthWnd = Me.hWnd 878 | .ShowDialog 879 | 880 | Label15.Caption = .ResultSlider 881 | If .ResultMain = TD_OK Then 882 | Label1.Caption = "Yes Yes Yes!" 883 | Else 884 | Label1.Caption = "Cancelled." 885 | End If 886 | End With 887 | End Sub 888 | 889 | Private Sub Command36_Click() 890 | With TaskDialog1 891 | .Init 892 | .MainInstruction = "Hello World" 893 | .Content = "Input Required" 894 | .Flags = TDF_INPUT_BOX Or TDF_EXPAND_FOOTER_AREA Or TDF_EXPANDED_BY_DEFAULT ' Or TDF_SHOW_PROGRESS_BAROr TDF_USE_COMMAND_LINKS ' 895 | ' .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 896 | ' .AddCustomButton 102, "CommandLink2" 897 | .AddRadioButton 103, "Radio 1" 898 | .AddRadioButton 104, "Radio 2" 899 | .ExpandedControlText = "Expando" 900 | .ExpandedInfo = "Expanded information." 901 | ' .VerifyText = "Verification check." 902 | .InputAlign = TDIBA_Footer 903 | ' .InputAlignInFooter = tdcaCenter 904 | 905 | ' .InputWidth = 100 906 | ' .Footer = "$input" 907 | .IconFooter = TD_INFORMATION_ICON 908 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 'Or TDCBF_RETRY_BUTTON Or TDCBF_CLOSE_BUTTON 909 | .IconMain = TD_INFORMATION_ICON 910 | .Title = "cTaskDialog Project" 911 | .ParenthWnd = Me.hWnd 912 | .ShowDialog 913 | 914 | Label5.Caption = .ResultInput 915 | If .ResultMain = TD_OK Then 916 | Label1.Caption = "Yes Yes Yes!" 917 | Else 918 | Label1.Caption = "Cancelled." 919 | End If 920 | End With 921 | End Sub 922 | 923 | Private Sub Command37_Click() 924 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 925 | With TaskDialog3 926 | .Init 927 | .MainInstruction = "Main Instruct" 928 | .Content = "Content goes here." 929 | .Flags = TDF_COMBO_BOX Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_MARQUEE_PROGRESS_BAR 'Or TDF_EXPANDED_BY_DEFAULT Or TDF_EXPAND_FOOTER_AREA ' 930 | .CommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON 931 | .IconMain = TD_SHIELD_ICON 932 | .Title = "cTaskDialog Project" 933 | .ComboCueBanner = "Cue Banner Text" 934 | .ComboSetInitialState "", 5 935 | .ComboAlign = TDIBA_Footer 936 | ' .ComboAlignInFooter = tdcaCenter 937 | ' .ComboSetInitialItem 1 938 | .ComboImageList = himlSys 939 | ' .ComboStyle = cbtDropdownList 940 | .ComboAddItem "Item 1", 6 941 | .ComboAddItem "Item 2", 7 942 | .ComboAddItem "Item 3", 8 943 | .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 944 | .AddCustomButton 102, "CommandLink2" 945 | ' .AddRadioButton 103, "Radio 1" 946 | ' .AddRadioButton 104, "Radio 2" 947 | .ExpandedControlText = "Expando" 948 | .ExpandedInfo = "Expanded information." 949 | .VerifyText = "Verification check." 950 | .IconFooter = TD_ERROR_ICON 951 | .ParenthWnd = Me.hWnd 952 | .ShowDialog 953 | 954 | Label7.Caption = .ResultComboText 955 | Label9.Caption = .ResultComboIndex 956 | If .ResultMain = 100 Then 957 | Label1.Caption = "Yes Yes Yes!" 958 | Else 959 | Label1.Caption = "Cancelled." 960 | End If 961 | End With 962 | End Sub 963 | 964 | Private Sub Command38_Click() 965 | With TaskDialog1 966 | .Init 967 | ' .MainInstruction = "Hello World" 968 | .Content = "Pick a day, any day." 969 | .Flags = TDF_DATETIME Or TDF_EXPANDED_BY_DEFAULT Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_EXPANDED_BY_DEFAULT 'TDF_EXPAND_FOOTER_AREA ' 970 | .DateTimeType = dttDateTimeWithCheckTimeOnly 971 | .DateTimeAlign = TDIBA_Footer 972 | .DateTimeAlignInFooter = tdcaRight 973 | .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 974 | .AddCustomButton 102, "CommandLink2" 975 | .AddRadioButton 103, "Radio 1" 976 | .AddRadioButton 104, "Radio 2" 977 | .ExpandedControlText = "Expando blah blah" 978 | .ExpandedInfo = "Expanded information." 979 | ' .VerifyText = "Verification check.sggsgdggggggg" 980 | 981 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 982 | .IconMain = TD_INFORMATION_ICON 983 | .IconFooter = TD_ERROR_ICON 984 | .Title = "cTaskDialog Project" 985 | .ParenthWnd = Me.hWnd 986 | .ShowDialog 987 | 988 | Label11.Caption = .ResultDateTime 989 | If .ResultMain = TD_OK Then 990 | Label1.Caption = "Yes Yes Yes!" 991 | Else 992 | Label1.Caption = "Cancelled." 993 | End If 994 | End With 995 | End Sub 996 | 997 | Private Sub Command39_Click() 998 | With TaskDialog1 999 | .Init 1000 | .MainInstruction = "Sliding on down" 1001 | .Content = "Pick a number" 1002 | .Flags = TDF_SLIDER Or TDF_USE_COMMAND_LINKS Or TDF_EXPANDED_BY_DEFAULT ' Or TDF_EXPAND_FOOTER_AREA TDF_SHOW_MARQUEE_PROGRESS_BAR Or 1003 | ' .SliderTickStyle = SldTickStyleBoth 1004 | ' .SliderAlign = TDIBA_Footer 1005 | .AddCustomButton 101, "CommandLink1" & vbLf & "Desc1" 1006 | .AddCustomButton 102, "CommandLink2" 1007 | ' .AddRadioButton 103, "Radio 1" 1008 | ' .AddRadioButton 104, "Radio 2" 1009 | .ExpandedControlText = "Expando" 1010 | .ExpandedInfo = "Expanded information." 1011 | ' .VerifyText = "Verification check." 1012 | .IconFooter = TD_INFORMATION_ICON 1013 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 1014 | .IconMain = TD_INFORMATION_ICON 1015 | .Title = "cTaskDialog Project" 1016 | .ParenthWnd = Me.hWnd 1017 | .ShowDialog 1018 | 1019 | Label15.Caption = .ResultSlider 1020 | If .ResultMain = TD_OK Then 1021 | Label1.Caption = "Yes Yes Yes!" 1022 | Else 1023 | Label1.Caption = "Cancelled." 1024 | End If 1025 | End With 1026 | 1027 | End Sub 1028 | 1029 | Private Sub Command4_Click() 1030 | With TaskDialog1 1031 | .Init 1032 | .MainInstruction = "You're about to do something stupid." 1033 | .Content = "Are you absolutely sure you want to continue with this really bad idea?" 1034 | .IconMain = TD_ERROR_ICON 1035 | .Title = "cTaskDialog Project" 1036 | .AddCustomButton 101, "YeeHaw!" 1037 | .AddCustomButton 102, "NEVER!!!" 1038 | .AddCustomButton 103, "I dunno?" 1039 | 1040 | .ShowDialog 1041 | 1042 | Label1.Caption = "ID of button clicked: " & .ResultMain 1043 | End With 1044 | End Sub 1045 | 1046 | Private Sub Command40_Click() 1047 | Dim hIco16 As LongPtr 1048 | hIco16 = ResIconToHICON("ICO_HEART", 16, 16) 'IconToHICON(LoadResData("ICO_CLIP", "CUSTOM"), 16, 16) 1049 | Set TaskDialogSC = New cTaskDialog 1050 | With TaskDialogSC 1051 | .Init 1052 | .Flags = TDF_INPUT_BOX 'TDF_KILL_SHIELD_ICON 'Or TDF_USE_IMAGERES_ICONID 1053 | ' .CommonButtons = TDCBF_NO_BUTTON 1054 | .Title = "TestTitle" 1055 | .Content = "TestContent" 1056 | .ParenthWnd = Me.hWnd 1057 | .MainInstruction = "TestInstruction" 1058 | .IconMain = TD_INFORMATION_ICON 1059 | ' .AddCustomButton 122, "Button 1" 1060 | .AddCustomButton 123, "SuperButton ", hIco16 1061 | ' .AddCustomButton 124, "Button 3" 1062 | .SetSplitButton 123 1063 | .ShowDialog 1064 | Label1.Caption = .ResultMain 1065 | Label5.Caption = .ResultInput 1066 | 1067 | End With 1068 | 1069 | End Sub 1070 | 1071 | 1072 | 1073 | Private Sub Command41_Click() 1074 | Dim dTimeMin As Date, dTimeMax As Date 1075 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 1076 | 1077 | dTimeMin = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(13, 0, 0) 1078 | dTimeMax = DateAdd("d", 7, dTimeMin) 1079 | dTimeMax = DateAdd("h", 4, dTimeMax) 1080 | Dim hBmp As LongPtr 1081 | Dim sImg As String 1082 | Dim CX As Long, CY As Long 1083 | If TaskDialog1.DPIScaleX > 1 Then 1084 | sImg = App.Path & "\disc48.png" 1085 | Else 1086 | sImg = App.Path & "\disc32.png" 1087 | End If 1088 | hBmp = hBitmapFromFile(sImg, CX, CY) 1089 | ' hBmp = LoadImageW(0, StrPtr(simg), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE) 1090 | Debug.Print "hBmp=" & hBmp '& ",cx=" & cx & ",cy=" & cy 1091 | With TaskDialog1 1092 | .Init 1093 | .MainInstruction = "Set Action" 1094 | ' .Content = "Pick a time, limited to sometime in the next 7 days, between 1pm and 6pm" 1095 | .Content = "Execute this action now or choose a new time below." & vbCrLf & "For additional help: Microsoft on the web - MSDN on the web" 1096 | .Flags = TDF_DATETIME Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_INPUT_BOX Or TDF_KILL_SHIELD_ICON Or TDF_ENABLE_HYPERLINKS Or TDF_COMBO_BOX 'Or TDF_USE_COMMAND_LINKS 1097 | ' .AddRadioButton 501, "Radio 1" 1098 | ' .AddRadioButton 502, "Radio 2" 1099 | ' .ExpandedControlText = "ExpandMe!" 1100 | ' .ExpandedInfo = "blahdy blah blah" 1101 | .DateTimeType = dttDateTime 1102 | .DateTimeAlign = TDIBA_Footer 1103 | ' .DateTimeAlignInContent = tdcaCenter 1104 | .DateTimeAlignInFooter = tdcaRight 1105 | .DateTimeSetRange True, True, dTimeMin, dTimeMax 1106 | .DateTimeSetInitial dTimeMin 1107 | .InputAlign = TDIBA_Content 1108 | .InputCueBanner = "Add an optional note to whatever." 1109 | .ComboAlign = TDIBA_Buttons 1110 | .ComboCueBanner = "Cue Banner Text" 1111 | .ComboSetInitialState "", 5 1112 | ' .ComboSetInitialItem 2 1113 | .ComboImageList = himlSys 1114 | .ComboAddItem "Item 1", 6 1115 | .ComboAddItem "Item 2", 7 1116 | .ComboAddItem "Item 3", 8 1117 | .ComboWidth = -1 1118 | ' .DefaultButton = TD_CANCEL 1119 | ' .VerifyText = "Confirm something or another." 1120 | .IconFooter = TD_INFORMATION_ICON 1121 | .Footer = "Choose date and time:" 1122 | .AddCustomButton 101, "Set Date" ' & vbLf & "Apply this date and time to whatever it is you're doing." 1123 | .CommonButtons = TDCBF_CANCEL_BUTTON 1124 | .IconMain = TD_SHIELD_GRAY_ICON 1125 | ' .hinst = 0 1126 | ' .Footer = "Microsoft on the web" & _ 1127 | ' " - MSDN on the web" 1128 | .Title = "cTaskDialog Project" 1129 | .ParenthWnd = Me.hWnd 1130 | .SetLogoImage hBmp, LogoBitmap, LogoTopRight, 4, 4 'LogoButtons 1131 | bRunMarquee = True 1132 | .ShowDialog 1133 | bRunMarquee = False 1134 | 1135 | Label11.Caption = .ResultDateTime 1136 | If .ResultMain = 101 Then 1137 | Label1.Caption = "Date Set" 1138 | Else 1139 | Label1.Caption = "Cancelled." 1140 | End If 1141 | End With 1142 | Call DeleteObject(hBmp) 1143 | 1144 | End Sub 1145 | 1146 | Private Sub Command42_Click() 1147 | Dim dTimeMin As Date, dTimeMax As Date 1148 | himlSys = GetSystemImagelist(SHGFI_SMALLICON) 1149 | 1150 | dTimeMin = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(13, 0, 0) 1151 | dTimeMax = DateAdd("d", 7, dTimeMin) 1152 | dTimeMax = DateAdd("h", 4, dTimeMax) 1153 | Dim hBmp As LongPtr 1154 | Dim sImg As String 1155 | sImg = App.Path & "\vbf.jpg" 1156 | Dim CX As Long, CY As Long 1157 | hBmp = hBitmapFromFile(sImg, CX, CY) 1158 | ' hBmp = LoadImageW(0, StrPtr(simg), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE) 1159 | Debug.Print "hBmp=" & hBmp '& ",cx=" & cx & ",cy=" & cy 1160 | With TaskDialog1 1161 | .Init 1162 | .MainInstruction = "Set Action" 1163 | ' .Content = "Pick a time, limited to sometime in the next 7 days, between 1pm and 6pm" 1164 | .Content = "Execute this action now or choose a new time below." & vbCrLf & "For additional help: Microsoft on the web - MSDN on the web" 1165 | .Flags = TDF_DATETIME Or TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_INPUT_BOX Or TDF_ENABLE_HYPERLINKS ' Or TDF_COMBO_BOX 'Or TDF_USE_COMMAND_LINKS 1166 | ' .AddRadioButton 501, "Radio 1" 1167 | ' .AddRadioButton 502, "Radio 2" 1168 | ' .ExpandedControlText = "ExpandMe!" 1169 | ' .ExpandedInfo = "blahdy blah blah" 1170 | .DateTimeType = dttDateTime 1171 | .DateTimeAlign = TDIBA_Footer 1172 | ' .DateTimeAlignInContent = tdcaCenter 1173 | .DateTimeAlignInFooter = tdcaRight 1174 | .DateTimeSetRange True, True, dTimeMin, dTimeMax 1175 | .DateTimeSetInitial dTimeMin 1176 | .InputAlign = TDIBA_Content 1177 | .InputCueBanner = "Add an optional note to whatever." 1178 | .ComboAlign = TDIBA_Content 1179 | .ComboCueBanner = "Cue Banner Text" 1180 | .ComboSetInitialState "", 5 1181 | ' .ComboSetInitialItem 2 1182 | .ComboImageList = himlSys 1183 | .ComboAddItem "Item 1", 6 1184 | .ComboAddItem "Item 2", 7 1185 | .ComboAddItem "Item 3", 8 1186 | .ComboWidth = -1 1187 | ' .DefaultButton = TD_CANCEL 1188 | ' .VerifyText = "Confirm something or another." 1189 | .IconFooter = TD_INFORMATION_ICON 1190 | .Footer = "Choose date and time:" 1191 | .AddCustomButton 101, "Set Date" ' & vbLf & "Apply this date and time to whatever it is you're doing." 1192 | .CommonButtons = TDCBF_CANCEL_BUTTON 1193 | .IconMain = TD_ERROR_ICON 1194 | ' .hinst = 0 1195 | ' .Footer = "Microsoft on the web" & _ 1196 | ' " - MSDN on the web" 1197 | .Title = "cTaskDialog Project" 1198 | .ParenthWnd = Me.hWnd 1199 | .SetLogoImage hBmp, LogoBitmap, LogoButtons 1200 | bRunMarquee = True 1201 | .ShowDialog 1202 | bRunMarquee = False 1203 | 1204 | Label11.Caption = .ResultDateTime 1205 | If .ResultMain = 101 Then 1206 | Label1.Caption = "Date Set" 1207 | Else 1208 | Label1.Caption = "Cancelled." 1209 | End If 1210 | End With 1211 | Call DeleteObject(hBmp) 1212 | End Sub 1213 | 1214 | Private Sub Command43_Click() 1215 | Set TaskDialogMPX1 = New cTaskDialog 1216 | Set TaskDialogMPX2 = New cTaskDialog 1217 | Set TaskDialogMPX3 = New cTaskDialog 1218 | sMPLogin = "" 1219 | With TaskDialogMPX3 1220 | .Init 1221 | .PageIndex = 3 1222 | .MainInstruction = "dummy" 1223 | .Content = "We're now doing stuff..." 1224 | .CommonButtons = TDCBF_OK_BUTTON 1225 | .IconMain = TD_SHIELD_OK_ICON 1226 | .Flags = TDF_SHOW_MARQUEE_PROGRESS_BAR Or TDF_USE_COMMAND_LINKS 1227 | .AddCustomButton 310, "Restart process" & vbLf & "Click to return to the previous page." 1228 | .SetButtonHold 310 1229 | .Title = "cTaskDialog Project - Page 3" 1230 | End With 1231 | With TaskDialogMPX2 1232 | .Init 1233 | .PageIndex = 2 1234 | .MainInstruction = "Log In" 1235 | .Content = "The password is: 'password' + user number, e.g. password1" '& vbCrLf & vbCrLf 1236 | .Flags = TDF_INPUT_BOX Or TDF_COMBO_BOX 1237 | .ComboStyle = cbtDropdownList 1238 | .InputIsPassword = True 1239 | .InputAlign = TDIBA_Buttons 1240 | .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON 1241 | .SetButtonElevated TD_OK, 1 1242 | .SetButtonHold TD_OK 1243 | .ComboAlign = TDIBA_Content 1244 | .ComboSetInitialItem 0 1245 | If (himlSys = 0) Then himlSys = GetSystemImagelist(SHGFI_SMALLICON) 1246 | .ComboImageList = himlSys 1247 | .ComboAddItem "User 1", 6 1248 | .ComboAddItem "User 2", 7 1249 | .ComboAddItem "User 3", 8 1250 | .Footer = "Enter your password then press OK to continue." 1251 | .IconFooter = TD_INFORMATION_ICON 1252 | .IconMain = TD_SHIELD_GRAY_ICON 1253 | .Title = "cTaskDialog Project - Page 2" 1254 | .ParenthWnd = Me.hWnd 1255 | End With 1256 | With TaskDialogMPX1 1257 | .Init 1258 | .PageIndex = 1 1259 | .MainInstruction = "Mutli-page Testing" 1260 | .Content = "Choose how you want to proceed." 1261 | .Flags = TDF_USE_COMMAND_LINKS 1262 | .AddCustomButton 200, "Proceed anonymously" & vbLf & "Click here to continue without logging in." 1263 | .AddCustomButton 201, "Set log in information" & vbLf & "Select your username." 1264 | .CommonButtons = TDCBF_CANCEL_BUTTON 1265 | .IconMain = TD_SHIELD_ICON 1266 | .ParenthWnd = Me.hWnd 1267 | .SetButtonHold 200 1268 | .SetButtonHold 201 1269 | .Title = "cTaskDialog Project - Page 1" 1270 | bPageExampleEx = True 1271 | .ShowDialog 1272 | bPageExampleEx = False 1273 | Label1.Caption = .ResultMain 1274 | Label5.Caption = .ResultInput 1275 | Label17.Caption = .PageIndex 1276 | End With 1277 | Label1.Caption = TaskDialog1.ResultMain 1278 | End Sub 1279 | 1280 | Private Sub Command44_Click() 1281 | With TaskDialogAC 1282 | .Init 1283 | .MainInstruction = "Do you wish to do somethingsomesuch?" 1284 | .Flags = TDF_CALLBACK_TIMER Or TDF_USE_COMMAND_LINKS Or TDF_SHOW_PROGRESS_BAR 1285 | .Content = "Execute it then, otherwise I'm gonna peace out." 1286 | .AddCustomButton 101, "Let's Go!" & vbLf & "Really, let's go." 1287 | .CommonButtons = TDCBF_CLOSE_BUTTON 1288 | .IconMain = IDI_QUESTION 1289 | .IconFooter = TD_ERROR_ICON 1290 | .Footer = "Closing in 15 seconds..." 1291 | .Title = "cTaskDialog Project" 1292 | .AutocloseTime = 15 'seconds 1293 | .ParenthWnd = Me.hWnd 1294 | ' .hinst = 0 1295 | .ShowDialog 1296 | 1297 | If .ResultMain = TD_YES Then 1298 | Label1.Caption = "Yes Yes Yes!" 1299 | ElseIf .ResultMain = TD_NO Then 1300 | Label1.Caption = "Nope. No. Non. Nein." 1301 | Else 1302 | Label1.Caption = "Cancelled." 1303 | End If 1304 | End With 1305 | End Sub 1306 | 1307 | Private Sub Command5_Click() 1308 | With TaskDialog1 1309 | .Init 1310 | .MainInstruction = "You're about to do something stupid." 1311 | .Content = "Are you absolutely sure you want to continue with this really bad idea? So just exactly how damn wide are you son of bitching bastards planning on making this before you get around to wrapping my text?" 1312 | .IconMain = TD_INFORMATION_ICON 1313 | .Title = "cTaskDialog Project" 1314 | .AddCustomButton 101, "YeeHaw!" 1315 | .AddCustomButton 102, "NEVER!!!" 1316 | .AddCustomButton 103, "I dunno?" 1317 | .AddRadioButton 110, "Let's do item 1" 1318 | .AddRadioButton 111, "Or maybe 2" 1319 | .AddRadioButton 112, "super secret option" 1320 | .Flags = TDF_SIZE_TO_CONTENT 1321 | .Width = 50 1322 | .ShowDialog 1323 | 1324 | Label1.Caption = "ID of button clicked: " & .ResultMain 1325 | Label2.Caption = "ID of radio button selected: " & .ResultRad 1326 | 1327 | End With 1328 | End Sub 1329 | 1330 | Private Sub Command6_Click() 1331 | With TaskDialog1 1332 | .Init 1333 | .MainInstruction = "Let's see some hyperlinking!" 1334 | .Content = "Where else to link to but Microsoft.com" 1335 | .IconMain = TD_INFORMATION_ICON 1336 | .Title = "cTaskDialog Project" 1337 | .CommonButtons = TDCBF_CLOSE_BUTTON 1338 | .Flags = TDF_ENABLE_HYPERLINKS 1339 | .ParenthWnd = Me.hWnd 1340 | .ShowDialog 1341 | 1342 | Label1.Caption = "ID of button clicked: " & .ResultMain 1343 | Label2.Caption = "ID of radio button selected: " & .ResultRad 1344 | 1345 | End With 1346 | End Sub 1347 | 1348 | Private Sub Command7_Click() 1349 | Dim hIconM As LongPtr, hIconF As LongPtr 1350 | hIconM = IconToHICON(LoadResData("ICO_CLIP", "CUSTOM"), 32, 32) 1351 | 'hIconM = ResIconToHICON("ICO_CLOCK", 32, 32) 1352 | hIconF = ResIconToHICON("ICO_HEART", 16, 16) 1353 | With TaskDialog1 1354 | .Init 1355 | .MainInstruction = "What time is it?" 1356 | .Content = "Is is party time yet???" 1357 | .Footer = "Don't you love TaskDialogIndirect?" 1358 | .Flags = TDF_USE_HICON_MAIN Or TDF_USE_HICON_FOOTER 1359 | .IconMain = hIconM 1360 | .IconFooter = hIconF 1361 | .Title = "cTaskDialog Project" 1362 | .CommonButtons = TDCBF_CLOSE_BUTTON 1363 | 1364 | .ShowDialog 1365 | 1366 | Label1.Caption = "ID of button clicked: " & .ResultMain 1367 | End With 1368 | Call DestroyIcon(hIconM) 1369 | Call DestroyIcon(hIconF) 1370 | 1371 | End Sub 1372 | 1373 | Private Sub Command8_Click() 1374 | With TaskDialog1 1375 | .Init 1376 | .MainInstruction = "Let's see all the basic fields." 1377 | .Content = "We can really fit in a lot of organized information now." 1378 | .Title = "cTaskDialog Project" 1379 | .Footer = "Have some footer text." 1380 | ' .CollapsedControlText = "Click here for some more info." 1381 | .ExpandedControlText = "Click again to hide that extra info." 1382 | .ExpandedInfo = "Here's some more info we don't really need." 1383 | .VerifyText = "Never ever show me this dialog again!" 1384 | 1385 | .IconMain = TD_INFORMATION_ICON 1386 | .IconFooter = TD_ERROR_ICON 1387 | 1388 | .ShowDialog 1389 | 1390 | Label1.Caption = "ID of button clicked: " & .ResultMain 1391 | Label2.Caption = "Box checked? " & .ResultVerify 1392 | End With 1393 | End Sub 1394 | 1395 | Private Sub Command9_Click() 1396 | 1397 | With TaskDialog1 1398 | .Init 1399 | .MainInstruction = "You're about to do something stupid." 1400 | .Content = "Are you absolutely sure you want to continue with this really bad idea?" 1401 | .IconMain = TD_INFORMATION_ICON 1402 | .Title = "cTaskDialog Project" 1403 | .CommonButtons = TDCBF_CANCEL_BUTTON 1404 | .Flags = TDF_USE_COMMAND_LINKS 1405 | .AddCustomButton 101, "YeeHaw!" & vbLf & "Put some additional information about the command here." 1406 | .AddCustomButton 102, "NEVER!!!" 1407 | .AddCustomButton 103, "I dunno?" 1408 | 1409 | .ShowDialog 1410 | 1411 | Label1.Caption = "ID of button clicked: " & .ResultMain 1412 | End With 1413 | End Sub 1414 | 1415 | Private Sub Form_Unload(Cancel As Integer) 1416 | Set TaskDialog1 = Nothing 1417 | Set TaskDialog2 = Nothing 1418 | FreeGDIPlus gdipInitToken 1419 | 1420 | End Sub 1421 | 1422 | 1423 | Private Sub TaskDialog1_ButtonClick(ByVal ButtonID As Long) 1424 | Debug.Print "TaskDialog1_ButtonClick " & ButtonID 1425 | If ButtonID = 200 Then 1426 | TaskDialog1.NavigatePage TaskDialog2 1427 | End If 1428 | End Sub 1429 | 1430 | 1431 | Private Sub TaskDialog1_ComboItemChanged(ByVal iNewItem As Long) 1432 | Debug.Print "ComboItmChg " & iNewItem 1433 | End Sub 1434 | 1435 | Private Sub TaskDialog1_DateTimeChange(ByVal dtNew As Date, ByVal lCheckStatus As Long) 1436 | Debug.Print "DateTimeChange " & dtNew 1437 | 1438 | End Sub 1439 | 1440 | Private Sub TaskDialog1_DialogDestroyed() 1441 | Timer1.Enabled = False 1442 | bRunProgress = False 1443 | End Sub 1444 | 1445 | Private Sub TaskDialog1_HyperlinkClick(ByVal lPtr As LongPtr) 1446 | 1447 | Call ShellExecuteW(0, 0, lPtr, 0, 0, SW_SHOWNORMAL) 1448 | 1449 | End Sub 1450 | Private Sub Form_Load() 1451 | gdipInitToken = InitGDIPlus 1452 | Set TaskDialog1 = New cTaskDialog 1453 | Set TaskDialog2 = New cTaskDialog 1454 | Set TaskDialog3 = New cTaskDialog 1455 | Set TaskDialogAC = New cTaskDialog 1456 | Set TaskDialogMPX1 = New cTaskDialog 1457 | Set TaskDialogMPX2 = New cTaskDialog 1458 | End Sub 1459 | 1460 | 1461 | 1462 | 1463 | Private Sub TaskDialog1_InputBoxChange(sText As String) 1464 | Debug.Print "InputChange=" & sText 1465 | End Sub 1466 | 1467 | 1468 | Private Sub TaskDialog1_SliderChange(ByVal lNewValue As Long) 1469 | Debug.Print "SliderChange=" & lNewValue 1470 | End Sub 1471 | 1472 | Private Sub TaskDialog1_Timer(ByVal TimerValue As Long) 1473 | 1474 | If lSecs > 60 Then 1475 | Timer1.Enabled = False 1476 | bRunProgress = False 1477 | Else 1478 | TaskDialog1.ProgressSetValue lSecs 1479 | TaskDialog1.Footer = "You've been thinking for " & lSecs & " seconds now..." 1480 | End If 1481 | 1482 | End Sub 1483 | 1484 | Private Sub TaskDialog1_VerificationClicked(ByVal Value As Long) 1485 | If Value = 1 Then 1486 | Timer1.Enabled = False 1487 | bRunProgress = False 1488 | Else 1489 | bRunProgress = True 1490 | Timer1.Enabled = True 1491 | End If 1492 | End Sub 1493 | 1494 | Private Sub TaskDialog2_ButtonClick(ByVal ButtonID As Long) 1495 | Debug.Print "TaskDialog2_ButtonClick " & ButtonID 1496 | 1497 | End Sub 1498 | 1499 | Private Sub TaskDialog2_DialogConstucted(ByVal hWnd As LongPtr) 1500 | Debug.Print "TaskDialog2_DialogConstucted" 1501 | 1502 | End Sub 1503 | 1504 | Private Sub TaskDialog2_DialogCreated(ByVal hWnd As LongPtr) 1505 | Debug.Print "TaskDialog2_DialogCreated" 1506 | 1507 | 1508 | End Sub 1509 | 1510 | Private Sub TaskDialog2_DropdownButtonClicked(ByVal hWnd As LongPtr) 1511 | Debug.Print "TD2 ButtonDropdown" 1512 | End Sub 1513 | 1514 | Private Sub TaskDialog2_InputBoxChange(sText As String) 1515 | Debug.Print "TD2 Input=" & sText 1516 | End Sub 1517 | 1518 | Private Sub TaskDialog3_DialogCreated(ByVal hWnd As LongPtr) 1519 | 'Call SendMessageW(TaskDialog3.hWndCombo, CB_SETDROPPEDWIDTH, 900&, ByVal 0&) 1520 | End Sub 1521 | 1522 | Private Sub TaskDialog3_InputBoxChange(sText As String) 1523 | Debug.Print "InputChange=" & sText 1524 | 1525 | End Sub 1526 | 1527 | Private Sub TaskDialogAC_DialogCreated(ByVal hWnd As LongPtr) 1528 | TaskDialogAC.ProgressSetRange 0, 15 1529 | TaskDialogAC.ProgressSetState ePBST_ERROR 1530 | End Sub 1531 | 1532 | Private Sub TaskDialogAC_Timer(ByVal TimerValue As Long) 1533 | On Error Resume Next 1534 | TaskDialogAC.Footer = "Closing in " & TaskDialogAC.AutocloseTime & " seconds..." 1535 | TaskDialogAC.ProgressSetValue 15 - TaskDialogAC.AutocloseTime 1536 | On Error GoTo 0 1537 | End Sub 1538 | 1539 | Private Sub TaskDialogMPX1_ButtonClick(ByVal ButtonID As Long) 1540 | Debug.Print "TaskDialogMPX1_ButtonClick id=" & ButtonID & ",page=" & TaskDialogMPX1.PageIndex 1541 | If bPageExampleEx Then 1542 | If TaskDialogMPX1.PageIndex = 1 Then 1543 | If ButtonID = 201 Then 1544 | TaskDialogMPX1.NavigatePage TaskDialogMPX2 1545 | ElseIf ButtonID = 200 Then 1546 | sMPLogin = "Anonymous" 1547 | TaskDialogMPX1.NavigatePage TaskDialogMPX3 1548 | End If 1549 | End If 1550 | End If 1551 | End Sub 1552 | 1553 | Private Sub TaskDialogPW_ButtonClick(ByVal ButtonID As Long) 1554 | Debug.Print "TaskDialogPW_ButtonClick " & ButtonID 1555 | If ButtonID = TD_OK Then 1556 | If TaskDialogPW.InputText = "password" Then 1557 | TaskDialogPW.CloseDialog 1558 | Else 1559 | MessageBeep MB_ERROR 1560 | TaskDialogPW.Footer = "Wrong password, please try again." 1561 | TaskDialogPW.IconFooter = TD_ERROR_ICON 1562 | End If 1563 | End If 1564 | End Sub 1565 | 1566 | Private Sub TaskDialogPW2_ButtonClick(ByVal ButtonID As Long) 1567 | Dim sPW As String 1568 | If ButtonID = TD_OK Then 1569 | Select Case TaskDialogPW2.ComboIndex 1570 | Case 0: sPW = "password1" 1571 | Case 1: sPW = "password2" 1572 | Case 2: sPW = "password3" 1573 | End Select 1574 | If TaskDialogPW2.InputText = sPW Then 1575 | TaskDialogPW2.CloseDialog 1576 | Else 1577 | MessageBeep MB_ERROR 1578 | TaskDialogPW2.Footer = "Wrong password, try again." 1579 | TaskDialogPW2.IconFooter = TD_ERROR_ICON 1580 | End If 1581 | End If 1582 | End Sub 1583 | 1584 | Private Sub TaskDialogSC_DropdownButtonClicked(ByVal hWnd As LongPtr) 1585 | Debug.Print "Got DropDown Button!" 1586 | End Sub 1587 | 1588 | Private Sub Timer1_Timer() 1589 | lSecs = lSecs + 1 1590 | End Sub 1591 | 1592 | Private Sub TaskDialogSC_DialogCreated(ByVal hWnd As LongPtr) Handles TaskDialogSC.DialogCreated 1593 | 1594 | End Sub 1595 | 1596 | Private Sub TaskDialogMPX2_DialogCreated(ByVal hWnd As LongPtr) Handles TaskDialogMPX2.DialogCreated 1597 | 1598 | End Sub 1599 | 1600 | Private Sub TaskDialogMPX2_ButtonClick(ByVal ButtonID As Long) Handles TaskDialogMPX2.ButtonClick 1601 | If bPageExampleEx Then 1602 | Dim sPW As String 1603 | If ButtonID = TD_OK Then 1604 | Select Case TaskDialogMPX2.ComboIndex 1605 | Case 0: sPW = "password1" 1606 | Case 1: sPW = "password2" 1607 | Case 2: sPW = "password3" 1608 | End Select 1609 | If TaskDialogMPX2.InputText = sPW Then 1610 | sMPLogin = "User " & (TaskDialogMPX2.ComboIndex + 1) 1611 | TaskDialogMPX2.NavigatePage TaskDialogMPX3 1612 | Else 1613 | MessageBeep MB_ERROR 1614 | Debug.Print TaskDialogMPX1.IconFooter 1615 | TaskDialogMPX2.Footer = "Wrong password, try again." 1616 | TaskDialogMPX2.IconFooter = TD_ERROR_ICON 1617 | End If 1618 | End If 1619 | End If 1620 | 1621 | End Sub 1622 | 1623 | Private Sub TaskDialogMPX2_Navigated() Handles TaskDialogMPX2.Navigated 1624 | Debug.Print "TDMPX2 NAV" 1625 | End Sub 1626 | 1627 | Private Sub TaskDialogMPX3_DialogCreated(ByVal hWnd As LongPtr) Handles TaskDialogMPX3.DialogCreated 1628 | 1629 | End Sub 1630 | 1631 | Private Sub TaskDialogMPX3_ButtonClick(ByVal ButtonID As Long) Handles TaskDialogMPX3.ButtonClick 1632 | If bPageExampleEx Then 1633 | If TaskDialogMPX3.PageIndex = 3 Then 1634 | If ButtonID = 310 Then 'Reset to page 1 1635 | With TaskDialogMPX1 1636 | .Init 1637 | .PageIndex = 1 1638 | .MainInstruction = "Mutli-page Testing" 1639 | .Content = "Choose how you want to proceed." 1640 | .Flags = TDF_USE_COMMAND_LINKS 1641 | .AddCustomButton 200, "Proceed anonymously" & vbLf & "Click here to continue without logging in." 1642 | .AddCustomButton 201, "Set log in information" & vbLf & "Select your username." 1643 | .CommonButtons = TDCBF_CANCEL_BUTTON 1644 | .IconMain = TD_SHIELD_ICON 1645 | .ParenthWnd = Me.hWnd 1646 | .SetButtonHold 200 1647 | .SetButtonHold 201 1648 | .Title = "cTaskDialog Project - Page 1" 1649 | End With 1650 | TaskDialogMPX3.NavigatePage TaskDialogMPX1 1651 | End If 1652 | End If 1653 | End If 1654 | 1655 | 1656 | End Sub 1657 | 1658 | Private Sub TaskDialogMPX3_Navigated() Handles TaskDialogMPX3.Navigated 1659 | TaskDialogMPX3.ProgressStartMarquee 1660 | TaskDialogMPX3.MainInstruction = "Logged in as " & sMPLogin 1661 | End Sub 1662 | 1663 | Private Sub TaskDialog3_Navigated() Handles TaskDialog3.Navigated 1664 | 1665 | End Sub 1666 | 1667 | Private Sub TaskDialog2_Navigated() Handles TaskDialog2.Navigated 1668 | If bRunMarquee2 Then 1669 | TaskDialog2.ProgressStartMarquee 1670 | End If 1671 | End Sub 1672 | 1673 | 1674 | End Class 1675 | -------------------------------------------------------------------------------- /ICO_CLIP.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/ICO_CLIP.ico -------------------------------------------------------------------------------- /ICO_CLOCK.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/ICO_CLOCK.ico -------------------------------------------------------------------------------- /ICO_HEART.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/ICO_HEART.ico -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cTaskDialog 2 | ### Current Version: v1.5 R2 Universal Compatibility Version 3 | 4 | **Quick Start:** Add cTaskDialog.cls and mTDHelper.bas to your project-- these are the only two required files for your code. 5 | 6 | 7 | cTaskDialog :: A complete class wrapper for `TaskDialogIndirect`, with additional custom features, universally compatible with VB6/VBA7/twinBASIC x86/x64 8 | 9 | **Update (v1.5.3 (1.5 R3), 03 Jun 2025):**\ 10 | -Bug fix: Public const in class. 11 | 12 | **Update (v1.5.2 (1.5 R2), 27 Mar 2025):**\ 13 | -Changed missed Debug.Print statements to DebugAppend and set useropt_dbg_PrintToImmediate to False by default, so the class will no longer print debug messages unless changed.\ 14 | -Bug fix: zzGetCommonButtonIcon and ResultComboData Long instead of LongPtr.\ 15 | -Corrected misc spelling mistakes highlighted by the AccessUI version :)\ 16 | **Update (v1.5, 19 Mar 2025):** mTDHelper.bas has been restored to its earlier compact form; change was during troubleshooting and unnecessary. No change to class.\ 17 | **Update (v1.5, 15 Jun 2024):** 18 | - Class will now attempt to use comctl32.dll 6.0 in the absence of a manifest, since it's impactical to add one to 32bit VBA hosts without one, like Excel. This is activated only immediately prior to the API call and deactivated immediately after, so it won't impact things like Visual Styles outside this class. 19 | 20 | - Added lParam options for AddComboItem; obtain from result with ResultComboData. 21 | 22 | - Custom icons were broken in the main demo project (no issue in this class) 23 | 24 | - ComboNewIndex property to provide the last added combo item index. 25 | 26 | 27 | **Update (v1.4, 19 Jan 2024):** Incorrect versions of mTDSample.bas were being used that did have conditonal PtrSafe declares. This has been fixed in the root dir for the VBP, in the Export dir, in the twinproj, and on VBForums.\ 28 | **Update (v1.4, 17 Jan 2024):**\ 29 | After review, I've included the undocumented additional common buttons that were used in the AccessUI version (thanks!). The following .CommonButtons are now available, with their return value given in parentheses: 30 | 31 | ```vba 32 | TDCBF_ABORT_BUTTON (TD_ABORT) 33 | TDCBF_IGNORE_BUTTON (TD_IGNORE) 34 | TDCBF_TRYAGAIN_BUTTON (TD_TRYAGAIN) 35 | TDCBF_CONTINUE_BUTTON (TD_CONTINUE) 36 | 37 | TDCBF_HELP_BUTTON '**This will raise the Help Event, and will not close the dialog.** 38 | ``` 39 | 40 | The Help button works everywhere, *including MS Access*. Unfortunately, the AccessUI version had a typo; the release had 16384 which isn't anything-- but it looks like they just had a typo originally, there's a comment '104857 which of course makes no sense... but if you convert these values to hex, you find `&H10000, &H20000, &H40000`, and `&H80000` for the other new buttons... `&H100000` is **1048576** in decimal-- so they just cut off a digit when copying it down. `&H100000` works in Access, I checked. 41 | 42 | 43 | **Update (v1.3.8, 30 Sep 2023):** Fix for custom buttons in VBA64.\ 44 | **Update (v1.3.7, 28 Sep 2023):** NOW FULLY WORKING IN VBA64! Note: You must update mTDHelper.bas too.) 45 | 46 | ![Screenshot1](https://i.imgur.com/AQEvO9W.gif) ![Screenshot2](https://i.imgur.com/8VvddRR.gif) 47 | 48 | ![Screensot3](https://i.imgur.com/npGDQVe.jpg) 49 | 50 | 51 | This is a version of my [cTaskDialog project](https://www.vbforums.com/showthread.php?777021-VB6-TaskDialogIndirect-Complete-class-implementation-of-Vista-Task-Dialogs) that uses conditional compilation to support both VB6/VBA6 and twinBASIC/VBA7 in either x86 or x64. See that page for complete project description and numerous more pictures and examples. The demo is provided as a twinBASIC project, but you can get just the cTaskDialog.cls and modTDHelper.bas for VB6/VBA in Export\Sources. The demos are in Form1.frm.twin there too, but you can use the demos from the main project thread too. 52 | 53 | Since people have asked about using this in VBA, it goes back to the earlier method of using a module to help with subclassing, as the self-subclass code in the last VB6 version only works in VB6, and while twinBASIC supports AddressOf on class members, VBA7 does not. Note that there's a bug in the self-sub version that changes the way multiple pages are handled, sending all events through the first page class. So if you use multiple paged Task Dialogs, you'll now need to relocate events for the other pages to their own event Subs (the Demo does this with it's multi-page Demos). 54 | 55 | > [!NOTE] 56 | > You can find a number of tutorials for the examples on the [original VB6 project page](https://www.vbforums.com/showthread.php?777021-VB6-TaskDialogIndirect-Complete-class-implementation-of-Vista-Task-Dialogs). 57 | 58 | ### Updates 59 | (30 Sep 2023) In my excitement over callbacks finally working, I forgot that I had not implemented the `TASKDIALOG_BUTTON_VBA7` alternates for custom buttons. This has now been implemented and basic functionality verified. Please notify of any issues. 60 | 61 | (28 Sep 2023) Courtesy of brilliant programmer The trick, a fix has finally been identified for use of the callbacks in VBA 64bit. Note: You must update mTDHelper.bas too. 62 | 63 | (23 Nov 2022) Updated to version 1.2.4. Fixed improper VarPtr calls in VBA7x64 routines. 64 | 65 | (26 Oct 2022) Updated to version 1.2.3. Fixed positioning bug on some systems. This occured when system visual effects were disabled, which changed the size immediately when the class expected to be able to compare against the old size. Thanks to Wayne Phillips for figuring this out! 66 | 67 | (24 Oct 2022) Updated to version 1.2.2. Fixed the issues with the logo, height after expando closed, and font sizes. Positioning issue is proving difficult so might take a little longer; wanted to fix what I could now. The Logo Demo in the twinBASIC project now shows loading a larger logo image based on current DPI (queried from the control, you don't need to implement it), and the Init routine now sets a default date/time that's returned if the datetime is unchecked (it would previously return a date in 1999... seemed wrong. But you shouldn't consider it valid if not checked, when checkboxes are enabled). 68 | 69 | ### LongPtr in VB6/VBA? 70 | You'll need to add LongPtr support to use this codebase in VB6/VBA6. [This thread](https://www.vbforums.com/showthread.php?898078-Typelib-to-add-LongPtr-type-to-VB6-for-universal-codebases) provides two methods: via a typelib with an alias, or via an enum. For simplicity this project currently uses the Enum method (defined in modHelper.bas). 71 | 72 | ### Requirements 73 | This project will work with VB6, VBA6, VBA7 x86/x64, and twinBASIC x86/x64,. Regardless of the project type, you'll need Common Controls 6.0 enabled via manifest. 74 | 75 | For twinBASIC, you'll need at least Beta 108 (when the PackingAlignment option was added), but at least 154 is recommended due to earlier versions sometimes producing an erroneous error message that GetSystemImageList is ambiguous. If you do use it with an earlier version, restarting the compiler will get rid of that error. [twinBASIC Releases](https://github.com/twinbasic/twinbasic/releases) 76 | 77 | ### Source Code 78 | The class itself can be found in the Export\Sources folder, along with the exported twinBASIC Demo form. The Export\Resources folder has a manifest for comtl6 if you need it. 79 | 80 | To use this outside of twinBASIC, you'll need cTaskDialog.cls and modTDHelper.bas from the Export\Sources folder. Both must be added to a project. 81 | 82 | ### Customizations 83 | This class is more than just a straight implementation of the native features (though it supports all of those and can be used with just a few lines for very simply dialogs), it also features custom flags that add additional control types: TextBox, ComboBox (with images), Date/Time, and Slider, all of which can be positioned in either the top region, by the buttons, or in the footer, and can be mixed and matched with eachother and all the built in features. There's also an option to add a logo image in the top right and a few other places. Follow the link to the VBForums thread up top for more pictures and demos of how these work (all the demos are in the Demo Project in the source). 84 | 85 | ![Screenshot4](https://i.imgur.com/1ApJRg1.jpg) ![Screenshot5](https://i.imgur.com/RW6XlJh.jpg) 86 | 87 | ![Screenshot6](https://i.imgur.com/FGIPojS.jpg) ![Screenshot6](https://i.imgur.com/xcbkWSB.jpg) 88 | 89 | -------------------------------------------------------------------------------- /cTaskDialog-x86Only.twinproj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/cTaskDialog-x86Only.twinproj -------------------------------------------------------------------------------- /cTaskDialog.twinproj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/cTaskDialog.twinproj -------------------------------------------------------------------------------- /cTaskDialog.vbp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/cTaskDialog.vbp -------------------------------------------------------------------------------- /disc24.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/disc24.png -------------------------------------------------------------------------------- /disc256.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/disc256.png -------------------------------------------------------------------------------- /disc32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/disc32.png -------------------------------------------------------------------------------- /disc48.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/disc48.png -------------------------------------------------------------------------------- /editpaste.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/editpaste.ico -------------------------------------------------------------------------------- /mTDHelper.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "mTDHelper" 2 | Option Explicit 3 | 'mTDHelper: Helper module for cTaskDialog.cls 4 | 'Must be included with the class. 5 | #If (VBA7 = 0) Then 'Adds LongPtr variable support to VB6 6 | Public Enum LongPtr 7 | [_] 8 | End Enum 9 | #End If 10 | Public Sub MagicalTDInitFunction() 11 | 'The trick is a GENIUS! 12 | 'He identified the bug in VBA64 that had been causing the crashing. 13 | 'As if by magic, calling this from Class_Initialize resolves the problem. 14 | End Sub 15 | Public Function TaskDialogCallbackProc(ByVal hwnd As LongPtr, ByVal uNotification As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal lpRefData As cTaskDialog) As LongPtr 16 | TaskDialogCallbackProc = lpRefData.zz_ProcessCallback(hwnd, uNotification, wParam, lParam) 17 | End Function 18 | Public Function TaskDialogEnumChildProc(ByVal hwnd As LongPtr, ByVal lParam As cTaskDialog) As Long 19 | TaskDialogEnumChildProc = lParam.zz_ProcessEnumCallback(hwnd) 20 | End Function 21 | Public Function TaskDialogSubclassProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As cTaskDialog) As LongPtr 22 | TaskDialogSubclassProc = dwRefData.zz_ProcessSubclass(hwnd, uMsg, wParam, lParam, uIdSubclass) 23 | End Function -------------------------------------------------------------------------------- /mTDSample.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "mTDSample" 2 | Option Explicit 3 | 'mTDSample.bas 4 | 'Module for cTaskDialog Demo 5 | 'This module is only required for some actions performed by the demos 6 | 'It is not required to use cTaskDialog.cls. 7 | 8 | 9 | 10 | 'Icon code was mostly written by Leandro Ascierto, from his clsMenuImage. 11 | 'I've simply modified the resource->hicon function to stand alone 12 | #If VBA7 Then 13 | Public Declare PtrSafe Function DestroyIcon Lib "user32.dll" (ByVal hIcon As LongPtr) As Long 14 | Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) 15 | Private Declare PtrSafe Function CreateIconFromResourceEx Lib "user32.dll" (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As LongPtr 16 | Private Declare PtrSafe Function CreateIconFromResource Lib "user32.dll" (ByVal presbits As LongPtr, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long) As LongPtr 17 | Private Declare PtrSafe Function LookupIconIdFromDirectoryEx Lib "user32.dll" (ByVal presbits As LongPtr, ByVal fIcon As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long 18 | Private Declare PtrSafe Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As SHGFI_flags) As LongPtr 19 | Public Declare PtrSafe Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal FileName As LongPtr, GpImage As LongPtr) As Long 20 | Public Declare PtrSafe Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As LongPtr, Width As Long) As Long 21 | Public Declare PtrSafe Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As LongPtr, Height As Long) As Long 22 | Public Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long 23 | Public Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long 24 | Public Declare PtrSafe Function GdiplusStartup Lib "gdiplus" (ByRef token As LongPtr, ByRef lpInput As GdiplusStartupInput, ByRef lpOutput As Long) As Long 25 | Public Declare PtrSafe Function GdiplusShutdown Lib "gdiplus" (ByVal token As LongPtr) As Long 26 | Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr 27 | Public Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long 28 | Public Declare PtrSafe Function LoadImageA Lib "user32" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal dwImageType As ImageTypes, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As LoadResourceFlags) As LongPtr 29 | #Else 30 | Public Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As LongPtr) As Long 31 | Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) 32 | Private Declare Function CreateIconFromResourceEx Lib "user32.dll" (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As LongPtr 33 | Private Declare Function CreateIconFromResource Lib "user32.dll" (ByVal presbits As LongPtr, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long) As LongPtr 34 | Private Declare Function LookupIconIdFromDirectoryEx Lib "user32.dll" (ByVal presbits As LongPtr, ByVal fIcon As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long 35 | Private Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As SHGFI_flags) As LongPtr 36 | Public Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal FileName As LongPtr, GpImage As LongPtr) As Long 37 | Public Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As LongPtr, Width As Long) As Long 38 | Public Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As LongPtr, Height As Long) As Long 39 | Public Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long 40 | Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long 41 | Public Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As LongPtr, ByRef lpInput As GdiplusStartupInput, ByRef lpOutput As Long) As Long 42 | Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As LongPtr) As Long 43 | Public Declare Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr 44 | Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long 45 | Public Declare Function LoadImageA Lib "user32" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal dwImageType As ImageTypes, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As LoadResourceFlags) As LongPtr 46 | #End If 47 | Public gdipInitToken As LongPtr 48 | Private Const MAX_PATH = 260 49 | 50 | Private Type IconHeader 51 | ihReserved As Integer 52 | ihType As Integer 53 | ihCount As Integer 54 | End Type 55 | 56 | Private Type IconEntry 57 | ieWidth As Byte 58 | ieHeight As Byte 59 | ieColorCount As Byte 60 | ieReserved As Byte 61 | iePlanes As Integer 62 | ieBitCount As Integer 63 | ieBytesInRes As Long 64 | ieImageOffset As Long 65 | End Type 66 | Private Type SHFILEINFO ' shfi 67 | hIcon As Long 68 | iIcon As Long 69 | dwAttributes As Long 70 | szDisplayName As String * MAX_PATH 71 | szTypeName As String * 80 72 | End Type 73 | Public Enum SHGFI_flags 74 | SHGFI_LARGEICON = &H0 ' sfi.hIcon is large icon 75 | SHGFI_SMALLICON = &H1 ' sfi.hIcon is small icon 76 | SHGFI_OPENICON = &H2 ' sfi.hIcon is open icon 77 | SHGFI_SHELLICONSIZE = &H4 ' sfi.hIcon is shell size (not system size), rtns BOOL 78 | SHGFI_PIDL = &H8 ' pszPath is pidl, rtns BOOL 79 | ' Indicates that the function should not attempt to access the file specified by pszPath. 80 | ' Rather, it should act as if the file specified by pszPath exists with the file attributes 81 | ' passed in dwFileAttributes. This flag cannot be combined with the SHGFI_ATTRIBUTES, 82 | ' SHGFI_EXETYPE, or SHGFI_PIDL flags <---- !!! 83 | SHGFI_USEFILEATTRIBUTES = &H10 ' pretend pszPath exists, rtns BOOL 84 | SHGFI_ICON = &H100 ' fills sfi.hIcon, rtns BOOL, use DestroyIcon 85 | SHGFI_DISPLAYNAME = &H200 ' isf.szDisplayName is filled (SHGDN_NORMAL), rtns BOOL 86 | SHGFI_TYPENAME = &H400 ' isf.szTypeName is filled, rtns BOOL 87 | SHGFI_ATTRIBUTES = &H800 ' rtns IShellFolder::GetAttributesOf SFGAO_* flags 88 | SHGFI_ICONLOCATION = &H1000 ' fills sfi.szDisplayName with filename 89 | ' containing the icon, rtns BOOL 90 | SHGFI_EXETYPE = &H2000 ' rtns two ASCII chars of exe type 91 | SHGFI_SYSICONINDEX = &H4000 ' sfi.iIcon is sys il icon index, rtns hImagelist 92 | SHGFI_LINKOVERLAY = &H8000& ' add shortcut overlay to sfi.hIcon 93 | SHGFI_SELECTED = &H10000 ' sfi.hIcon is selected icon 94 | SHGFI_ATTR_SPECIFIED = &H20000 ' get only attributes specified in sfi.dwAttributes 95 | End Enum 96 | Public Type GdiplusStartupInput 97 | GdiplusVersion As Long 98 | DebugEventCallback As LongPtr 99 | SuppressBackgroundThread As Long 100 | SuppressExternalCodecs As Long 101 | End Type 102 | 103 | Public Enum ImageTypes 104 | IMAGE_BITMAP = 0 105 | IMAGE_ICON = 1 106 | IMAGE_CURSOR = 2 107 | IMAGE_ENHMETAFILE = 3 108 | End Enum 109 | Public Enum LoadResourceFlags 110 | LR_DEFAULTCOLOR = &H0 111 | LR_MONOCHROME = &H1 112 | LR_COLOR = &H2 113 | LR_COPYRETURNORG = &H4 114 | LR_COPYDELETEORG = &H8 115 | LR_LOADFROMFILE = &H10 116 | LR_LOADTRANSPARENT = &H20 117 | LR_DEFAULTSIZE = &H40 118 | LR_VGACOLOR = &H80 119 | LR_LOADMAP3DCOLORS = &H1000 120 | LR_CREATEDIBSECTION = &H2000 121 | LR_COPYFROMRESOURCE = &H4000 122 | LR_SHARED = &H8000& 123 | End Enum 124 | 125 | 126 | Public Function InitGDIPlus() As LongPtr 127 | Dim Token As LongPtr 128 | Dim gdipInit As GdiplusStartupInput 129 | 130 | gdipInit.GdiplusVersion = 1 131 | GdiplusStartup Token, gdipInit, ByVal 0& 132 | InitGDIPlus = Token 133 | End Function 134 | 135 | ' Frees GDI Plus 136 | Public Sub FreeGDIPlus(Token As LongPtr) 137 | GdiplusShutdown Token 138 | End Sub 139 | Public Function hBitmapFromFile(PicFile As String, Width As Long, Height As Long, Optional ByVal BackColor As Long = vbWhite, Optional RetainRatio As Boolean = False) As LongPtr 140 | Dim hDC As LongPtr 141 | Dim hBitmap As LongPtr 142 | Dim Img As LongPtr 143 | 144 | If gdipInitToken = 0 Then 145 | gdipInitToken = InitGDIPlus() 146 | End If 147 | ' Load the image 148 | If GdipLoadImageFromFile(StrPtr(PicFile), Img) <> 0 Then 149 | ' Err.Raise 999, "GDI+ Module", "Error loading picture " & PicFile 150 | Exit Function 151 | End If 152 | Debug.Print "gdip himage=" & Img 153 | GdipCreateHBITMAPFromBitmap Img, hBitmap, &H0 154 | ' Calculate picture's width and height if not specified 155 | ' If Width = -1 Or Height = -1 Then 156 | ' GdipGetImageWidth Img, Width 157 | ' GdipGetImageHeight Img, Height 158 | ' End If 159 | ' 160 | ' ' Initialise the hDC 161 | ' InitDC hDC, hBitmap, BackColor, Width, Height 162 | ' 163 | ' ' Resize the picture 164 | ' 'gdipResize Img, hDC, Width, Height, RetainRatio 165 | ' gdipDrawCentered Img, hDC, Width, Height, True 166 | GdipDisposeImage Img 167 | ' 168 | ' ' Get the bitmap back 169 | ' GetBitmap hDC, hBitmap 170 | 171 | hBitmapFromFile = hBitmap 172 | End Function 173 | 174 | 175 | 176 | 177 | Public Function ResIconToHICON(id As String, Optional CX As Long = 24, Optional CY As Long = 24) As LongPtr 178 | 'returns an hIcon from an icon in the resource file 179 | 'Icons must be added as a custom resource 180 | 181 | Dim tIconHeader As IconHeader 182 | Dim tIconEntry() As IconEntry 183 | Dim MaxBitCount As Long 184 | Dim MaxSize As Long 185 | Dim Aproximate As Long 186 | Dim IconID As Long 187 | Dim hIcon As LongPtr 188 | Dim i As Long 189 | Dim bytIcoData() As Byte 190 | 191 | On Error GoTo e0 192 | 193 | bytIcoData = LoadResData(id, "CUSTOM") 194 | 195 | Call CopyMemory(tIconHeader, bytIcoData(0), Len(tIconHeader)) 196 | 197 | If tIconHeader.ihCount >= 1 Then 198 | 199 | ReDim tIconEntry(tIconHeader.ihCount - 1) 200 | 201 | Call CopyMemory(tIconEntry(0), bytIcoData(Len(tIconHeader)), Len(tIconEntry(0)) * tIconHeader.ihCount) 202 | 203 | IconID = -1 204 | 205 | For i = 0 To tIconHeader.ihCount - 1 206 | If tIconEntry(i).ieBitCount > MaxBitCount Then MaxBitCount = tIconEntry(i).ieBitCount 207 | Next 208 | 209 | 210 | For i = 0 To tIconHeader.ihCount - 1 211 | If MaxBitCount = tIconEntry(i).ieBitCount Then 212 | MaxSize = CLng(tIconEntry(i).ieWidth) + CLng(tIconEntry(i).ieHeight) 213 | If MaxSize > Aproximate And MaxSize <= (CX + CY) Then 214 | Aproximate = MaxSize 215 | IconID = i 216 | End If 217 | End If 218 | Next 219 | 220 | If IconID = -1 Then Exit Function 221 | 222 | With tIconEntry(IconID) 223 | hIcon = CreateIconFromResourceEx(bytIcoData(.ieImageOffset), .ieBytesInRes, 1, &H30000, CX, CY, &H0) 224 | If hIcon <> 0 Then 225 | ResIconToHICON = hIcon 226 | End If 227 | End With 228 | 229 | End If 230 | 'Debug.Print "Res hIcon=" & hIcon 231 | 232 | On Error GoTo 0 233 | Exit Function 234 | 235 | e0: 236 | Debug.Print "modIcon.ResIconTohIcon.Error->" & Err.Description & " (" & Err.Number & ")" 237 | 238 | End Function 239 | 240 | Public Function IconToHICON(IcoData() As Byte, DesiredX As Long, DesiredY As Long) As LongPtr 241 | Dim lPtrSrc As Long, lPtrDst As Long, lID As Long 242 | Dim icDir() As Byte, LB As Long 243 | Dim tIconHeader As IconHeader 244 | Dim tIconEntry As IconEntry 245 | Dim ICRESVER As Long 246 | ICRESVER = &H30000 247 | LB = LBound(IcoData) ' just in case a non-zero LBound array passed 248 | ' convert 16 byte IconDir to 14 byte IconDir 249 | CopyMemory tIconHeader, IcoData(LB), Len(tIconHeader) 250 | ReDim icDir(0 To tIconHeader.ihCount * Len(tIconEntry) + Len(tIconHeader) - 1&) 251 | CopyMemory icDir(0), tIconHeader, Len(tIconHeader) 252 | lPtrDst = Len(tIconHeader) 253 | lPtrSrc = LB + lPtrDst 254 | For lID = 1& To tIconHeader.ihCount 255 | CopyMemory tIconEntry, IcoData(lPtrSrc), 12& ' size of standard tIconEntry less last 4 bytes 256 | tIconEntry.ieImageOffset = lID 257 | CopyMemory icDir(lPtrDst), tIconEntry, 14& ' size of DLL tIconEntry 258 | lPtrDst = lPtrDst + 14&: lPtrSrc = lPtrSrc + Len(tIconEntry) 259 | Next 260 | lID = LookupIconIdFromDirectoryEx(VarPtr(icDir(0)), True, DesiredX, DesiredY, 0&) 261 | Erase icDir() 262 | If lID > 0& Then 263 | CopyMemory tIconEntry, IcoData(LB + (lID - 1&) * Len(tIconEntry) + Len(tIconHeader)), Len(tIconEntry) 264 | 265 | IconToHICON = CreateIconFromResource(VarPtr(IcoData(LB + tIconEntry.ieImageOffset)), tIconEntry.ieBytesInRes, True, ICRESVER) 266 | End If 267 | End Function 268 | Public Function LoadIcoFile(sFile As String) As Byte() 269 | Dim f As Long 270 | 'Dim b() As Byte 271 | 272 | f = FreeFile() 273 | Open sFile For Binary As f 274 | ReDim LoadIcoFile(LOF(f)) 275 | Get f,, LoadIcoFile 276 | Close f 277 | End Function 278 | Public Function GetSystemImagelist(uSize As Long) As LongPtr 279 | Dim sfi As SHFILEINFO 280 | Dim wd As String 281 | wd = Environ("WINDIR") 282 | wd = Left(wd, 3) 283 | ' Any valid file system path can be used to retrieve system image list handles. 284 | GetSystemImagelist = SHGetFileInfo(wd, 0, sfi, Len(sfi), SHGFI_SYSICONINDEX Or uSize) 285 | End Function 286 | 287 | #If False Then 288 | Dim SHGFI_LARGEICON, SHGFI_SMALLICON, SHGFI_OPENICON, SHGFI_SHELLICONSIZE, SHGFI_PIDL, _ 289 | SHGFI_USEFILEATTRIBUTES, SHGFI_ICON, SHGFI_DISPLAYNAME, SHGFI_TYPENAME, SHGFI_ATTRIBUTES, _ 290 | SHGFI_ICONLOCATION, SHGFI_EXETYPE, SHGFI_SYSICONINDEX, SHGFI_LINKOVERLAY, SHGFI_SELECTED, _ 291 | SHGFI_ATTR_SPECIFIED 292 | #End If 293 | 294 | -------------------------------------------------------------------------------- /td.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/td.res -------------------------------------------------------------------------------- /vbf.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/vbf.bmp -------------------------------------------------------------------------------- /vbf.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/vbf.gif -------------------------------------------------------------------------------- /vbf.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/vbf.jpg -------------------------------------------------------------------------------- /vbf2.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fafalone/cTaskDialog64/6148ca3af9b01694b79a66eab83df69327899171/vbf2.bmp --------------------------------------------------------------------------------