-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy pathcTaskDialog.cls
5034 lines (4705 loc) · 199 KB
/
cTaskDialog.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cTaskDialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'************************************************************
'cTaskDialog v1.5 R2 Universal Compatibility Version
'by Jon Johnson (aka fafalone)
'
'https://github.com/fafalone/cTaskDialog64
'
'https://www.vbforums.com/showthread.php?777021
'
'Originally Released 21 March 2020
'x64 Version released 21 October 2022; update 27 Mar 2025
'************************************************************
'
'
'Provides a full implementation of TaskDialogIndirect and extensive enhancements.
'
'Code may be modified, reused, republished.. anything as long as credit is given
'
'Some enums and declarations originally written by Randy Birch at VBNet and Julius Laslo at vb@rchiv
'
'This version is compatible with VB6, VBA6, VBA7 32/64bit, and twinBASIC 32/64bit.
'*********************************
'USAGE
'For full details on usage and support, see the development thread at VBForums:
'http://www.vbforums.com/showthread.php?777021
'The thread contains detailed samples complete with images for all features.
'Submit any bug reports in that thread as well, or on this project's GitHub:
'https://github.com/fafalone/cTaskDialog64
'
'*************************************************
'REQUIREMENTS
'--Common Controls 6.0 are required. This class will attempt to activate it without
' a manifest present, but it's strongly recommended you use one as this features
' relies on the undocumented presence of a manifest we can borrow from shell32.dll,
' to avoid needing to distribute a separate file with this class.
'
'--mTaskDialogHelper must be added to your project. While twinBASIC supports AddressOf on
' class members, I wanted to retain VBA support too.
'
'--The TaskDialogIndirect API is only available on Windows Vista and newer.
'
'*************************************************
'VERSION HISTORY
'Version 1.5.2 (1.5 R2)
'-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.
'-Helper module has been condensed back to the original compact form; it was only expanded
' while trying to find a VBA bug workaround now solved by MagicalTDInitFunction.
'-Bug fix: zzGetCommonButtonIcon and ResultComboData Long instead of LongPtr.
'-Corrected misc spelling mistakes highlighted by the AccessUI version :)
'
'Version 1.5.0
' - Class will now attempt to use comctl32.dll 6.0 in the absence of a manifest, since
' it's impractical 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.
'
' - Added lParam options for AddComboItem; obtain from result with ResultComboData.
'
' - Custom icons were broken in the main demo project (no issue in this class)
'
' - ComboNewIndex property to provide the last added combo item index.
'
'Version 1.4.0
'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:
' TDCBF_ABORT_BUTTON (TD_ABORT)
' TDCBF_IGNORE_BUTTON (TD_IGNORE)
' TDCBF_TRYAGAIN_BUTTON (TD_TRYAGAIN)
' TDCBF_CONTINUE_BUTTON (TD_CONTINUE)
' TDCBF_HELP_BUTTON **This will raise the Help event, and will not close the dialog.**
'
'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.
'
'
'Version 1.3.8 - Custom button handling for VBA 7 x64 has now been implemented.
'
'Version 1.3.7 **REALLY UNIVERSAL**!!
'Thanks to brilliant VBForums user The trick, the crashing in VBA64 has been eliminated
'after a bug in VBA was discovered and a workaround found.
'ADVANCED PROGRAMMERS TAKE NOTE: This likely has broader applicability. If you're experiencing
' crashing in ordinary module-based callbacks or subclassing, apply the same fix as here:
' Call an unused dummy sub in the module from Class_Initialize before doing anything else.
'
'Version 1.2.6 Universal
'Bug fix: SimpleDialog return TDBUTTONS instead of TDRESULT
'
'
'Version 1.2.5 Universal
'Bug fix: Numerous bug fixes to VBA calls and unsupported App. items while in VBA. The code to
' call it in VBA7 has also been substantially simplified.
'
'Version 1.2.4 Universal
'Bug fix: VBA calls in ShowDialog/NavigatePage incorrectly pointed to array instead of 1st item.
'
'Version 1.2.3 Universal
'Bug fix: Resolved incorrect positioning on some systems. This occurred when system visual effects
' for window min/max were disabled, preventing getting the previous size after being
' notified of the expando click.
'
'Version 1.2.2 Universal
'-The Init routine now sets the default date/time
'-The Logo B demo now shows querying the DPI to load a larger image for scaling > 100%.
'Bug fix: Various corrections for scaling >100%, including systems where the default GUI font from
' GetStockObject and WM_GETFONT didn't apply DPI scaling.
'Bug fix: Multi-page navigation back to a previous page causes behavior differences.
'Bug fix: Somehow a typo changed a - to an = in AddLogoImage, breaking right alignment positioning
' and transparency.
'
'Version 1.2.1 Universal
'Bug fix: Commented out PackingAlignment attribute for non-twinBASIC projects and implemented
' manually packed/set structure for VBA7/64, the only place where extra alignment bytes
' would get inserted and break it.
'
'Version 1.2 R2 x64
'-Combos in DropDownList style now also report text.
'-(Bug fix) Multiple pages having their events directed to the first page was actually a bug,
' not an unavoidable feature. Now, all events (including Navigated) fire in the page
' itself. The multi-page demos have been updated to reflect this, please check your
' code to adjust it if you're using this feature.
'
'Version 1.2 Release 2 (R2)
'--Bug fix: Quick bug fix for footer icons not redrawing when changed during runtime.
'
'NEW IN VERSION 1.2
'--Since it turns out, when you navigate to a new page, it doesn't activate the new TaskDialog
' object, it just takes the settings and applies them to the original object. So the outcome
' of this was that only the settings that are part of the native TaskDialog would be applied,
' and see also the bugfix related to sending messages to active dialogs. Any of the custom
' features wouldn't get applied. All settings are transferred now.
' NOTE: Since this has to be done by overwriting the current configuration set, if you move
' back to an earlier page, you'll need to reset the settings first. All of them, not just
' customizations.
'--Added InputBoxTextAlign property to set left/right/center alignment.
'--Added User Options section below this changelog that includes a boolean for whether to print
' debug messages in the immediate window, and whether to include the date/time if it does. Also
' added an option for the minimum level of message to show, but so far no debug messages in the
' project are set to a different level.
'--Bug fix: Flag for DateTime and Slider were assigned same value.
'--Bug fix: Input box should have had ES_AUTOHSCROLL set.
'--Bug fix: In ClickVerification, it used the message for a button click, which led to either
' closing the dialog or doing nothing, instead of TDM_CLICK_VERIFICATION, the correct
' message to send for modifying the checkbox through code.
'--Bug fix: Navigating to a new page zero'd the hWnd on the expectation it would change, but
' this expectation was incorrect. It shouldn't be zero'd and any action applied should
' be sent to the main TaskDialog object, the API messages will apply to the current
' page. E.g. TaskDialog1 is the first page, which loads a second page with object
' TaskDialog2. When navigating to TaskDialog2, TaskDialog1 receives a Navigated() event,
' and if TaskDialog2 has a marquee progress bar, call TaskDialog1.ProgressStartMarquee.
'
'NEW IN VERSION 1.1
'--The cTaskDialog class is now entirely self-contained- using Paul Caton/LaVolpe's self-sub
' self-callback routines to eliminate the need for a module or presence of the TaskDialog__Procs.
'--Additional left-right-center alignment for custom controls has been added. For the additions,
' they are only relevant if the control is being used with a fixed width. Given this, automatic
' prevention of only allowing 1 control per location has been disabled-- however, it is the on
' the caller to ensure there's no overlap.
'--To further aid in this, you can now specify a manual offset with .(control)OffsetX that is
' added to the default offset after alignment calculation. Note that for right alignment, to get
' the control farther to the left, you'd want to make this a negative number.
'--ComboText now also a let that sets the text. This does not add an item and cannot set an image
' if an imagelist is in use; for those features use ComboSetCurrentState
'--Added Get/Let for Combo dropdown width (.ComboDropWidth). Returns 0 unless previously set. Can
' modify an open dialog.
'--Bug fix: TDF_NO_SET_FOREGROUND flag, which was added in Windows 8, was missing.
'--Bug fix: Alignment issues with certain flags with the DateTime control when placed in the footer.
'--Bug fix: Flag conflicts with built in ones and omitted flags. Fixed.
'
'NEW IN VERSION 1.0
'--You can now make a custom button into a Split Button (dropdown arrow). Use .SetSplitButton
' with the ID of the custom button. This fires a DropdownButtonClicked event. Cannot be used
' with Command Links. Note there's one more function prototype in mTaskDialogHelper you'll
' need to copy if you're placing those in your own module (they've been condensed too so the
' whole thing is only 3 lines now).
'--A logo type image can now be placed with .SetLogoImage. The current placement options are
' the top right corner, or next to the buttons (only if no controls, either custom or the
' expando/verify are present). The image is passed as an HBITMAP or HICON, so you can load
' in whichever way you want. No copy is made, so you must destroy the image yourself, but
' only after the dialog closes (or it will not appear).
'--Autoclose has been implemented. Set the .AutocloseTime property to a value in seconds; when
' you get the property, it returns the current time remaining.
'--Events for custom controls: ComboItemChanged, ComboDropdown, InputBoxChange, DateTimeChange
'--Custom controls now have the option to manually set their width (and height for combo).
'--Custom controls in the Buttons position now have their width adjusted to fill the space.
' Custom controls in the Footer position still use a standard size, however for InputBox,
' ComboBox, and Slider if you specify a width of -1 the width will scale to the full width
'--For custom controls in the footer area, and the datetime control in the content area, there's
' an additional alignment option to choose between left, center, and right. In the footer area
' this could be used to show footer text and have the control off to the right.
'--Focus is no longer always on an InputBox: Focus is set on whatever custom control is in the
' content area, if none button area, last footer area. Or, there's now a .DefaultCustomControl
' option to manually specify which one, or not have focus set on any of them.
'--Bug fix: Several fixes relating to alignment and events for custom controls used on dialogs
' that are loaded as a new page (NavigatePage/TDN_NAVIGATED)
'--Bug fix: .DefaultButton used TDBUTTONS instead of TDRESULT enum to identify IDs
'--Bug fix: .DefaultRadioButton was incorrectly associated with the TDBUTTONS enum
'--Alignment: -Adjusted Content area custom controls slightly higher when expanded
' info is used.
' -Custom controls in content area now have an appropriate X-position and width when
' no icon appears, shifting everything to the left.
' -Made sure that content text actually had a link before making the link adjustment,
' since the flag would still be used if there's a link only in the footer area.
' -When there's a link but no command links or radio buttons, content area controls
' needed to be adjusted upwards a bit.
'--Alignment: -Custom controls size and position is now automatically adjust for the current DPI.
' -You can also specify a scale factor manually with the DPIScaleX/DPIScaleY properties.
'KNOWN ISSUES: -If there's a custom control in the content area, when an expando control is expanded
' and then collapsed, the excess whitespace isn't removed despite there not being any
' extra vbCrLf's to account for it. No way to correct this has been discovered yet.
' -If the dialog has to be resized in response to an expando control, the width is
' reduced by several pixels for an unknown reason- but only on the first time. If the
' numbers returned by getting the client RECT were wrong, you'd expect to lose more
' pixels every time, but that's not the case. No solution has been discovered.
' -Some alignment scenarios remain unsupported. If expando with the expand-footer w/
' expand-default, have text with multiple lines, alignment will be off. This remains
' a significant challenge to address as the DirectUIHWND reports incorrect information
' to GetPixel, so figuring out where things are will require font height analysis and
' reverse engineering line break length determination. Will work on in next version.
' -Sliders with ticks on top and bottom simply don't fit on higher DPIs in the footer
' position. Height available is too small no matter how it's positioned.
'----------------------------------------------------------------------------------------------------
'NEW IN VERSION 0.8
'--Added ability to use comboboxes (normal edit dropdown and dropdown list), date/time pickers,
' and sliders like the inputbox controls.
'--There's still the 3 alignment positions from the inputbox, so you can have controls in each
' of these places (however, only 1 of each type is allowed)
'--When TDF_KILL_SHIELD_ICON is used, there's now an option to replace it with a different icon:
' Set .IconReplaceGradient...
' 1) To an ID in your app's resource file (only works when compiled)
' 2) Add the TDF_USE_SHELL32_ICONID or TDF_USE_IMAGERES_ICONID flag and use an ID from those
' 3) Set .hInst to a custom module and use an icon ID from that
' Using an hIcon is not supported at this time.
'--Bug fix: Using TDF_KILL_SHIELD_ICON and calling .Init crashed the app
'--Bug fix: Using an InputBox at the footer position, the bottom half was cut off if no
' footer icon was set.
'--Bug fix: Input box position adjusted for expando only if in the content position, now adjusts
' if in footer position too. Prevented this bug in all other controls.
'--Bug fix: If input box was in footer position, and expanded info was expanded automatically
' and into the footer area, the input box would be in the wrong position. Fixed and
' prevented for new controls.
'KNOWN ISSUE: If the slider control is placed in the footer position and an expando control is
' set to expand into the footer area, the transparent background on the slider is
' lost (turns white) until it's clicked. It's a very unusual and specific situation,
' so not going to delay this version while I come up with a fix.
'TODO:
'The next version will be 1.0. There's a couple major features planned, including images and more
'events (for the custom controls). Maybe more controls; like dropdown menus on the buttons.
'I'm very aware this class needs substantial cleanup, that's also being saved for 1.0
' So please go easy on the sloppiness!!! :)
'
'---------------------------------------------------------------------------------------------------
'NEW IN VERSION 0.7
'--Input boxes! See details below for the TDF_INPUT_BOX custom flag.
'--Added flag TDF_KILL_SHIELD_ICON - kill it but keep that colored background.
'--Fixed bug where updating the footer icon in an open dialog instead updated the main icon
'NEW IN VERSION 0.6.1
'--Can't believe I forgot the TDF_SIZE_TO_CONTENT flag.
'NEW IN VERSION 0.6
'--Support for custom icons on the buttons themselves
'0.5.2: critical bugfixes
'NEW IN VERSION 0.5.1
'--Added a force case function for the enums; they'll be automatically cased like normal now
' while in the IDE
'--Bugfix: If a dialog was called as a new page, setting holds/disabled/elevated automatically
' did not work.
'--Bugfix: When navigating to a new page, the old hWnd was not cleared, leading to some calls
' not working properly.
'--Customized the progressbarstate enum since it's likely to conflict; if you use a PBST_ var,
' it needs to be changed to ePBST, if it wasn't publicly declared outside this class
'NEW IN VERSION 0.5
'--Added support for multiple pages
'NEW IN VERSION 0.4.1
'--Added queueing for EnableButton, EnableRadioButton, and SetButtonElevated: now you can
' disable or elevate a button before the dialog is shown and it will be done automatically
'NEW IN VERSION 0.4
'--Added support for TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE; which adds the security shield
' to a button indicated elevated user permission is required to perform the action
'--Added a SimpleDialog function to show the original TaskDialog() for very simple messages;
' it can be a drop-in replacement for MsgBox, taking the common Message,Buttons,Title in
' the same order
'--Set default dialog title to App.Title. If NULL is passed, it shows the exe name rather
' than a blank string; and vb6.exe when in the IDE.
'--Misc minor bugfixes
'NEW IN VERSION 0.3.2/3
'Some internal improvements suggested by Bonnie West on VBForums. Also minor bugfixes.
'NEW IN VERSION 0.3.1
'Bugfixes; now use LoadLibrary instead of GetModuleHandle, which may fail in some circumstances
'NEW IN VERSION 0.3
'Automated the process of not closing the dialog when a button is clicked
'Uses .SetButtonHold and .ReleaseButtonHold
'NEW IN VERSION 0.2
'Schmidt gave me the brilliant idea to make using icons from shell32.dll and imageres.dll
'possible simply by setting .hInstance to their handle and specifying the index.
'See the new custom flags, and the readme for full details
'*******************************************************************************
'USER OPTIONS : Configuration for developers using this class.
Private Const useropt_dbg_PrintToImmediate As Boolean = False
Private Const useropt_dbg_MinLevel As Long = 0&
Private Const useropt_dbg_IncludeDateTime As Boolean = True
Private Const useropt_no_force_comctl6 As Boolean = False 'Don't use activation context API
'********************************************************************************
Private Const WM_USER = &H400&
Private Const S_OK = 0
Private Const S_FALSE = 1&
Private Const CSIDL_SYSTEM = &H25
Public Const MAX_PATH As Long = 260
Private Const IDD_EDIT1 = 101&
Private Const IDD_DT1 = 102&
Private Const IDD_DT2 = 103&
Private Const IDD_COMBO = 104&
Private Const IDD_SLIDER = 105&
Private Const WS_EX_CLIENTEDGE = &H200
Private Const WS_EX_LEFT As Long = &H0&
Private Const WS_EX_LTRREADING As Long = &H0&
Private Const WS_EX_RIGHTSCROLLBAR As Long = &H0&
Private Const WS_EX_TRANSPARENT = &H20
Private Const WS_EX_LAYERED = &H80000
Private Const DEFAULT_GUI_FONT = 17
Private Const WM_SETFONT As Long = &H30
Private Const WM_GETFONT = &H31
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT As Long = &HC
Private Const WM_COMMAND = &H111
Private Const WM_NOTIFY = &H4E
Private Const WM_HSCROLL = &H114
Private Const WM_DESTROY = &H2
Private Const WM_CTLCOLORSTATIC As Long = &H138
Private Const BM_SETIMAGE = &HF7
Private Const EM_SETSEL As Long = &HB1
Private Const ECM_FIRST As Long = &H1500
Private Const EM_SETCUEBANNER As Long = (ECM_FIRST + 1)
Private Const ES_LEFT = &H0
Private Const ES_CENTER = &H1
Private Const ES_RIGHT = &H2
Private Const ES_AUTOHSCROLL As Long = &H80
Private Const ES_PASSWORD As Long = &H20
Private Const BS_SPLITBUTTON As Long = &HC
Private Const CBN_SELCHANGE = 1
Private Const CBN_DROPDOWN = 7
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const EN_CHANGE = &H300
Private Const EN_UPDATE = &H400
Private Const BCN_FIRST As Long = -1250
Private Const BCN_DROPDOWN As Long = (BCN_FIRST + 2)
Private Const H_MAX As Long = &HFFFF + 1
Private Const DTN_FIRST = (H_MAX - 760&)
Private Const DTN_LAST = (H_MAX - 799&)
Private Const DTN_DATETIMECHANGE = (DTN_FIRST + 1)
Private Const TRBN_FIRST = -1501
Private Const TRBN_THUMBPOSCHANGING = TRBN_FIRST - 1
Private Const TBS_HORZ As Long = &H0
Private Const TBS_BOTH As Long = &H8
Private Const TBS_BOTTOM As Long = &H0
Private Const TBS_TOP As Long = &H4
Private Const TBS_NOTICKS As Long = &H10
Private Const TBS_AUTOTICKS As Long = &H1
Private Const TBS_TRANSPARENTBKGND = &H1000
Private Const TBM_SETRANGEMIN As Long = (WM_USER + 7)
Private Const TBM_SETRANGEMAX As Long = (WM_USER + 8)
Private Const TBM_SETTICFREQ As Long = (WM_USER + 20)
Private Const TBM_SETLINESIZE As Long = (WM_USER + 23)
Private Const TBM_SETPAGESIZE As Long = (WM_USER + 21)
Private Const TBM_GETPOS As Long = (WM_USER)
Private Const TBM_SETPOS As Long = (WM_USER + 5)
Private Const BCM_FIRST = &H1600
Private Const BCM_SETDROPDOWNSTATE = (BCM_FIRST + &H6)
Private Const DTM_FIRST As Long = &H1000
Private Const DTM_GETSYSTEMTIME As Long = (DTM_FIRST + 1)
Private Const DTM_SETSYSTEMTIME As Long = (DTM_FIRST + 2)
Private Const DTM_SETRANGE As Long = (DTM_FIRST + 4)
Private Const STM_SETICON = &H170
Private Const STM_GETICON = &H171
Private Const STM_SETIMAGE = &H172
Private Const STM_GETIMAGE = &H173
Private Const SS_LEFT = &H0
Private Const SS_CENTER = &H1
Private Const SS_RIGHT = &H2
Private Const SS_ICON = &H3
Private Const SS_BLACKRECT = &H4
Private Const SS_GRAYRECT = &H5
Private Const SS_WHITERECT = &H6
Private Const SS_BLACKFRAME = &H7
Private Const SS_GRAYFRAME = &H8
Private Const SS_WHITEFRAME = &H9
Private Const SS_SIMPLE = &HB
Private Const SS_LEFTNOWORDWRAP = &HC
Private Const SS_BITMAP = &HE
Private Const SS_ENHMETAFILE = &HF
Private Const SS_ETCHEDHORZ = &H10
Private Const SS_ETCHEDVERT = &H11
Private Const SS_ETCHEDFRAME = &H12
Private Const SS_REALSIZECONTROL = &H40
Private Const SS_NOPREFIX = &H80
Private Const SS_NOTIFY = &H100
Private Const SS_CENTERIMAGE = &H200
Private Const SS_RIGHTJUST = &H400
Private Const SS_SUNKEN = &H1000
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type NMHDR
hWndFrom As LongPtr ' Window handle of control sending message
idFrom As LongPtr ' Identifier of control sending message
code As Long ' Specifies the notification code
End Type
Private Enum ImageTypes
IMAGE_BITMAP = 0
IMAGE_ICON = 1
IMAGE_CURSOR = 2
IMAGE_ENHMETAFILE = 3
End Enum
Private Type BITMAP
BMType As Long
BMWidth As Long
BMHeight As Long
BMWidthBytes As Long
BMPlanes As Integer
BMBitsPixel As Integer
BMBits As LongPtr
End Type
Private Enum WinStyles
WS_OVERLAPPED = &H0
WS_TABSTOP = &H10000
WS_MAXIMIZEBOX = &H10000
WS_MINIMIZEBOX = &H20000
WS_GROUP = &H20000
WS_THICKFRAME = &H40000
WS_SYSMENU = &H80000
WS_HSCROLL = &H100000
WS_VSCROLL = &H200000
WS_DLGFRAME = &H400000
WS_BORDER = &H800000
WS_CAPTION = (WS_BORDER Or WS_DLGFRAME)
WS_MAXIMIZE = &H1000000
WS_CLIPCHILDREN = &H2000000
WS_CLIPSIBLINGS = &H4000000
WS_DISABLED = &H8000000
WS_VISIBLE = &H10000000
WS_MINIMIZE = &H20000000
WS_CHILD = &H40000000
WS_POPUP = &H80000000
WS_TILED = WS_OVERLAPPED
WS_ICONIC = WS_MINIMIZE
WS_SIZEBOX = WS_THICKFRAME
' Common Window Styles
WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
WS_CHILDWINDOW = WS_CHILD
End Enum
Private Enum DTSTYLES
DTS_SHORTDATEFORMAT = &H0
DTS_UPDOWN = &H1
DTS_SHOWNONE = &H2
DTS_LONGDATEFORMAT = &H4
DTS_TIMEFORMAT = &H9
DTS_APPCANPARSE = &H10
DTS_RIGHTALIGN = &H20
DTS_SHORTDATECENTURYFORMAT = &HC
End Enum
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const GDT_ERROR As Long = -1
Private Const GDT_VALID As Long = 0
Private Const GDT_NONE As Long = 1
Private Const GDTR_MAX As Long = &H2
Private Const GDTR_MIN As Long = &H1
Public Enum SldTickStyle
SldTickStyleBottom = 0
SldTickStyleTop = 1
SldTickStyleBoth = 2
SldTickStyleNone = 3
End Enum
Private nSliderTickStyle As SldTickStyle
Public Enum eProgressBarStates
ePBST_NORMAL = 1
ePBST_ERROR = 2
ePBST_PAUSED = 3
End Enum
Public Enum TDInputBoxAlign
TDIBA_Content = 0
TDIBA_Buttons = 1
TDIBA_Footer = 2
End Enum
Public Enum TDInputBoxTextAlign
TDIBTA_Left = 0
TDIBTA_Right = 1
TDIBTA_Center = 2
End Enum
Private Enum eShowWindowTypes
SW_HIDE = 0
SW_SHOWNORMAL = 1
SW_NORMAL = 1
SW_SHOWMINIMIZED = 2
SW_SHOWMAXIMIZED = 3
SW_MAXIMIZE = 3
SW_SHOWNOACTIVATE = 4
SW_SHOW = 5
SW_MINIMIZE = 6
SW_SHOWMINNOACTIVE = 7
SW_SHOWNA = 8
SW_RESTORE = 9
SW_SHOWDEFAULT = 10
End Enum
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const WC_COMBOBOXEX = "ComboBoxEx32"
Private Const CBEM_SETIMAGELIST = (WM_USER + 2)
Private Const CBEM_GETCOMBOCONTROL = (WM_USER + 6)
Private Const CBEM_GETEDITCONTROL = (WM_USER + 7)
Private Const CBEM_SETUNICODEFORMAT = 8192 + 5
Private Const CBEM_INSERTITEMW = (WM_USER + 11)
Private Const CBEM_SETITEMW = (WM_USER + 12)
Private Const CBS_DROPDOWN = &H2&
Private Const CBS_DROPDOWNLIST = &H3&
Private Const CBS_AUTOHSCROLL = &H40
Private Const CB_GETCURSEL = &H147
Private Const CB_SETCURSEL = &H14E
Private Type COMBOBOXEXITEMW
Mask As COMBOBOXEXITEM_Mask
iItem As LongPtr
pszText As LongPtr '// LPCSTR
cchTextMax As Long
iImage As Long
iSelectedImage As Long
iOverlay As Long
iIndent As Long
lParam As LongPtr
End Type
Private Enum COMBOBOXEXITEM_Mask
CBEIF_TEXT = &H1
CBEIF_IMAGE = &H2
CBEIF_SELECTEDIMAGE = &H4
CBEIF_OVERLAY = &H8
CBEIF_INDENT = &H10
CBEIF_LPARAM = &H20
CBEIF_DI_SETITEM = &H10000000
End Enum
Private hActCtx As LongPtr
Private szSys As String
Private Enum ActivationContextFlags
ACTCTX_FLAG_PROCESSOR_ARCHITECTURE_VALID = (&H1)
ACTCTX_FLAG_LANGID_VALID = (&H2)
ACTCTX_FLAG_ASSEMBLY_DIRECTORY_VALID = (&H4)
ACTCTX_FLAG_RESOURCE_NAME_VALID = (&H8)
ACTCTX_FLAG_SET_PROCESS_DEFAULT = (&H10)
ACTCTX_FLAG_APPLICATION_NAME_VALID = (&H20)
ACTCTX_FLAG_SOURCE_IS_ASSEMBLYREF = (&H40)
ACTCTX_FLAG_HMODULE_VALID = (&H80)
End Enum
Private Type ACTCTX
cbSize As Long
dwFlags As ActivationContextFlags
lpSource As LongPtr
wProcessorArchitecture As Integer
wLangId As Integer
lpAssemblyDirectory As LongPtr
lpResourceName As LongPtr
lpApplicationName As LongPtr
hModule As LongPtr
End Type
Private Enum DeactivateActCtxFlags
DEACTIVATE_ACTCTX_FLAG_FORCE_EARLY_DEACTIVATION = (&H1)
End Enum
Private Type DLLVERSIONINFO
cbSize As Long
dwMajor As Long
dwMinor As Long
dwBuildNumber As Long
dwPlatformID As Long
End Type
Private Const INVALID_HANDLE_VALUE = -1&
Public Enum TDICONS
TD_WARNING_ICON = -1 'exclamation point in a yellow 'yield' triangle (same image as IDI_EXCLAMATION)
TD_ERROR_ICON = -2 'round red circle containg 'X' (same as IDI_HAND)
TD_INFORMATION_ICON = -3 'round blue circle containing 'i' (same image as IDI_ASTERISK)
TD_SHIELD_ICON = -4 'Vista's security shield
IDI_APPLICATION = 32512&
IDI_ERROR = 32513& 'miniature picture of an application window
IDI_QUESTION = 32514& 'round blue circle containing '?'
IDI_WINLOGO = 32517&
TD_SHIELD_GRADIENT_ICON = -5 'same image as TD_SHIELD_ICON; main message text on gradient blue background
TD_SHIELD_WARNING_ICON = -6 'exclamation point in yellow Shield shape; main message text on gradient orange background
TD_SHIELD_ERROR_ICON = -7 'X contained within Shield shape; main message text on gradient red background
TD_SHIELD_OK_ICON = -8 'Shield shape containing green checkmark; main message text on gradient green background
TD_SHIELD_GRAY_ICON = -9 'same image as TD_SHIELD_ICON; main message text on medium gray background
TD_NO_ICON = 0 'no icon; text on white background
End Enum
'taskdialog common button flags
Public Enum TASKDIALOG_COMMON_BUTTON_FLAGS
TDCBF_OK_BUTTON = &H1& 'return value 1 (IDOK)
TDCBF_YES_BUTTON = &H2& 'return value 6 (IDYES)
TDCBF_NO_BUTTON = &H4& 'return value 7 (IDNO)
TDCBF_CANCEL_BUTTON = &H8& 'return value 2 (IDCANCEL)
TDCBF_RETRY_BUTTON = &H10& 'return value 4 (IDRETRY)
TDCBF_CLOSE_BUTTON = &H20& 'return value 8 (IDCLOSE)
TDCBF_ABORT_BUTTON = &H10000
TDCBF_IGNORE_BUTTON = &H20000
TDCBF_TRYAGAIN_BUTTON = &H40000
TDCBF_CONTINUE_BUTTON = &H80000
'// Note: Clicking the "Help" button will not close the dialog, but will
'// raise the TaskDialogPage.Help event.
TDCBF_HELP_BUTTON = &H100000
End Enum
'These are just a custom, nonconflicted version of the MessageBox API returns
'TD_OK is the same as IDOK, and so on.
Public Enum TDRESULT
TD_OK = 1
TD_CANCEL = 2
TD_ABORT = 3
TD_RETRY = 4
TD_IGNORE = 5
TD_YES = 6
TD_NO = 7
TD_CLOSE = 8
'IDHELP is the corresponding value, but that button doesn't close the box and get returned
TD_TRYAGAIN = 10
TD_CONTINUE = 11
End Enum
Public Enum TASKDIALOG_FLAGS
TDF_ENABLE_HYPERLINKS = &H1
TDF_USE_HICON_MAIN = &H2
TDF_USE_HICON_FOOTER = &H4
TDF_ALLOW_DIALOG_CANCELLATION = &H8
TDF_USE_COMMAND_LINKS = &H10
TDF_USE_COMMAND_LINKS_NO_ICON = &H20
TDF_EXPAND_FOOTER_AREA = &H40
TDF_EXPANDED_BY_DEFAULT = &H80
TDF_VERIFICATION_FLAG_CHECKED = &H100
TDF_SHOW_PROGRESS_BAR = &H200
TDF_SHOW_MARQUEE_PROGRESS_BAR = &H400
TDF_CALLBACK_TIMER = &H800
TDF_POSITION_RELATIVE_TO_WINDOW = &H1000
TDF_RTL_LAYOUT = &H2000
TDF_NO_DEFAULT_RADIO_BUTTON = &H4000
TDF_CAN_BE_MINIMIZED = &H8000&
TDF_NO_SET_FOREGROUND = &H10000
TDF_SIZE_TO_CONTENT = &H1000000
TDF_USE_SHELL32_ICONID = &H400000 'CUSTOM FLAG
TDF_USE_IMAGERES_ICONID = &H800000 'CUSTOM FLAG
TDF_DATETIME = &H80000 'CUSTOM FLAG: Add calendar control
TDF_SLIDER = &H2000000 'CUSTOM FLAG: Add Slider control
TDF_INPUT_BOX = &H4000000 'CUSTOM FLAG: Input box. See below.
TDF_COMBO_BOX = &H8000000 'CUSTOM FLAG: Combo box; .ComboType controls edit or list
TDF_KILL_SHIELD_ICON = &H10000000 'CUSTOM FLAG: Allows the colored background from the TD_SHIELD_x icons to be used with just the text and no shield icon
TDF_EXEC_HYPERLINKS = &H20000000 'CUSTOM FLAG
TDF_USE_SHELL32_ICONID_BUTTON = &H40000000 'CUSTOM FLAG
TDF_USE_IMAGERES_ICONID_BUTTON = &H80000000 'CUSTOM FLAG
End Enum
'TDF_INPUT_BOX:
'Creates a textbox for input. There are multiple ways to set its position:
'1) Default, at the bottom of the content in the whitespace before the gray area
'2) To the left of the buttons. Not compatible with the expanded-info or verify-checkbox styles.
'3) As a footer. Aligned to retain the footer icon, but have an inputbox next to it.
'
'Additional inputbox items:
'-Initial text can be set, and current text from an open dialog, with .InputText
'-Cue banner can be set, .InputCueBanner
'-Input box can be set as a password input with * masks, .InputIsPassword
Public Enum TASKDIALOG_MESSAGES
TDM_NAVIGATE_PAGE = WM_USER + 101&
TDM_CLICK_BUTTON = WM_USER + 102& '// wParam = Button ID
TDM_SET_MARQUEE_PROGRESS_BAR = WM_USER + 103& '// wParam = 0 (nonMarque) wParam != 0 (Marquee)
TDM_SET_PROGRESS_BAR_STATE = WM_USER + 104& '// wParam = new progress state
TDM_SET_PROGRESS_BAR_RANGE = WM_USER + 105& '// lParam = tdMAKELPARAM(nMinRange& nMaxRange)
TDM_SET_PROGRESS_BAR_POS = WM_USER + 106& '// wParam = new position
TDM_SET_PROGRESS_BAR_MARQUEE = WM_USER + 107& '// wParam = 0 (stop marquee), wParam != 0 (start marquee), lparam = speed (milliseconds between repaints)
TDM_SET_ELEMENT_TEXT = WM_USER + 108& '// wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_CLICK_RADIO_BUTTON = WM_USER + 110& '// wParam = Radio Button ID
TDM_ENABLE_BUTTON = WM_USER + 111& '// lParam = 0 (disable), lParam != 0 (enable), wParam = Button ID
TDM_ENABLE_RADIO_BUTTON = WM_USER + 112& '// lParam = 0 (disable), lParam != 0 (enable), wParam = Radio Button ID
TDM_CLICK_VERIFICATION = WM_USER + 113& '// wParam = 0 (unchecked), 1 (checked), lParam = 1 (set key focus)
TDM_UPDATE_ELEMENT_TEXT = WM_USER + 114& '// wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE = WM_USER + 115& '// wParam = Button ID, lParam = 0 (elevation not required)& lParam != 0 (elevation required)
TDM_UPDATE_ICON = WM_USER + 116& '// wParam = icon element (TASKDIALOG_ICON_ELEMENTS), lParam = new icon (hIcon if TDF_USE_HICON_* was set, PCWSTR otherwise)
End Enum 'TASKDIALOG_MESSAGES;
Public Enum TASKDIALOG_NOTIFICATIONS
TDN_CREATED = 0
TDN_NAVIGATED = 1
TDN_BUTTON_CLICKED = 2 '// wParam = Button ID
TDN_HYPERLINK_CLICKED = 3 '// lParam = (LPCWSTR)pszHREF
TDN_TIMER = 4 '// wParam = Milliseconds since dialog created or timer reset
TDN_DESTROYED = 5
TDN_RADIO_BUTTON_CLICKED = 6 '// wParam = Radio Button ID
TDN_DIALOG_CONSTRUCTED = 7
TDN_VERIFICATION_CLICKED = 8 '// wParam = 1 if checkbox checked, 0 if not, lParam is unused and always 0
TDN_HELP = 9
TDN_EXPANDO_BUTTON_CLICKED = 10 '// wParam = 0 (dialog is now collapsed), wParam != 0 (dialog is now expanded)
End Enum 'TASKDIALOG_NOTIFICATIONS;
Public Enum TASKDIALOG_ELEMENTS
TDE_CONTENT = 0
TDE_EXPANDED_INFORMATION = 1
TDE_FOOTER = 2
TDE_MAIN_INSTRUCTION = 3
End Enum
Public Enum TASKDIALOG_ICON_ELEMENTS
TDIE_ICON_MAIN = 0
TDIE_ICON_FOOTER = 1
End Enum
#If TWINBASIC Then
[PackingAlignment(1)]
#End If
Private Type TASKDIALOG_BUTTON
nButtonID As Long
pszButtonText As LongPtr
End Type
#If TWINBASIC Then
[PackingAlignment(1)]
#End If
Private Type TASKDIALOGCONFIG
cbSize As Long
hWndParent As LongPtr
hInstance As LongPtr
dwFlags As TASKDIALOG_FLAGS
dwCommonButtons As TASKDIALOG_COMMON_BUTTON_FLAGS
pszWindowTitle As LongPtr
pszMainIcon As LongPtr 'TDICONS
pszMainInstruction As LongPtr
pszContent As LongPtr
cButtons As Long
pButtons As LongPtr
nDefaultButton As Long
cRadioButtons As Long
pRadioButtons As LongPtr
nDefaultRadioButton As Long
pszVerificationText As LongPtr
pszExpandedInformation As LongPtr
pszExpandedControlText As LongPtr
pszCollapsedControlText As LongPtr
pszFooterIcon As LongPtr 'TDICONS
pszFooter As LongPtr
pfCallback As LongPtr
lpCallbackData As LongPtr
CXWidth As Long
End Type
#If VBA7 Then
#If (Win64 <> 0) And (TWINBASIC = 0) Then
'VBA7 does not support the packing alignment attribute that makes calling this easy in twinBASIC; x64 inserts padding this particular API doesn't expect.
Private Type TASKDIALOG_BUTTON_VBA7
data(11) As Byte
End Type
Private m_uButtons_VBA7() As TASKDIALOG_BUTTON_VBA7
Private m_uRadioButtons_VBA7() As TASKDIALOG_BUTTON_VBA7
Private Type TASKDIALOGCONFIG_VBA7
data(159) As Byte
End Type
Private uTDC_VBA7 As TASKDIALOGCONFIG_VBA7
Private Declare PtrSafe Function TaskDialogIndirect_VBA7 Lib "comctl32.dll" Alias "TaskDialogIndirect" (pTaskConfig As TASKDIALOGCONFIG_VBA7, _
pnButton As Long, _
pnRadioButton As Long, _
pfVerificationFlagChecked As Long) As Long
#End If
Private Declare PtrSafe Function TaskDialog Lib "comctl32.dll" _
(ByVal hWndParent As LongPtr, _
ByVal hInstance As LongPtr, _
ByVal pszWindowTitle As LongPtr, _
ByVal pszMainInstruction As LongPtr, _
ByVal pszContent As LongPtr, _
ByVal dwCommonButtons As Long, _
ByVal pszIcon As LongPtr, _
pnButton As Long) As Long
Private Declare PtrSafe Function TaskDialogIndirect Lib "comctl32.dll" (pTaskConfig As TASKDIALOGCONFIG, _
pnButton As Long, _
pnRadioButton As Long, _
pfVerificationFlagChecked As Long) As Long
Private Declare PtrSafe Function SendMessageW Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As LongPtr, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function DestroyIcon Lib "user32.dll" (ByVal hIcon As LongPtr) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long
Private Declare PtrSafe Function GetParent Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
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 Long) As LongPtr
Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hwndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hWnd As LongPtr, lpPoint As Any) As Long ' lpPoint As POINT) As Long
Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hDC As LongPtr, ByVal X As Long, ByVal Y As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As LongPtr
Private Declare PtrSafe Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function UpdateWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr, Optional ByVal dwRefData As LongPtr) As Long
Private Declare PtrSafe Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr) As Long
Private Declare PtrSafe Function SystemParametersInfoW Lib "user32" (ByVal uiAction As Long, ByVal uiParam As Long, pvParam As Any, ByVal fWinIni As Long) As Long
Private Declare PtrSafe Function CreateFontIndirectW Lib "gdi32" (ByRef lpLogFont As LOGFONTW) As LongPtr
Private Declare PtrSafe Function RegOpenKeyExW Lib "advapi32" (ByVal hKey As LongPtr, ByVal lpSubKey As LongPtr, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
Private Declare PtrSafe Function RegQueryValueExW Lib "advapi32" (ByVal hKey As LongPtr, ByVal lpValueName As LongPtr, lpReserved As Long, ByRef lpType As Long, ByVal szData As LongPtr, ByRef lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As LongPtr) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If
Private Declare PtrSafe Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare PtrSafe Function DllGetVersion Lib "comctl32" (ByRef pdvi As DLLVERSIONINFO) As Long
Private Declare PtrSafe Function CreateActCtx Lib "kernel32" Alias "CreateActCtxW" (pActCtx As ACTCTX) As LongPtr
Private Declare PtrSafe Function ActivateActCtx Lib "kernel32" (ByVal hActCtx As LongPtr, lpCookie As LongPtr) As Long
Private Declare PtrSafe Function DeactivateActCtx Lib "kernel32" (ByVal dwFlags As DeactivateActCtxFlags, ByVal lpCookie As LongPtr) As Long
Private Declare PtrSafe Sub ReleaseActCtx Lib "kernel32" (ByVal hActCtx As LongPtr)
Private Declare PtrSafe Function GetSystemDirectoryW Lib "kernel32" (ByVal lpBuffer As LongPtr, ByVal uSize As Long) As Long
#Else
Private Declare Function TaskDialog Lib "comctl32.dll" _
(ByVal hWndParent As Long, _
ByVal hInstance As Long, _
ByVal pszWindowTitle As Long, _
ByVal pszMainInstruction As Long, _
ByVal pszContent As Long, _
ByVal dwCommonButtons As Long, _
ByVal pszIcon As Long, _
pnButton As Long) As Long
'WINCOMMCTRLAPI HRESULT WINAPI TaskDialogIndirect(const TASKDIALOGCONFIG *pTaskConfig, __out_opt int *pnButton, __out_opt int *pnRadioButton, __out_opt BOOL *pfVerificationFlagChecked);
Private Declare Function TaskDialogIndirect Lib "comctl32.dll" (pTaskConfig As TASKDIALOGCONFIG, _
pnButton As Long, _
pnRadioButton As Long, _
pfVerificationFlagChecked As Long) As Long
Private Declare Function SendMessageW Lib "user32" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hinst As Long, ByVal lpsz As Long, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetParent Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
' Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function ShellExecuteW Lib "shell32.dll" (ByVal hWnd As Long, ByVal lpOperation As Long, ByVal lpFile As Long, ByVal lpParameters As Long, ByVal lpDirectory As Long, ByVal nShowCmd As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function DefSubclassProc Lib "comctl32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As GWL_nIndex) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As GWL_nIndex, ByVal dwNewLong As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare Function SystemParametersInfoW Lib "user32" (ByVal uiAction As Long, ByVal uiParam As Long, pvParam As Any, ByVal fWinIni As Long) As Long
Private Declare Function CreateFontIndirectW Lib "gdi32" (ByRef lpLogFont As LOGFONTW) As Long
Private Declare Function RegOpenKeyExW Lib "advapi32" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExW Lib "advapi32" (ByVal hKey As Long, ByVal lpValueName As Long, lpReserved As Long, ByRef lpType As Long, ByVal szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
Private Declare Function DllGetVersion Lib "comctl32" (ByRef pdvi As DLLVERSIONINFO) As Long
Private Declare Function CreateActCtx Lib "kernel32" Alias "CreateActCtxW" (pActCtx As ACTCTX) As Long
Private Declare Function ActivateActCtx Lib "kernel32" (ByVal hActCtx As Long, lpCookie As Long) As Long
Private Declare Function DeactivateActCtx Lib "kernel32" (ByVal dwFlags As DeactivateActCtxFlags, ByVal lpCookie As Long) As Long
Private Declare Sub ReleaseActCtx Lib "kernel32" (ByVal hActCtx As Long)
Private Declare Function GetSystemDirectoryW Lib "kernel32" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long
#End If
Private Const CP_ACP = 0 ' ANSI code page
Private Enum GWL_nIndex
GWL_WNDPROC = (-4)
GWL_HINSTANCE = (-6)
GWL_HWNDPARENT = (-8)
GWL_ID = (-12)
GWL_STYLE = (-16)
GWL_EXSTYLE = (-20)
GWL_USERDATA = (-21)
End Enum
Private Const HKEY_CURRENT_USER = &H80000001
Private Const KEY_QUERY_VALUE = &H1&
Private Const REG_SZ = 1&
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private m_ScaleX As Single, m_ScaleY As Single
Public lngTimerID As Long
Private m_hInst As LongPtr
Public Event DialogCreated(ByVal hWnd As LongPtr)
Public Event ButtonClick(ByVal ButtonID As Long)
Public Event HyperlinkClick(ByVal lPtr As LongPtr)
Public Event Timer(ByVal TimerValue As Long)
Public Event DialogDestroyed()
Public Event RadioButtonClick(ByVal ButtonID As Long)
Public Event DialogConstucted(ByVal hWnd As LongPtr)
Public Event VerificationClicked(ByVal Value As Long)
Public Event ExpandButtonClicked(ByVal Value As Long)
Public Event Navigated()