-
Notifications
You must be signed in to change notification settings - Fork 0
/
TCAppBar.cls
1219 lines (1026 loc) · 41.6 KB
/
TCAppBar.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 = "TCAppBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'TCAppBar Class
'implements Application TaskBar with any given form
'Copyright Vadim Maslov, Dec. 1999
Option Explicit
'=======================================
'EVENTS
'=======================================
Public Event PositionChanged(newPosition As TCAppBarEdge)
Public Event AutoHideAppeared()
Public Event AutoHideDisappeared()
'=======================================
'EXPORTED ENUMERATIONS
'=======================================
Public Enum TCAppBarEdge
ABE_LEFT = 0
ABE_TOP = 1
ABE_RIGHT = 2
ABE_BOTTOM = 3
ABE_FLOAT = 4
End Enum
'=======================================
'PRIVATE ENUMERATIONS
'=======================================
Private Enum TCAppBarMessages
ABM_ACTIVATE = &H6 ' lParam == TRUE/FALSE means activate/deactivate
ABM_GETAUTOHIDEBAR = &H7
ABM_GETSTATE = &H4
ABM_GETTASKBARPOS = &H5
ABM_NEW = &H0
ABM_QUERYPOS = &H2
ABM_REMOVE = &H1
ABM_SETAUTOHIDEBAR = &H8 ' this can fail at any time. MUST check the result
ABM_SETPOS = &H3
ABM_WINDOWPOSCHANGED = &H9
End Enum
Private Enum TCAppBarNotifications
ABN_FULLSCREENAPP = &H2
ABN_POSCHANGED = &H1
ABN_STATECHANGE = &H0
ABN_WINDOWARRANGE = &H3 ' lParam == TRUE means hide
End Enum
Private Enum TCAppBarState
ABS_ALWAYSONTOP = &H2
ABS_AUTOHIDE = &H1
End Enum
'=======================================
'PRIVATE TYPES
'=======================================
Private Type TCAppBarSettings
hwnd As Long
AutoHide As Boolean
AlwaysOnTop As Boolean
uEdge As TCAppBarEdge
abSlide As Boolean
abSlideInterval As Long
abDockHorSize As Long
abDockVerSize As Long
abFloatRect As RECT
abIncHorizontal As Long
abIncVertical As Long
abFloatCaption As Boolean
abMinWidth As Long
abMinHeight As Long
abMinDockHeight As Long
abMinDockWidth As Long
abMaxWidth As Long
abMaxHeight As Long
abMaxDockWidth As Long
abMaxDockHeight As Long
abConformTaskBar As Boolean
abAllowLeft As Boolean
abAllowRight As Boolean
abAllowTop As Boolean
abAllowBottom As Boolean
abAllowFloat As Boolean
End Type
Private Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As TCAppBarEdge
rc As RECT
lParam As Long ' message specific
End Type
'=======================================
'PRIVATE VARIABLES
'=======================================
Private g_fRegistered As Boolean ' flag to reflect if the appbar is registered
Private g_abSettings As TCAppBarSettings ' var to store session-scope appbar settings
Private g_FullScreenAppActive As Boolean ' flag to reflect if full screen application is currently running
Private PrevEdge As TCAppBarEdge ' var to store previous position of the appbar
Private oldExStyle As Long ' var to store previous window styles of the passed hwnd
Private BarIsHidden As Boolean ' flag to reflect if appbar is currently hidden
'=======================================
'PRIVATE DECLARES
'=======================================
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 SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As TCAppBarMessages, _
pData As APPBARDATA) As Long
'=======================================
'PUBLIC PROPERTIES
'==========================================
Public Property Get AllowLeft() As Boolean
AllowLeft = g_abSettings.abAllowLeft
End Property
Public Property Let AllowLeft(vAllow As Boolean)
If Not vAllow = g_abSettings.abAllowLeft Then
g_abSettings.abAllowLeft = vAllow
End If
End Property
Public Property Get AllowRight() As Boolean
AllowRight = g_abSettings.abAllowRight
End Property
Public Property Let AllowRight(vAllow As Boolean)
If Not vAllow = g_abSettings.abAllowRight Then
g_abSettings.abAllowRight = vAllow
End If
End Property
Public Property Get AllowTop() As Boolean
AllowTop = g_abSettings.abAllowTop
End Property
Public Property Let AllowTop(vAllow As Boolean)
If Not vAllow = g_abSettings.abAllowTop Then
g_abSettings.abAllowTop = vAllow
End If
End Property
Public Property Get AllowBottom() As Boolean
AllowBottom = g_abSettings.abAllowBottom
End Property
Public Property Let AllowBottom(vAllow As Boolean)
If Not vAllow = g_abSettings.abAllowBottom Then
g_abSettings.abAllowBottom = vAllow
End If
End Property
Public Property Get AllowFloat() As Boolean
AllowFloat = g_abSettings.abAllowFloat
End Property
Public Property Let AllowFloat(vAllow As Boolean)
If Not vAllow = g_abSettings.abAllowFloat Then
g_abSettings.abAllowFloat = vAllow
End If
End Property
Public Property Get ConformWithTaskBar() As Boolean
ConformWithTaskBar = g_abSettings.abConformTaskBar
End Property
Public Property Let ConformWithTaskBar(mValue As Boolean)
g_abSettings.abConformTaskBar = mValue
If g_fRegistered Then SetAppBarState
End Property
Public Property Get MaxWidth() As Long
MaxWidth = g_abSettings.abMaxWidth
End Property
Public Property Let MaxWidth(mMaxWidth As Long)
If Not (mMaxWidth <= g_abSettings.abMinWidth) Then
g_abSettings.abMaxWidth = mMaxWidth
If (g_abSettings.abFloatRect.Right - g_abSettings.abFloatRect.Left) > mMaxWidth Then
g_abSettings.abFloatRect.Right = g_abSettings.abFloatRect.Left + mMaxWidth
If (g_fRegistered) And (g_abSettings.uEdge = ABE_FLOAT) Then SetAppBarPos
End If
End If
End Property
Public Property Get MaxHeight() As Long
MaxHeight = g_abSettings.abMaxHeight
End Property
Public Property Let MaxHeight(mMaxHeight As Long)
If Not (mMaxHeight <= g_abSettings.abMaxHeight) Then
g_abSettings.abMaxHeight = mMaxHeight
If (g_abSettings.abFloatRect.Bottom - g_abSettings.abFloatRect.Top) > mMaxHeight Then
g_abSettings.abFloatRect.Bottom = g_abSettings.abFloatRect.Top + mMaxHeight
If (g_fRegistered) And (g_abSettings.uEdge = ABE_FLOAT) Then SetAppBarPos
End If
End If
End Property
Public Property Get MaxDockWidth() As Long
MaxDockWidth = g_abSettings.abMaxDockWidth
End Property
Public Property Let MaxDockWidth(maxDWidth As Long)
If Not (maxDWidth <= g_abSettings.abMinDockWidth) Then
g_abSettings.abMaxDockWidth = maxDWidth
If (g_abSettings.abDockHorSize > maxDWidth) Then
g_abSettings.abDockHorSize = maxDWidth
If (g_fRegistered) And (g_abSettings.uEdge = ABE_LEFT Or g_abSettings.uEdge = ABE_RIGHT) Then _
SetAppBarPos
End If
End If
End Property
Public Property Get MaxDockHeight() As Long
MaxDockHeight = g_abSettings.abMaxDockHeight
End Property
Public Property Let MaxDockHeight(maxDHeight As Long)
If Not (maxDHeight <= g_abSettings.abMaxDockHeight) Then
g_abSettings.abMaxDockHeight = maxDHeight
If (g_abSettings.abDockVerSize > maxDHeight) Then
g_abSettings.abDockVerSize = maxDHeight
If (g_fRegistered) And (g_abSettings.uEdge = ABE_TOP Or g_abSettings.uEdge = ABE_BOTTOM) Then _
SetAppBarPos
End If
End If
End Property
Public Property Get MinDockHeight() As Long
MinDockHeight = g_abSettings.abMinDockHeight
End Property
Public Property Let MinDockHeight(mdHeight As Long)
If Not (mdHeight >= g_abSettings.abMaxDockHeight) Then
g_abSettings.abMinDockHeight = mdHeight
If (g_abSettings.abDockVerSize < mdHeight) Then
g_abSettings.abDockVerSize = mdHeight
If (g_fRegistered) And (g_abSettings.uEdge = ABE_TOP Or g_abSettings.uEdge = ABE_BOTTOM) Then _
SetAppBarPos
End If
End If
End Property
Public Property Get MinDockWidth() As Long
MinDockWidth = g_abSettings.abMinDockWidth
End Property
Public Property Let MinDockWidth(mdWidth As Long)
If Not (mdWidth >= g_abSettings.abMaxDockWidth) Then
g_abSettings.abMinDockWidth = mdWidth
If (g_abSettings.abDockHorSize < mdWidth) Then
g_abSettings.abDockHorSize = mdWidth
If (g_fRegistered) And (g_abSettings.uEdge = ABE_LEFT Or g_abSettings.uEdge = ABE_RIGHT) Then _
SetAppBarPos
End If
End If
End Property
Public Property Get MinHeight() As Long
MinHeight = g_abSettings.abMinHeight
End Property
Public Property Let MinHeight(mHeight As Long)
If Not (mHeight >= g_abSettings.abMaxHeight) Then
g_abSettings.abMinHeight = mHeight
If (g_abSettings.abFloatRect.Bottom - g_abSettings.abFloatRect.Top) > mHeight Then
g_abSettings.abFloatRect.Bottom = g_abSettings.abFloatRect.Top + mHeight
If (g_fRegistered) And (g_abSettings.uEdge = ABE_FLOAT) Then SetAppBarPos
End If
End If
End Property
Public Property Get MinWidth() As Long
MinWidth = g_abSettings.abMinWidth
End Property
Public Property Let MinWidth(mWidth As Long)
If Not (mWidth <= g_abSettings.abMaxWidth) Then
g_abSettings.abMinWidth = mWidth
If (g_abSettings.abFloatRect.Right - g_abSettings.abFloatRect.Left) > mWidth Then
g_abSettings.abFloatRect.Right = g_abSettings.abFloatRect.Left + mWidth
If (g_fRegistered) And (g_abSettings.uEdge = ABE_FLOAT) Then SetAppBarPos
End If
End If
End Property
Public Property Get EDGE() As TCAppBarEdge
EDGE = g_abSettings.uEdge
End Property
Public Property Let EDGE(nEdge As TCAppBarEdge)
If nEdge <> g_abSettings.uEdge Then
PrevEdge = g_abSettings.uEdge
g_abSettings.uEdge = nEdge
RaiseEvent PositionChanged(nEdge)
End If
If g_fRegistered Then Call SetAppBarPos
End Property
Public Property Get CaptionOnFloat() As Boolean
CaptionOnFloat = g_abSettings.abFloatCaption
End Property
Public Property Let CaptionOnFloat(fCaption As Boolean)
g_abSettings.abFloatCaption = fCaption
End Property
Public Property Get DockHorizontalWidth() As Long
DockHorizontalWidth = g_abSettings.abDockHorSize
End Property
Public Property Let DockHorizontalWidth(nWidth As Long)
If (Not nWidth > g_abSettings.abMaxDockWidth) And Not (nWidth < g_abSettings.abMinDockWidth) Then
g_abSettings.abDockHorSize = nWidth
If g_fRegistered Then Call SetAppBarPos
End If
End Property
Public Property Get DockVerticalHeight() As Long
DockVerticalHeight = g_abSettings.abDockVerSize
End Property
Public Property Let DockVerticalHeight(nHeight As Long)
If Not (nHeight > g_abSettings.abMaxDockHeight) And Not (nHeight < g_abSettings.abMinDockHeight) Then
g_abSettings.abDockVerSize = nHeight
If g_fRegistered Then Call SetAppBarPos
End If
End Property
Public Property Get ResizeIncrementHorizontal() As Long
ResizeIncrementHorizontal = g_abSettings.abIncHorizontal
End Property
Public Property Let ResizeIncrementHoriztonal(hIncrement As Long)
g_abSettings.abIncHorizontal = hIncrement
End Property
Public Property Get ResizeIncrementVertical() As Long
ResizeIncrementVertical = g_abSettings.abIncVertical
End Property
Public Property Let ResizeIncrementVertical(vIncrement As Long)
g_abSettings.abIncVertical = vIncrement
End Property
Public Property Get AutoHide() As Boolean
AutoHide = g_abSettings.AutoHide
End Property
Public Property Let AutoHide(g_AutoHide As Boolean)
g_abSettings.AutoHide = g_AutoHide
If g_fRegistered Then Call SetAppBarState
End Property
Public Property Get AlwaysOnTop() As Boolean
AlwaysOnTop = g_abSettings.AlwaysOnTop
End Property
Public Property Let AlwaysOnTop(g_AlwaysOnTop As Boolean)
g_abSettings.AlwaysOnTop = g_AlwaysOnTop
If g_fRegistered Then Call SetAppBarState
End Property
Public Property Get SlideEffect() As Boolean
SlideEffect = g_abSettings.abSlide
End Property
Public Property Let SlideEffect(g_SlideEffect As Boolean)
g_abSettings.abSlide = g_SlideEffect
End Property
Public Property Get SlideInterval() As Long
SlideInterval = g_abSettings.abSlideInterval
End Property
Public Property Let SlideInterval(g_SlideInterval As Long)
g_abSettings.abSlideInterval = g_SlideInterval
End Property
'=======================================
'PUBLIC FUNCTIONS
'==========================================
Public Function Attach(hwnd As Long) As Boolean
Dim wRect As RECT
If g_fRegistered Then Attach = False: Exit Function
Call GetWindowRect(hwnd, wRect)
g_abSettings.hwnd = hwnd
g_abSettings.abFloatRect = wRect
Attach = RegisterAppBar(True)
End Function
Public Function Detach() As Boolean
If Not g_fRegistered Then Detach = False: Exit Function
Detach = RegisterAppBar(False)
End Function
'=======================================
'FRIEND FUNCTIONS called from AppBarModule
'==========================================
Friend Function onMinMaxInfo(ByVal lpMinMaxInfo As Long) As Long
'controlling window resize by setting window's maximum and minimum
'resize values
Dim mmInfo As MINMAXINFO
CopyMemory VarPtr(mmInfo), lpMinMaxInfo, Len(mmInfo)
Select Case g_abSettings.uEdge
Case ABE_LEFT, ABE_RIGHT
mmInfo.ptMinTrackSize.x = g_abSettings.abMinDockWidth
mmInfo.ptMinTrackSize.y = GetSystemMetrics(SM_CYSCREEN)
mmInfo.ptMaxTrackSize.x = g_abSettings.abMaxDockWidth
mmInfo.ptMaxTrackSize.y = GetSystemMetrics(SM_CYSCREEN)
Case ABE_TOP, ABE_BOTTOM
mmInfo.ptMinTrackSize.x = GetSystemMetrics(SM_CXSCREEN)
mmInfo.ptMinTrackSize.y = g_abSettings.abMinDockHeight
mmInfo.ptMaxTrackSize.x = GetSystemMetrics(SM_CXSCREEN)
mmInfo.ptMaxTrackSize.y = g_abSettings.abMaxDockHeight
Case ABE_FLOAT
mmInfo.ptMinTrackSize.x = g_abSettings.abMinWidth
mmInfo.ptMinTrackSize.y = g_abSettings.abMinHeight
mmInfo.ptMaxTrackSize.x = g_abSettings.abMaxWidth
mmInfo.ptMaxTrackSize.y = g_abSettings.abMaxHeight
End Select
'return adjusted structure and stop default message processing
CopyMemory lpMinMaxInfo, VarPtr(mmInfo), Len(mmInfo)
onMinMaxInfo = 0
End Function
Friend Function onExitSizeMove() As Long
'remember the new window dimesions
If Not g_fRegistered Then Exit Function
Dim rc As RECT
Call GetWindowRect(g_abSettings.hwnd, rc)
If EDGE = PrevEdge Then
Select Case EDGE
Case ABE_LEFT, ABE_RIGHT: g_abSettings.abDockHorSize = rc.Right - rc.Left
Case ABE_TOP, ABE_BOTTOM: g_abSettings.abDockVerSize = rc.Bottom - rc.Top
End Select
End If
If PrevEdge = ABE_FLOAT Then
If EDGE = ABE_FLOAT Then g_abSettings.abFloatRect = rc
End If
EDGE = g_abSettings.uEdge
SetAppBarState
onExitSizeMove = 0
End Function
Friend Function onAppBarCallback(ByVal wParam, ByVal lParam) As Long
'what we do when the system notifies us about changes to other appbars
Select Case wParam
Case ABN_POSCHANGED: SetAppBarPos
Case ABN_STATECHANGE: If g_abSettings.abConformTaskBar Then AdjustToTaskBar
Case ABN_FULLSCREENAPP: g_FullScreenAppActive = CBool(lParam): SetAppBarState
End Select
onAppBarCallback = 0
End Function
Friend Function onWinPosChanged() As Long
Dim abd As APPBARDATA
abd.cbSize = Len(abd)
abd.hwnd = g_abSettings.hwnd
SHAppBarMessage ABM_WINDOWPOSCHANGED, abd
End Function
Friend Function onActivate(ByVal wParam As Long)
Dim abd As APPBARDATA
abd.cbSize = Len(abd)
abd.hwnd = g_abSettings.hwnd
SHAppBarMessage ABM_ACTIVATE, abd
If (wParam = WA_INACTIVE) And (g_abSettings.AutoHide) And _
(Not BarIsHidden) Then HideAppbar True
End Function
Friend Function onMoving(ByVal lParam As Long) As Long
Dim pt As POINTAPI
Dim proposedEdge As TCAppBarEdge
Dim rc As RECT
Dim iWidth As Long
Dim iHeight As Long
'lParam is a pointer to rc structure
CopyMemory VarPtr(rc), lParam, Len(rc)
'find out where is the cursor when WM_MOVING was posted
pt = GetPosAtMessage
'Calculate the edge we should dock to depending on mouse position
proposedEdge = EdgeFromPoint(pt)
If (proposedEdge = ABE_BOTTOM) And (Not g_abSettings.abAllowBottom) Or _
(proposedEdge = ABE_LEFT) And (Not g_abSettings.abAllowLeft) Or _
(proposedEdge = ABE_RIGHT) And (Not g_abSettings.abAllowRight) Or _
(proposedEdge = ABE_TOP) And (Not g_abSettings.abAllowTop) Or _
(proposedEdge = ABE_FLOAT) And (Not g_abSettings.abAllowFloat) Then
If PrevEdge = ABE_FLOAT Then
onMoving = -1
Else
rc = MoveBack(PrevEdge)
CopyMemory lParam, VarPtr(rc), Len(rc)
onMoving = 0
End If
Exit Function
End If
'if changed from docked to float
If PrevEdge <> ABE_FLOAT And proposedEdge = ABE_FLOAT Then
'if float window is set to have caption, change window style then
If g_abSettings.abFloatCaption Then _
ChangeWndStyle g_abSettings.hwnd, GWL_STYLE, WS_CAPTION Or WS_SYSMENU, _
0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER, False
'get the last remembered floating rectangle
rc = g_abSettings.abFloatRect
'calculate width and height to preserve them
iWidth = rc.Right - rc.Left
iHeight = rc.Bottom - rc.Top
'reposition rectangle so that we preserve width and height, but change the position
'with regards to cursor location at the moment when WM_MOVE was posted
With rc
.Left = pt.x - (iWidth \ 2)
.Right = pt.x + (iWidth \ 2)
.Top = pt.y
.Bottom = pt.y + iHeight
End With
'remember the new window position and size
g_abSettings.abFloatRect = rc
ElseIf PrevEdge = ABE_FLOAT And proposedEdge <> ABE_FLOAT Then
'remove caption and menu from the window if it's about to be docked
ChangeWndStyle g_abSettings.hwnd, GWL_STYLE, 0, WS_CAPTION Or _
WS_SYSMENU, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER, False
End If
If proposedEdge <> PrevEdge Then
RaiseEvent PositionChanged(proposedEdge)
PrevEdge = proposedEdge
End If
'query the system for new approved window location
GetDestRect proposedEdge, rc
'remember new calculated edge
g_abSettings.uEdge = proposedEdge
'change the default rc and pass it as lParam back
CopyMemory lParam, VarPtr(rc), Len(rc)
'stop default processing
onMoving = 0
End Function
Friend Function onEnterSizeMove() As Long
PrevEdge = EDGE
onEnterSizeMove = 0
End Function
Friend Function onNcHitTest(ByRef defResult As Long) As Long
Dim Result As HITTEST
Dim virtualKey As VIRTUAL_KEY
Dim primaryMouseDown As Boolean
Result = defResult
'check which button is default
If GetSystemMetrics(SM_SWAPBUTTON) = 0 Then
virtualKey = VK_LBUTTON
Else
virtualKey = VK_RBUTTON
End If
'primaryMouseDown is true if the default mouse button is pressed
primaryMouseDown = CBool(GetAsyncKeyState(virtualKey) And &H8000)
'if cursor is in window client area and default mouse is down and appbar is docked or
'if not docked, but has no caption then return HTCAPTION - window will be moved
If (Result = HTCLIENT) And primaryMouseDown Then
If EDGE <> ABE_FLOAT Or (EDGE = ABE_FLOAT And CaptionOnFloat = False) Then Result = HTCAPTION
End If
'if appbar is floating and result code is resizing code then check for resize increment,
'if to allow corresponding resizing
If (EDGE = ABE_FLOAT) And (Result >= HTSIZEFIRST) And (Result <= HTSIZELAST) Then
Select Case Result
Case HTLEFT, HTRIGHT
If ResizeIncrementHorizontal = 0 Then Result = HTBORDER
Case HTTOP, HTBOTTOM
If ResizeIncrementVertical = 0 Then Result = HTBORDER
Case HTTOPLEFT
If (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTBORDER
ElseIf (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal <> 0) Then
Result = HTLEFT
ElseIf (ResizeIncrementVertical <> 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTTOP
End If
Case HTTOPRIGHT
If (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTBORDER
ElseIf (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal <> 0) Then
Result = HTRIGHT
ElseIf (ResizeIncrementVertical <> 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTTOP
End If
Case HTBOTTOMLEFT
If (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTBORDER
ElseIf (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal <> 0) Then
Result = HTLEFT
ElseIf (ResizeIncrementVertical <> 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTBOTTOM
End If
Case HTBOTTOMRIGHT
If (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTBORDER
ElseIf (ResizeIncrementVertical = 0) And (ResizeIncrementHorizontal <> 0) Then
Result = HTRIGHT
ElseIf (ResizeIncrementVertical <> 0) And (ResizeIncrementHorizontal = 0) Then
Result = HTBOTTOM
End If
End Select
End If
'if appbar is docked and result is resize code
If (EDGE <> ABE_FLOAT) And (Result >= HTSIZEFIRST) And (Result <= HTSIZELAST) Then
'check if resizing allowed on this edge
Select Case EDGE
Case ABE_LEFT, ABE_RIGHT: If ResizeIncrementHorizontal = 0 Then Result = HTBORDER
Case ABE_TOP, ABE_BOTTOM: If ResizeIncrementVertical = 0 Then Result = HTBORDER
End Select
'check if we can allow resizing this edge
Select Case EDGE
Case ABE_LEFT
If Result <> HTRIGHT Then Result = HTBORDER
Case ABE_RIGHT
If Result <> HTLEFT Then Result = HTBORDER
Case ABE_TOP
If Result <> HTBOTTOM Then Result = HTBORDER
Case ABE_BOTTOM
If Result <> HTTOP Then Result = HTBORDER
End Select
End If
'change the default value and return
defResult = Result
End Function
Friend Function onSizing(ByVal wParam As Long, ByVal lParam As Long)
Dim rc As RECT
Dim rcb As RECT
Dim iWidth As Long
Dim iHeight As Long
Dim MinWidth As Long
Dim MinHeight As Long
Dim curWidth As Long
Dim curHeight As Long
'lParam contains rc structure of new proposed rectangle
CopyMemory VarPtr(rc), lParam, Len(rc)
'current appbar's width and height
curWidth = rc.Right - rc.Left
curHeight = rc.Bottom - rc.Top
'rcb is the minimum posible rectangle of the appbar
'MinWidth and MinHeight will store the minimum possible width and height of the appbar
rcb.Left = 0
rcb.Top = 0
Select Case EDGE
Case ABE_FLOAT
rcb.Right = MinWidth
rcb.Bottom = MinHeight
Case Else
rcb.Right = MinDockWidth
rcb.Bottom = MinDockHeight
End Select
MinWidth = rcb.Right - rcb.Left
MinHeight = rcb.Bottom - rcb.Top
'If horizontal increment is not 0 then calculate the most proximate int value for the width
If g_abSettings.abIncHorizontal <> 0 Then
iWidth = (((curWidth - MinWidth) + (g_abSettings.abIncHorizontal \ 2)) \ g_abSettings.abIncHorizontal) * _
g_abSettings.abIncHorizontal + MinWidth
Else
iWidth = curWidth
End If
'If vertical increment is not 0 then calculate the most proximate int value for the height
If g_abSettings.abIncVertical <> 0 Then
iHeight = (((curHeight - MinHeight) + (g_abSettings.abIncVertical \ 2)) \ g_abSettings.abIncVertical) * _
g_abSettings.abIncVertical + MinHeight
Else
iHeight = curHeight
End If
'action depends on which side is being resized (wParam contains this info)
'action is to adjust the appbar's rectangle correspondingly and pass it back to lparam
Select Case wParam
Case WMSZ_LEFT: rc.Left = rc.Right - iWidth
Case WMSZ_RIGHT: rc.Right = rc.Left + iWidth
Case WMSZ_TOP: rc.Top = rc.Bottom - iHeight
Case WMSZ_BOTTOM: rc.Bottom = rc.Top + iHeight
Case WMSZ_TOPLEFT: rc.Top = rc.Bottom - iHeight: rc.Left = rc.Right - iWidth
Case WMSZ_TOPRIGHT: rc.Bottom = rc.Top + iHeight: rc.Right = rc.Left + iWidth
Case WMSZ_BOTTOMLEFT: rc.Bottom = rc.Top + iHeight: rc.Left = rc.Right - iWidth
Case WMSZ_BOTTOMRIGHT: rc.Bottom = rc.Top + iHeight: rc.Right = rc.Left + iWidth
End Select
CopyMemory lParam, VarPtr(rc), Len(rc)
onSizing = 0
End Function
Friend Function onTimer()
Dim pt As POINTAPI
Dim rc As RECT
'if appbar is in autohide mode and not floating and currently not hidden
If (g_abSettings.uEdge = ABE_FLOAT) Or (BarIsHidden) Or _
(g_abSettings.AutoHide = False) Then Exit Function
'if it is not the active window
If GetActiveWindow <> g_abSettings.hwnd Then
pt = GetPosAtMessage
GetWindowRect g_abSettings.hwnd, rc
If Not IsPointInRect(rc, pt) Then 'and if mouse is not on it
HideAppbar True ' slide it to hide
End If
End If
End Function
Friend Function onNCMOUSEMOVE()
If BarIsHidden Then HideAppbar False
End Function
'=======================================
'PRIVATE FUNCTIONS
'=======================================
Private Function RegisterAppBar(fRegister As Boolean) As Boolean
Dim nResult As Long
Dim abData As APPBARDATA
Dim hMenu As Long
abData.cbSize = Len(abData)
abData.hwnd = g_abSettings.hwnd
If fRegister Then
abData.uCallbackMessage = WM_APPBARMSG
If CBool(SHAppBarMessage(ABM_NEW, abData)) = False Then
RegisterAppBar = False
Exit Function
End If
'Make sure our window is a toolwindow acting as a toolbar
'Force style change, but store default style in oldExStyle to restore
oldExStyle = SetWindowLong(g_abSettings.hwnd, GWL_EXSTYLE, _
WS_EX_TOOLWINDOW)
g_fRegistered = True
Call SubclassAppBar(g_abSettings.hwnd, Me)
SetTimer g_abSettings.hwnd, 120, g_abSettings.abSlideInterval, 0
SetAppBarState
RaiseEvent PositionChanged(g_abSettings.uEdge)
Else
Call SHAppBarMessage(ABM_REMOVE, abData)
SetWindowLong g_abSettings.hwnd, GWL_EXSTYLE, oldExStyle
KillTimer g_abSettings.hwnd, 120
g_fRegistered = False
UnsubclassAppBar
End If
RegisterAppBar = True
End Function
Private Function SetAppBarState()
Dim abData As APPBARDATA
Dim wndPos As SWP_hWndInsertAfter
Dim nRet As Long
If g_abSettings.abConformTaskBar Then
AdjustToTaskBar
Exit Function
End If
If g_abSettings.AlwaysOnTop = True Then
wndPos = HWND_TOPMOST
Else
wndPos = HWND_NOTOPMOST
End If
If g_FullScreenAppActive Then wndPos = HWND_BOTTOM
abData.cbSize = Len(abData)
abData.hwnd = g_abSettings.hwnd
abData.uEdge = g_abSettings.uEdge
If g_abSettings.AutoHide Then abData.lParam = 1
nRet = SHAppBarMessage(ABM_SETAUTOHIDEBAR, abData)
If (g_abSettings.AutoHide) And nRet = 0 Then g_abSettings.AutoHide = False
Call SetWindowPos(g_abSettings.hwnd, wndPos, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or _
SWP_NOACTIVATE)
End Function
Private Function SetAppBarPos(Optional AfterHiddenState As Boolean)
Dim abData As APPBARDATA
Dim bufRC As RECT
Dim curEdge As TCAppBarEdge
'Initialize APPBARDATA structure
abData.cbSize = Len(abData)
abData.hwnd = g_abSettings.hwnd
abData.uEdge = g_abSettings.uEdge
'Fill abData rectangle with screen coordinates
abData.rc.Left = 0: abData.rc.Top = 0
abData.rc.Right = GetSystemMetrics(SM_CXSCREEN)
abData.rc.Bottom = GetSystemMetrics(SM_CYSCREEN)
'Query suggested appbar position from the system
Call SHAppBarMessage(ABM_QUERYPOS, abData)
'Adjust destination rectangle
Select Case g_abSettings.uEdge
Case ABE_LEFT: abData.rc.Right = abData.rc.Left + g_abSettings.abDockHorSize
Case ABE_RIGHT: abData.rc.Left = abData.rc.Right - g_abSettings.abDockHorSize
Case ABE_TOP: abData.rc.Bottom = abData.rc.Top + g_abSettings.abDockVerSize
Case ABE_BOTTOM: abData.rc.Top = abData.rc.Bottom - g_abSettings.abDockVerSize
End Select
'Finally set the appbar position
If Not g_abSettings.AutoHide Then
SHAppBarMessage ABM_SETPOS, abData
Else
'if bar is in autohide mode then we store original position in bufRC
'and pass the system false rectangle
bufRC = abData.rc
abData.rc.Left = 0: abData.rc.Top = 0: abData.rc.Right = 0: abData.rc.Bottom = 0
SHAppBarMessage ABM_SETPOS, abData
'restore the original position of appbar
abData.rc = bufRC
End If
'Move appbar window correspondingly
If g_abSettings.uEdge <> ABE_FLOAT Then
ChangeWndStyle g_abSettings.hwnd, GWL_STYLE, 0, WS_CAPTION Or _
WS_SYSMENU, SWP_DRAWFRAME, False
If g_abSettings.abSlide And Not AfterHiddenState Then
Dim hInc As Long
Dim vInc As Long
hInc = (abData.rc.Right - abData.rc.Left) \ 3
vInc = (abData.rc.Bottom - abData.rc.Top) \ 3
Select Case g_abSettings.uEdge
Case ABE_LEFT
MoveWindow g_abSettings.hwnd, abData.rc.Left + hInc, abData.rc.Top, _
(abData.rc.Right - abData.rc.Left), (abData.rc.Bottom - abData.rc.Top), 1
Case ABE_RIGHT
MoveWindow g_abSettings.hwnd, abData.rc.Left - hInc, abData.rc.Top, _
(abData.rc.Right - abData.rc.Left), (abData.rc.Bottom - abData.rc.Top), 1
Case ABE_TOP
MoveWindow g_abSettings.hwnd, abData.rc.Left, abData.rc.Top + vInc, _
(abData.rc.Right - abData.rc.Left), (abData.rc.Bottom - abData.rc.Top), 1
Case ABE_BOTTOM
MoveWindow g_abSettings.hwnd, abData.rc.Left, abData.rc.Top - vInc, _
(abData.rc.Right - abData.rc.Left), (abData.rc.Bottom - abData.rc.Top), 1
End Select
End If
SlideBar abData.rc
Else
If g_abSettings.abFloatCaption Then _
ChangeWndStyle g_abSettings.hwnd, GWL_STYLE, WS_CAPTION Or WS_SYSMENU, 0, _
SWP_DRAWFRAME, False
SlideBar g_abSettings.abFloatRect
End If
End Function
'Function queries the system for approved appbar position on given edge
Private Function GetDestRect(uEdge As TCAppBarEdge, rc As RECT)
'if we float, just return the same rectangle
If uEdge = ABE_FLOAT Then Exit Function
Dim abd As APPBARDATA
'initialize APPBARDATA
abd.cbSize = Len(abd)
abd.hwnd = g_abSettings.hwnd
abd.uEdge = uEdge
'set default rectangle as screen area
With rc
.Left = 0
.Right = GetSystemMetrics(SM_CXSCREEN)
.Top = 0
.Bottom = GetSystemMetrics(SM_CYSCREEN)
End With
'query the system
If Not g_abSettings.AutoHide Then SHAppBarMessage ABM_QUERYPOS, abd
'return updated rectangle
Select Case uEdge
Case ABE_LEFT: rc.Right = rc.Left + g_abSettings.abDockHorSize
Case ABE_RIGHT: rc.Left = rc.Right - g_abSettings.abDockHorSize
Case ABE_TOP: rc.Bottom = rc.Top + g_abSettings.abDockVerSize
Case ABE_BOTTOM: rc.Top = rc.Bottom - g_abSettings.abDockVerSize
End Select
End Function
Private Function MoveBack(uEdge As TCAppBarEdge) As RECT
Dim rc As RECT
Select Case uEdge
Case ABE_LEFT
rc.Left = 0
rc.Top = 0
rc.Bottom = GetSystemMetrics(SM_CYSCREEN)
rc.Right = g_abSettings.abDockHorSize
Case ABE_RIGHT
rc.Top = 0
rc.Bottom = GetSystemMetrics(SM_CYSCREEN)
rc.Left = GetSystemMetrics(SM_CXSCREEN) - g_abSettings.abDockHorSize
rc.Right = GetSystemMetrics(SM_CXSCREEN)
Case ABE_TOP
rc.Left = 0
rc.Top = 0
rc.Right = GetSystemMetrics(SM_CXSCREEN)
rc.Bottom = g_abSettings.abDockVerSize
Case ABE_BOTTOM
rc.Left = 0
rc.Right = GetSystemMetrics(SM_CXSCREEN)
rc.Top = GetSystemMetrics(SM_CYSCREEN) - g_abSettings.abDockVerSize
rc.Bottom = GetSystemMetrics(SM_CYSCREEN)
Case ABE_FLOAT
End Select
MoveBack = rc
End Function
Private Function GetHiddenRect(rc As RECT, mHide As Boolean) As Boolean
Dim vHorBorder As Long
Dim vVerBorder As Long
If (EDGE = ABE_FLOAT) Then
GetHiddenRect = False
Exit Function
End If
If mHide Then ' if we have to hide bar
' get size of border that will anyway be visible
vHorBorder = GetSystemMetrics(SM_CXBORDER) * 2
vVerBorder = GetSystemMetrics(SM_CYBORDER) * 2
'find out the appbar position so that only calculated edge is visible
Select Case EDGE
Case ABE_LEFT
rc.Top = 0
rc.Bottom = GetSystemMetrics(SM_CYSCREEN)
rc.Left = -(rc.Right - rc.Left) + vHorBorder
rc.Right = vHorBorder