-
Notifications
You must be signed in to change notification settings - Fork 4
/
frmMain.frm
6925 lines (5577 loc) · 295 KB
/
frmMain.frm
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 5.00
Begin VB.Form dock
BorderStyle = 0 'None
Caption = " "
ClientHeight = 9675
ClientLeft = 45
ClientTop = 570
ClientWidth = 5520
Icon = "frmMain.frx":0000
OLEDropMode = 1 'Manual
ScaleHeight = 645
ScaleMode = 3 'Pixel
ScaleWidth = 368
ShowInTaskbar = 0 'False
Begin VB.Timer explorerTimer
Enabled = 0 'False
Interval = 10000
Left = 2895
Tag = "this routine is used to identify an item in the dock as currently running even if not triggered by the dock"
Top = 1680
End
Begin VB.Timer initiatedExplorerTimer
Enabled = 0 'False
Interval = 5000
Left = 2895
Tag = "Provides regular checking of only explorer processes initiated by the dock itself"
Top = 1155
End
Begin VB.Timer iconGrowthTimer
Enabled = 0 'False
Interval = 20
Left = 255
Tag = "used to make the main icon grow"
Top = 3540
End
Begin VB.Timer clickBlankTimer
Enabled = 0 'False
Interval = 50
Left = 255
Tag = "used to make the main icon invisible for a very brief period of 100ms or less"
Top = 3075
End
Begin VB.Timer delayRunTimer
Enabled = 0 'False
Interval = 3000
Left = 240
Tag = "This is the timer that causes any secondary command to run three seconds after the main"
Top = 4620
End
Begin VB.Timer targetExistsTimer
Enabled = 0 'False
Interval = 8000
Left = 225
Tag = "this routine is used to identify if the main target is valid"
Top = 7290
End
Begin VB.Timer forceHideRevealTimer
Enabled = 0 'False
Interval = 1500
Left = 2835
Top = 3960
End
Begin VB.Timer ScreenResolutionTimer
Interval = 3000
Left = 255
Top = 2595
End
Begin VB.Timer bounceDownTimer
Enabled = 0 'False
Interval = 20
Left = 255
Tag = "controls the bounceDownward when the icon is clicked"
Top = 2100
End
Begin VB.Timer hourGlassTimer
Enabled = 0 'False
Interval = 50
Left = 2835
Tag = "load a small rotating hourglass image into the collection, used to signify running actions"
Top = 4470
End
Begin VB.Timer sleepTimer
Enabled = 0 'False
Interval = 2000
Left = 225
Tag = "stores and compares the last time to see if the PC has slept"
Top = 6765
End
Begin VB.Timer positionZTimer
Enabled = 0 'False
Interval = 10000
Left = 255
Tag = "Places the dock back in the defined z-order"
Top = 1110
End
Begin VB.Timer autoSlideInTimer
Enabled = 0 'False
Interval = 10
Left = 2835
Tag = "slide the dock in the Y axis"
Top = 6030
End
Begin VB.Timer nMinuteExposeTimer
Enabled = 0 'False
Interval = 60000
Left = 2835
Tag = "causes the dock to re-appear in its default state after N mins"
Top = 4995
End
Begin VB.Timer autoFadeInTimer
Enabled = 0 'False
Interval = 10
Left = 240
Tag = "this routine simply gradually sets the opacity of the dock when triggered using funcBlend32bpp.SourceConstantAlpha"
Top = 6255
End
Begin VB.Timer autoSlideOutTimer
Enabled = 0 'False
Interval = 10
Left = 2835
Tag = "slide the dock in the Y axis"
Top = 5505
End
Begin VB.Timer initiatedProcessTimer
Enabled = 0 'False
Interval = 3000
Left = 2895
Tag = "Provides regular checking of only processes initiated by the dock itself"
Top = 660
End
Begin VB.Timer autoHideChecker
Enabled = 0 'False
Interval = 500
Left = 255
Tag = "checks to see if the dock needs to be hidden, if so, initiates one of the hider timers"
Top = 5190
End
Begin VB.Timer autoFadeOutTimer
Enabled = 0 'False
Interval = 10
Left = 240
Tag = "this routine simply gradually sets the opacity of the dock when triggered using funcBlend32bpp.SourceConstantAlpha"
Top = 5715
End
Begin VB.Timer processTimer
Enabled = 0 'False
Interval = 10000
Left = 2895
Tag = "this routine is used to identify an item in the dock as currently running even if not triggered by the dock"
Top = 150
End
Begin VB.Timer runTimer
Enabled = 0 'False
Interval = 10
Left = 240
Tag = "calls the subroutine that runs the actual command"
Top = 4155
End
Begin VB.Timer bounceUpTimer
Enabled = 0 'False
Interval = 20
Left = 255
Tag = "controls the bounceUpward when the icon is clicked"
Top = 1605
End
Begin VB.Timer responseTimer
Interval = 200
Left = 255
Tag = "Determines whetherto turn on the animate timer"
Top = 600
End
Begin VB.Timer animateTimer
Enabled = 0 'False
Interval = 10
Left = 270
Tag = "this is the X millisecond timer that does the animation for the dock icons"
Top = 105
End
Begin VB.Label Label20
Caption = "explorerTimer"
Height = 255
Left = 3420
TabIndex = 26
Tag = "this routine is used to identify an item in the dock as currently running even if not triggered by the dock"
Top = 1755
Width = 1215
End
Begin VB.Label Label19
Caption = "initiatedExplorerTimer"
Height = 255
Left = 3420
TabIndex = 25
Tag = "Provides regular checking of only explorer processes initiated by the dock itself"
Top = 1230
Width = 1815
End
Begin VB.Label lblIconGrowthTimer
Caption = "iconGrowthTimer"
Height = 255
Left = 930
TabIndex = 24
ToolTipText = "used to make the main icon invisible for a very brief period of 100ms or less"
Top = 3585
Width = 1680
End
Begin VB.Label lblClickBlankTimer
Caption = "ClickBlankTimer"
Height = 255
Left = 945
TabIndex = 23
ToolTipText = "used to make the main icon invisible for a very brief period of 100ms or less"
Top = 3120
Width = 1680
End
Begin VB.Label Label6
Caption = "delayRunTimer"
Height = 255
Index = 1
Left = 960
TabIndex = 22
ToolTipText = "This is the timer that causes any secondary command to run three seconds after the main"
Top = 4695
Width = 1425
End
Begin VB.Label Label18
Caption = "targetExistsTimer"
Height = 255
Left = 945
TabIndex = 21
Tag = "this routine is used to identify if the main target is valid"
Top = 7365
Width = 1665
End
Begin VB.Label Label
Caption = "forceHideRevealTimer"
Height = 255
Index = 1
Left = 3360
TabIndex = 20
Top = 4080
Width = 1935
End
Begin VB.Label Label17
Caption = "ScreenResolutionTimer"
Height = 255
Left = 960
TabIndex = 19
Top = 2670
Width = 1680
End
Begin VB.Label Label5
Caption = "bounceDownTimer"
Height = 255
Left = 960
TabIndex = 18
Tag = "controls the bounceDownward when the icon is clicked"
Top = 2175
Width = 1485
End
Begin VB.Label Label16
Caption = "hourglassTimer"
Height = 255
Left = 3360
TabIndex = 17
ToolTipText = "causes the dock to re-appear in its default state after 10 mins"
Top = 4590
Width = 1785
End
Begin VB.Label Label15
Caption = "sleepTimer"
Height = 255
Left = 945
TabIndex = 16
Tag = "stores and compares the last time to see if the PC has slept"
Top = 6810
Width = 1665
End
Begin VB.Label Label14
Caption = "positionZTimer"
Height = 255
Left = 960
TabIndex = 15
ToolTipText = "Placing the dock back in the defined z-order"
Top = 1200
Width = 1215
End
Begin VB.Label Label13
Caption = "autoSlideInTimer"
Height = 255
Left = 3375
TabIndex = 14
ToolTipText = "slides the dock in the Y axis"
Top = 6150
Width = 1410
End
Begin VB.Label Label12
Caption = "Note: there are other timers on the splashform"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 405
TabIndex = 13
Top = 9135
Width = 4380
End
Begin VB.Label Label9
Caption = "nMinuteExposeTimer"
Height = 255
Left = 3375
TabIndex = 12
ToolTipText = "causes the dock to re-appear in its default state after 10 mins"
Top = 5085
Width = 1785
End
Begin VB.Label Label2
Caption = "autoFadeInTimer"
Height = 255
Left = 960
TabIndex = 11
ToolTipText = "this routine simply gradually increases the opacity of the dock when triggered using funcBlend32bpp.SourceConstantAlpha"
Top = 6360
Width = 1425
End
Begin VB.Label lblDockInfo2
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Caption = $"frmMain.frx":058A
ForeColor = &H80000008&
Height = 990
Left = 435
TabIndex = 10
Top = 7935
Width = 4380
End
Begin VB.Label lblDockInfo
Appearance = 0 'Flat
BackColor = &H80000000&
BorderStyle = 1 'Fixed Single
Caption = $"frmMain.frx":068F
ForeColor = &H80000008&
Height = 1380
Left = 2715
TabIndex = 9
Top = 2295
Width = 2370
End
Begin VB.Label Label11
Caption = "autoSlideOutTimer"
Height = 255
Left = 3360
TabIndex = 8
ToolTipText = "slides the dock in the Y axis"
Top = 5610
Width = 1410
End
Begin VB.Label Label10
Caption = "initiatedProcessTimer"
Height = 255
Left = 3435
TabIndex = 7
Tag = "Provides regular checking of only processes initiated by the dock"
Top = 735
Width = 1815
End
Begin VB.Label Label8
Caption = "autoHideChecker"
Height = 255
Left = 960
TabIndex = 6
Tag = "checks to see if the dock needs to be hidden, if so, initiates one of the hider timers, slide or fade"
ToolTipText = "this routine simpl"
Top = 5295
Width = 1410
End
Begin VB.Label Label7
Caption = "autoFadeOutTimer"
Height = 255
Left = 945
TabIndex = 5
ToolTipText = "this routine simply gradually sets decreased opacity of the dock when triggered using funcBlend32bpp.SourceConstantAlpha"
Top = 5835
Width = 1425
End
Begin VB.Label Label6
Caption = "runTimer"
Height = 255
Index = 0
Left = 975
TabIndex = 4
ToolTipText = "This is the timer that causes any specified command to run"
Top = 4170
Width = 1425
End
Begin VB.Label Label4
Caption = "bounceUpTimer"
Height = 255
Left = 960
TabIndex = 3
Tag = "controls the bounceUpward when the icon is clicked"
Top = 1665
Width = 1215
End
Begin VB.Label Label3
Caption = "processTimer"
Height = 255
Left = 3435
TabIndex = 2
Tag = "this routine is used to identify an item in the dock as currently running even if not triggered by the dock"
Top = 225
Width = 1215
End
Begin VB.Label Label1
Caption = "responseTimer"
Height = 255
Left = 960
TabIndex = 1
Tag = "Determines whetherto turn on the animate timer"
Top = 720
Width = 1215
End
Begin VB.Label Label
Caption = "animateTimer"
Height = 255
Index = 0
Left = 960
TabIndex = 0
Tag = "this is the X millisecond timer that does the animation for the dock icons"
Top = 240
Width = 1215
End
End
Attribute VB_Name = "dock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'========================================================================================================
' SteamyDock
'
' A VB6 GDI+ dock for Reactos, XP, Win7, 8 and 10.
' SteamyDock is a functional reproduction of the dock we all know and love - Rocketdock for Windows from Punklabs.
'
' Built using: VB6, MZ-TOOLS 3.0, VBAdvance, CodeHelp Core IDE Extender Framework 2.2 & Rubberduck 2.4.1
'
' MZ-TOOLS https://www.mztools.com/
' CodeHelp http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=62468&lngWId=1
' Rubberduck http://rubberduckvba.com/
' Rocketdock https://punklabs.com/
' Registry code ALLAPI.COM
' La Volpe http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=67466&lngWId=1
' PrivateExtractIcons code http://www.activevb.de/rubriken/
' Persistent debug code http://www.vbforums.com/member.php?234143-Elroy
' Open File common dialog code without dependent OCX - http://forums.codeguru.com/member.php?92278-rxbagain
' VBAdvance
' Fafalone for the enumerate Explorer windows code
'
' Tested on :
' ReactOS 0.4.14 32bit on virtualBox
' Windows 7 Professional 32bit on Intel
' Windows 7 Ultimate 64bit on Intel
' Windows 7 Professional 64bit on Intel
' Windows XP SP3 32bit on Intel
' Windows 10 Home 64bit on Intel
' Windows 10 Home 64bit on AMD
' Windows 11 64bit on Intel
'
' Dependencies:
' GDI+
' A windows-alike o/s such as Windows 7-11 or ReactOS
' OLEEXP.TLB placed in sysWoW64 - required to obtain the explorer paths only during development.
'
'
' Project References:
' VisualBasic for Applications
' VisualBasic Runtime Objects and Procedures
' VisualBasic Objects and Procedures
' OLE Automation - drag and drop
' Microsoft Shell Controls and Automation
' Microsoft scripting runtime - for the scripting dictionary usage
' OLEEXP Modern Shell Interfaces for VB6, v5.1
'
'
'========================================================================================================
'
' Credits
'
' I have really tried to maintain the credits as the project has progressed. If I have made a mistake and left someone out then
' do forgive me. I will make amends if anyone points out my mistake in leaving someone out.
'
' Peacemaker2000 Original idea for a GDI+ dock came from here:
' http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=55352&lngWId=1&fbclid=IwAR2FeR12CdaxyOoY-muw-b6_oDW-_19oLrt8syEL6BQSX4PMEfHyWpfqpzM
'
' Olaf Schmidt - used some of Olaf's code as examples of how to implement the handling of images using GDI+
' and specifically used two routines, createScaledImg & ReadBytesFromFile.
'
' Also critically, the idea of using the scripting dictionary as a repository for a collection of
' image bitmaps.
'
' In addition, the easeing functions to do the bounce animation, I initially used a converted .js
' implementation but Olaf's was better.
'
' Spider Harper Is64bit() function.
'
' Wayne Phillips Used a heavily modified version of his code to bring an external application window to the foreground
' https://www.everythingaccess.com/tutorials.asp?ID=Bring-an-external-application-window-to-the-foreground
'
' www.thescarms.com Provided the code to enumerate through windows using a callback routine
'
' dee-u Candon City, Ilocos Used a modified version of his code to obtain a window handle from a PID.
' https://www.vbforums.com/showthread.php?561413-getting-hwnd-from-process
'
' Shuja Ali @ codeguru for his settings.ini code.
'
' An unknown, untraceable source, possibly on MSN - for the KillApp code
'
' ALLAPI.COM For the registry reading code.
'
' Elroy on VB forums for his Persistent debug window - no longer used but thanks anyway!
' http://www.vbforums.com/member.php?234143-Elroy
'
' Rxbagain on codeguru for his Open File common dialog code without a dependent OCX
' http://forums.codeguru.com/member.php?92278-rxbagain
'
' si_the_geek for his special folder code
'
' Aaron Young for his code for registering a keypress system wide
'
' Lots of GDI+ examples gleaned from here:
' http://read.pudn.com/downloads29/sourcecode/windows/control/93919/Use_GDI+_(1627568102003/frmMain.frm__.htm
'
' La Volpe Routine to check return value from any GDI++ function
' Jacques Lebrun Function to Provide resolution of shortcuts
' https://www.vbforums.com/showthread.php?445574-Reading-shortcut-information
' Fafalone for the enumerate Explorer windows code:
' https://www.vbforums.com/showthread.php?818959-VB6-Get-extended-details-about-Explorer-windows-by-getting-their-IFolderView
' Dragokas systray code
'
'
'========================================================================================================
'
' The core of this program are the routines from Olaf Schmidt that open the image files as an ADO stream of bytes and feed
' those into GDI+. These images are then converted to bitmaps and fed into dictionary objects for storage.
'
' NOTE - I do not suggest developing VB6 programs using Windows 11, it can be a painful experience. A modern Windows 7 system
' with an SSD and 16gb RAM is the perfect platform. Windows 10 can be made into a decent development platform but Win 11 is a pain.
' You may have to run VB6 elevated to avoid the annoying registry errors on startup. Disabling UAC allows you to compile directly to
' your app beneath the program files folder which otherwise Win 11 will prevent you from doing.
'
' NOTE - On the running steamydock binary, if set as compatibility mode and run as admin - causes problems on autostart on Win10, avoid that!
' Avoid setting any sort of compatibility mode - for example, when set as compatible for Win7 the dock was unable
' to obtain the processID from running binaries such as everything.exe, cpuid.exe - unless the dock ran in administrator mode. Just remove any compatibility settings
' and run without elevation.
'
' NOTE - Do not end this program within the IDE by RUN/END, do that a few times and GDI+ will consume all your memory until the IDE falls over. When this happens
' just close the IDE and re-open it. Instead, ALWAYS use the QUIT option on Steamydock's right click menu.
'
' NOTE - The keyboard capture for F11 key to hide the dock, is disabled during a debug run in the IDE.
'
' NOTE - Calls to subroutines are generally (not always) made using the obsolete CALL statement making them more obvious. I also work with
' other languages where the the use of brackets is required, it makes shifting from one language to another slightly less jarring.
' Functions are just referenced in the usual fashion, returning a value.
' Exception - Even though the GDI+ APIs are "Functions" they are run using the CALL statement. GDIP functions only return a zero or an error
' code whilst any returned pointers &c are provided as passed arguments and not as the function's return value. Having the call statement in
' place merely allows easy substitution for some error handling during debugging.
' Program Structure:
'
' There is a response timer and an animate timer.
' The responseTimer draws the small icons once and monitors the mouse position, the animateTimer runs at a high frequency and draws
' the whole dock multiple times per second providing the animation effect. The relationship of the timers is found in an Impress or Powerpoint type
' document in the documentation folder. There are several timers and they really control the operation of everything.
'
' Before those timers start, the program reads all the icon locations from the settings file and loads the icons into memory using a dictionary
' object to hold the data. The location of the objects is keyed. This occurs on startup. During runtime, the various images are
' recalled from memory and drawn to the screen using a for...loop.
'
' Only the central (n) icons are resized. This way CPU usage is minimised. Memory usage is also minimal but
' all the icons must be stored in memory so there is a natural overhead. The right-click menu sits upon an invisible form
' as GDI+ does not like a menu on the same form as the GDI+ graphics.
' All associated icon data is stored in temporary arrays so that it can be processed quickly. The program keeps track of dock-initiated processes using these arrays.
' For the background image, we do NOT retain skin compatibility with Rocketdock. This is due to Punklabs overly-complex use of GDI+ in
' RD to stretch and manipulate the single small theme image into something wider that fits the whole dock.
' Instead, we have two small right/left image and one centre image that is sized in Photoshop -
' to 2000px, then we crop the image to size as required using GDI+. This cropping occurs when the image is loaded into the dictionary
' rather than when it is displayed. As SD is FOSS, a future developer can implement Rocketdock's themeing if it is really required.
'
' The background form is transparent, the X,Y position of the mouse event, on a non-transparent part of the form (the icons),
' is captured using an API and compared to stored icon X locations to determine which icon is selected. Click-through on
' transparent parts of the icons are captured by drawing a 1% opacity background of a white square that is in itself 50% transparent.
'
'
' Running Processes:
'
' NOTE: Running processes have 'cogs'. A cog is placed above the icon triggered at process initiation.
' The continued presence of these cogs are determined using two timers, the first only analyses processes
' that have been initiated by the dock so that the running 'cog' can be quickly removed when the process ends
' (initiatedProcessTimer). The second timer loops through all processes to see which are active at any time,
' adding a cog above any icon that has a matching process name (processTimer). The isRunning function is used
' to achieve a match. There is a very similar procedure for determining running explorer windows, described next.
'
' With Explorer windows, we identify which of the icon entries is a folder, but only at runtime within runCommand.
' At that point we add the specific folder to an initiatedFolderArray and then immediately add a cog to the icon.
' A timer runs frequently and just loops through this array to monitor the state of recently initiated explorer
' instances so that the running 'cog' can be quickly removed when the Explorer window is closed, a separate timer
' loops less frequently through all open explorer windows and checks to see if any matching icon deserves a 'cog'.
' It will match CLSID entries too. It uses the enumerateExplorerWindows function to achieve a match.
' BUILD: The program runs without any Microsoft plugins.
' It requires a single typelib to be present. OLEEXP.TLB placed in sysWoW64 - required to obtain the explorer
' paths.
' oleexp.tlb should typically be located in SysWow64 (or System32 on a 32-bit Windows install). You can register it
' manually using regtlib.exe on Win 7-10 systems or the newer utility on Win 11.
'
' but it should be sufficient to let VB6 register it for you. When you first try to run or compile it will come up with the
' project references utility. Point OLEEXP to the correct location (SysWoW64). You should only have one copy installed.
' Only needed during development as the types are compiled in. Once your project is compiled, the TLB is no longer used.
' It does not need to be present on end user machines.
' Detail regarding data sources:
' C:\Users\<username>\AppData\Roaming\steamyDock\
'
' dockSettingsFile = sdAppPath & "\settings.ini" ' The dock 's settings file in user appdata
' toolSettingsFile = SpecialFolder_AppData & <utilityName> "\settings.ini" the tool's own settings file.
'
' docksettings.ini is partitioned as follows:
'
' [Software\SteamyDock\DockSettings] - the dockSettings tool writes here
' [Software\SteamyDock\IconSettings\Icons] - the iconSettings tool writes here
'
' re: toolSettingsFile - The utilities read their own config files for their own personal set up in their own folders in appdata
' Settings.ini, this is just for local settings that concern only the utility, look and feel, fonts &c
'
' eg.
' C:\Users\<username>\AppData\Roaming\dockSettings\settings.ini
'
' toolSettingsFile - Dock - the following items are currently inserted into the toolSettingsFile for the dockSettings utility
'
' [Software\SteamyDockSettings]
' defaultStrength = 400
' defaultStyle = False
' defaultFont=Centurion Light SF
' toolSettingsFile - Icons - the following items are currently inserted into the toolSettingsFile for the iconSettings utility
' [Software\SteamyDockSettings]
' defaultFolderNodeKey=C:\Program Files (x86)\SteamyDock\iconSettings\my collection ' this could be moved to the docksettings.ini later
' rdMapState = Visible ' as could this
' defaultSize = 8
' defaultStrength = False
' defaultStyle = False
' Quality = 1
' defaultFont=Centurion Light SF
'========================================================================================================
'
' LICENCE AGREEMENTS:
'
' Copyright © 2019 Dean Beedell
'
' Using this program implies you have accepted the licence. The GPL licence applies to the code
' this software Is provided 'as-is', without any express or implied warranty. In no event will the
' author be held liable for any damages arising from the use of this software. Permission is granted to
' anyone to use this software for any purpose, including commercial applications, and to alter it and
' redistribute it freely, subject to the following restrictions:
'
' 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation is required.
' 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software.
' 3. This notice may not be removed or altered from any source distribution.
'
' This program is free software; you can redistribute it and/or modify it under the terms of the
' GNU General Public Licence as published by the Free Software Foundation; either version 2 of the
' Licence, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
' even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
' General Public Licence for more details.
'
' You should have received a copy of the GNU General Public Licence along with this program; if not,
' write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
' USA
'
' If you use this software in any way whatsoever then that implies acceptance of the licence. If you
' do not wish to comply with the licence terms then please remove the download, binary and source code
' from your systems immediately.
'
'--------------------------------------------------------------------------------------------------------------
Option Explicit
Private Declare Function OLE_CLSIDFromString Lib "ole32" Alias "CLSIDFromString" (ByVal lpszProgID As Long, ByVal pCLSID As Long) As Long
Private Declare Function Ole_CreatePic Lib "olepro32" _
Alias "OleCreatePictureIndirect" ( _
ByRef lpPictDesc As PictDesc, _
ByVal riid As Long, _
ByVal fPictureOwnsHandle As Long, _
ByRef iPic As IPicture) As Long
' API to determine whether the program is running with administrator rights
Private Declare Function IsUserAnAdmin Lib "Shell32" Alias "#680" () As Integer
Private Enum OLE_ERROR_CODES
S_OK = 0
E_NOINTERFACE = &H80004002
E_POINTER = &H80004003
E_FAIL = &H80004005
E_UNEXPECTED = &H8000FFFF
E_INVALIDARG = &H80070057
End Enum
' vars to obtain correct screen width (to correct VB6 bug) STARTS
Private Const HORZRES = 8
Private Const VERTRES = 10
'Private lngHeight As Long
'Private lngWidth As Long
Private lngCursor As Long
Private iconIndex As Single
Private iconProportion As Double
Private iconXOffset As Double
Private dynamicSizeModifierPxls As Double
Private differenceFromLeftMostResizedIconPxls As Double
Private animateStep As Single
Private dockDrawingPositionPxls As Single
'Private dockTopPxls As Single '.nn
Private iconLeftmostPointPxls As Single
Private iconRightmostPointPxls As Single
Private lngFont As Long
Private lngBrush As Long
Private lngFontFamily As Long
Private lngCurrentFont As Long
Private lngFormat As Long
Private iconHeightPxls As Single
'Private iconWidthPxls As Single
Private iconPosLeftPxls As Single
Private iconCurrentTopPxls As Single
Private iconCurrentBottomPxls As Single ' 01/06/2021 DAEB frmMain.frm Added to capture the bottom Y co-ords of each icon
Private screenHorizontalEdge As Single
Private bDrawn As Boolean
Private savApIMouseX As Long
Private savApIMouseY As Long
'general vars
Private normalDockWidthPxls As Long
Private expandedDockWidth As Long
Private leftIconSize As Long
Private dockJustEntered As Boolean
Private rdDefaultYPos As Integer
'Private saveStartLeftTwps As Long
Private saveStartLeftPxls As Long ' .59 DAEB 26/04/2021 frmMain.frm changed to use pixels alone, removed all unnecesary twip conversion
' bounce variables
Private sDBounceStep As Integer ' add to configuration later
Private sDBounceInterval As Integer
Private b1 As Double 'not all used yet
Private b2 As Double
Private B3 As Double
Private b4 As Double
Private b5 As Double
Private b6 As Double
Private b7 As Double
Private b8 As Double
Private b9 As Double
Private B0 As Double
' theme variables
Private rDThemeImage As String
Private rDThemeLeftMargin As Integer
Private rDThemeTopMargin As Integer
Private rDThemeRightMargin As Integer
Private rDThemeBottomMargin As Integer
Private rDThemeOutsideLeftMargin As Integer
Private rDThemeOutsideTopMargin As Integer
Private rDThemeOutsideRightMargin As Integer
Private rDThemeOutsideBottomMargin As Integer
' Vars for
Private rDSeparatorImage As String
Private rDSeparatorTopMargin As Integer
Private rDSeparatorBottomMargin As Integer
Private xAxisModifier As Integer ' .57 DAEB 19/04/2021 frmMain.frm modifedAmountToSlide renamed to xAxisModifier for clarity's sake
Private yAxisModifier As Integer '.nn added for future Y axis animation
Private autoHideMode As String
Private autoSlideMode As String
Private dockSlidOut As Boolean
Private dockYEntrancePoint As Integer
Private nMinuteExposeTimerCount As Integer
' .13 DAEB frmMain.frm 27/01/2021 Added system wide keypress support
' .23 DAEB frmMain.frm 08/02/2021 Changed from an array to a single var
Public lPressed As Long '.nn
Private dockZorder As String '.nn
' .58 DAEB 21/04/2021 frmMain.frm added timer and vars to check to see if the system has just emerged from sleep
Private strTimeThen As Date
' .63 DAEB 29/04/2021 frmMain.frm load a small rotating hourglass image into the collection, used to signify running actions
Private hourglassimage As String
Private hourglassTimerCount As Integer
' .63 DAEB 29/04/2021 frmMain.frm load a small rotating hourglass image into the collection, used to signify running actions
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private mouseDownTime As Long
' .84 DAEB 20/07/2021 frmMain.frm Added prevention of the dock returning until the hiding application is no longer running.
Private autoHideProcessName As String
Private soundtoplay As String
Private delayRunTimerCount As Integer
Private bumpFactor As Single
' We initialise all the above vars during the form_initialise phase
Private currentDockHeightPxls As Long
Private blankClickEvent As Boolean
Private lastPositionRelativeToDock As Boolean
Private outsideDock As Boolean
'Private iconGrowthModifier As Integer
Private Sub clickBlankTimer_Timer()
' In VB6 you cannot obtain a 1 millisecond timer. The clock resolution on Windows is not high enough.
' By default it increments 64 times per second. The smallest interval you can get is therefore 16 milliseconds.
' set the current icon key to that of the blank icon
blankClickEvent = False
clickBlankTimer.Enabled = False
End Sub
'---------------------------------------------------------------------------------------
' Procedure : clearAllMessageBoxRegistryEntries
' Author : beededea
' Date : 11/04/2023
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub clearAllMessageBoxRegistryEntries()
On Error GoTo clearAllMessageBoxRegistryEntries_Error
SaveSetting App.EXEName, "Options", "Show message" & "dragAndDeleteThisIcon", 0
SaveSetting App.EXEName, "Options", "Show message" & "deleteThisIcon", 0
SaveSetting App.EXEName, "Options", "Show message" & "confirmEachKill", 0
SaveSetting App.EXEName, "Options", "Show message" & "confirmEachKillPutWindowBehind", 0
On Error GoTo 0
Exit Sub
clearAllMessageBoxRegistryEntries_Error:
With Err
If .Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure clearAllMessageBoxRegistryEntries of Form dock"
Resume Next
End If
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : explorerTimer_Timer
' Author : beededea
' Date : 10/04/2023
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub explorerTimer_Timer()
On Error GoTo explorerTimer_Timer_Error
Call checkExplorerRunning
On Error GoTo 0
Exit Sub
explorerTimer_Timer_Error:
With Err
If .Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure explorerTimer_Timer of Form dock"
Resume Next
End If
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Load
' Author : beededea
' Date : 30/01/2023
' Purpose :
'---------------------------------------------------------------------------------------
'
Private Sub Form_Load()
' .06 DAEB 03/03/2021 mdlMain.bas removed the appSystrayTypes feature, no longer needed to access the systray apps
' .05 DAEB frmMain.frm 10/02/2021 changes to handle invisible windows that exist in the known apps systray list
'appSystrayTypes = "GPU-Z|XWidget|Lasso|Open Hardware Monitor|CintaNotes" ' systray apps list, add to the list those apps you find that can be minimised to the systray
'=========================================
' program starts!
'=========================================
' comment the following function back in only when debugging
On Error GoTo Form_Load_Error
' Clear all the message box "show again" entries in the registry
Call clearAllMessageBoxRegistryEntries
' set some variable values ready for operation
Call setSomeValues
' set debugging if required
Call toggleDebugging
' write to the debuglog to log
debugLog "*****************************"
debugLog "% SteamyDock program started."
debugLog "*****************************"
' checks whether the system is 32bit or 64bit
sixtyFourBit = Is64bit()
' extracts all the known drive names using Windows APIs to a useful global var
Call getAllDriveNames(sAllDrives)
'if the process already exists then kill it
Call testDockRunning
' check the state of the licence
Call checkLicenceState
' check the Windows version
Call testWindowsVersion(classicThemeCapable)
' turn off the option to run as administrator
Call disableAdmin ' .17 DAEB frmMain.frm 27/01/2021 Moved disabling admin to a separate routine
' we check to see if rocketdock is installed in order to know the location of the settings.ini file used by Rocketdock
'Call checkRocketdockInstallation ' also sets rdAppPath
' check where steamyDock is installed, seems obvious but someone could be running the binary somewhere remote from its default location
Call checkSteamyDockInstallation ' in any case it sets the sdPathPath
' validate all the components are in place for this program to run.
If fValidateComponents = False Then
' at the moment if components are missing we do nothing, just let SD attempt to start,
End If
' get the location of the dock's new settings file
Call locateDockSettingsFile
' read the dock settings from INI or from registry
Call readDockConfiguration
' set the hotkey toggle to the user's chosen function key
Call setUserHotKey ' .13 DAEB frmMain.frm 27/01/2021 Added system wide keypress support
' working here!
' no need to determine which monitor we should use, we know this from rdMonitor gleaned from readDockConfiguration above.
' monitor validation, despite the value set in config, we need to check again as a monitor may have been disconnected.
If Val(rDMonitor) + 1 > GetMonitorCount Then
rDMonitor = "0" 'validate
End If
' If Val(rDMonitor) > 0 Then
' ' get screen bounds
' ' position the dock onto the correct monitor using the current monitor left position plus 1
' getDeviceHdc
'
' ' set the device (screen) context default to primary monitor
' If hdcScreen = 0 Then
hdcScreen = Me.hdc
' End If
'
' 'CenterFormOnMonitorTwo dock
' End If