-
Notifications
You must be signed in to change notification settings - Fork 10
/
frmPopupMenu.frm
676 lines (635 loc) · 25.1 KB
/
frmPopupMenu.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
VERSION 5.00
Object = "{ACD4732E-2B7C-40C1-A56B-078848D41977}#1.0#0"; "image.ocx"
Begin VB.Form frmPopupMenu
BackColor = &H001C1B1B&
BorderStyle = 0 'None
Caption = "Dark♂Menu"
ClientHeight = 2625
ClientLeft = 0
ClientTop = 0
ClientWidth = 2025
LinkTopic = "Form1"
ScaleHeight = 2625
ScaleWidth = 2025
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Timer tmrPopupTimeout
Enabled = 0 'False
Interval = 500
Left = 1200
Top = 2040
End
Begin VB.Timer tmrCheckFocus
Interval = 10
Left = 480
Top = 2040
End
Begin ImageX.aicAlphaImage imgShowSubMenu
Height = 225
Index = 0
Left = 1320
Top = 480
Visible = 0 'False
Width = 225
_ExtentX = 397
_ExtentY = 397
Image = "frmPopupMenu.frx":0000
Enabled = 0 'False
End
Begin VB.Image imgSubMenu
Enabled = 0 'False
Height = 225
Left = 1680
Picture = "frmPopupMenu.frx":0018
Top = 480
Visible = 0 'False
Width = 225
End
Begin ImageX.aicAlphaImage imgMenuCheckBox
Height = 345
Index = 0
Left = 1320
Top = 1080
Width = 345
_ExtentX = 609
_ExtentY = 609
Image = "frmPopupMenu.frx":036E
Enabled = 0 'False
End
Begin VB.Line lnSplitter
BorderColor = &H00373333&
Index = 0
Visible = 0 'False
X1 = 600
X2 = 1920
Y1 = 960
Y2 = 960
End
Begin VB.Image imgUnchecked
Enabled = 0 'False
Height = 225
Left = 1320
Picture = "frmPopupMenu.frx":0386
Top = 1560
Visible = 0 'False
Width = 225
End
Begin VB.Image imgChecked
Enabled = 0 'False
Height = 225
Left = 1680
Picture = "frmPopupMenu.frx":06DC
Top = 1560
Visible = 0 'False
Width = 225
End
Begin VB.Line lnBorderTop
BorderColor = &H00373333&
BorderWidth = 2
X1 = 840
X2 = 120
Y1 = 480
Y2 = 480
End
Begin VB.Line lnBorderLeft
BorderColor = &H00373333&
BorderWidth = 2
X1 = 120
X2 = 120
Y1 = 360
Y2 = 2040
End
Begin VB.Line lnBorderRight
BorderColor = &H00373333&
BorderWidth = 2
X1 = 960
X2 = 960
Y1 = 600
Y2 = 1680
End
Begin VB.Line lnBorderBottom
BorderColor = &H00373333&
BorderWidth = 2
X1 = 240
X2 = 1080
Y1 = 1800
Y2 = 1800
End
Begin VB.Label labItem
AutoSize = -1 'True
BackColor = &H001C1B1B&
Caption = " Item"
BeginProperty Font
Name = "Consolas"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00F0F0F0&
Height = 225
Index = 0
Left = 0
TabIndex = 0
Top = 0
Width = 525
End
End
Attribute VB_Name = "frmPopupMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const ITEM_DISTANCE = 90
Private Const ITEM_HORZ_MARGIN = 60
Private Const SPLITTER_VERT_MARGIN = 90
Private Const MIN_WIDTH = 1425
Private Const TRANSPARENT_VALUE = 210
Private Type MenuItem
MenuID As Integer
MenuText As String
SubMenus() As String 'Base = 1
SubMenuID() As Integer 'Base = 1
Enabled As Boolean
CheckBox As Boolean
Visible As Boolean
Checked As Boolean
MenuIcon() As Byte
End Type
Dim Menus() As MenuItem 'Base = 1
Dim CurrSubMenuID() As Integer 'Base = 1
Dim SpaceCount As Integer
Dim SubMenuWindow As frmPopupMenu
Dim BoundCtl As DarkMenu
Dim LabelWidth As Single
Dim PrevItem As Integer
Public MatchItem As Integer
Public IsPopupSub As Boolean
Dim IsUsingKeyboard As Boolean
Dim KeybdIndex As Integer
Public IsLastMenu As Boolean
Dim PrevX As Single, _
PrevY As Single
Public NoWhitelist As Boolean '如果从Pane上弹出菜单，第一次失焦会允许菜单不消失，第二次就关闭菜单
Dim KeyBindingList(vbKeyA To vbKeyZ) As Integer '如果菜单项里面有“&”，就把“&”前面的字母和菜单控件Index绑定起来，以实现键盘快捷键（实际对应的Index是该数组的值-1）
Public Sub CloseMenu()
On Error Resume Next
If Not SubMenuWindow Is Nothing Then
SubMenuWindow.CloseMenu
Set SubMenuWindow = Nothing
IsPopupSub = False
End If
Unload Me
End Sub
Private Sub PopupNewMenu(LabelIndex As Integer)
If Not SubMenuWindow Is Nothing Then
SubMenuWindow.CloseMenu
Set SubMenuWindow = Nothing
IsPopupSub = False
End If
Set SubMenuWindow = New frmPopupMenu
Me.IsPopupSub = True
With SubMenuWindow
.MatchItem = LabelIndex
.Left = Me.Left + Me.labItem(LabelIndex).Width - 15
.Top = Me.Top + Me.labItem(LabelIndex).Top - ITEM_DISTANCE
.AddItems BoundCtl, Menus(CurrSubMenuID(LabelIndex + 1)).SubMenuID
.NoWhitelist = True
.Show
If IsUsingKeyboard Then
Call .Form_KeyDown(vbKeyDown, 0)
End If
End With
If BoundCtl.Transparent Then
SetLayeredWindowAttributes Me.hwnd, 0, TRANSPARENT_VALUE, LWA_ALPHA
End If
End Sub
Public Sub AddItems(FromControl As DarkMenu, FromArray() As Integer, Optional ControlWidth As Integer)
On Error Resume Next
Dim i As Integer
Dim NewWidth As Integer
Dim HasCheckBox As Boolean
Dim HasSubMenu As Boolean
Dim nCheckBoxes As Integer
Dim nSubMenus As Integer
Dim nSplitters As Integer
CurrSubMenuID = FromArray
SpaceCount = FromControl.SpaceCount
Set BoundCtl = FromControl
PrevItem = -1
If BoundCtl.Transparent Then
SetWindowLongA Me.hwnd, GWL_EXSTYLE, GetWindowLongA(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes Me.hwnd, 0, 255, LWA_ALPHA
End If
ReDim Menus(FromControl.GetMenuCount)
For i = 1 To UBound(Menus)
With Menus(i)
FromControl.GetMenuItemInfo i, .MenuID, .MenuText, .Enabled, .CheckBox, _
.Visible, .SubMenus, .SubMenuID, .MenuIcon, .Checked
End With
Next i
For i = 1 To Me.labItem.UBound
Unload Me.labItem(i)
Next i
HasCheckBox = False
ZeroMemory KeyBindingList(vbKeyA), ByVal 52 '清空按键绑定列表（52 = 26 * sizeof(Integer)）
For i = 1 To UBound(CurrSubMenuID)
If Menus(CurrSubMenuID(i)).Visible Then
If i > 1 Then
Load Me.labItem(i - 1)
Else
Me.labItem(0).AutoSize = True
Me.labItem(0).Top = ITEM_DISTANCE '+ ITEM_DISTANCE / 2 - Me.labItem(0).Height / 2
Me.imgMenuCheckBox(0).Height = Me.labItem(0).Height + ITEM_DISTANCE
Me.imgMenuCheckBox(0).Top = Me.labItem(0).Top
End If
Me.labItem(i - 1).Caption = String(SpaceCount, " ") & Menus(CurrSubMenuID(i)).MenuText & String(SpaceCount, " ")
If i > 1 Then
Me.labItem(i - 1).Top = Me.labItem(i - 2).Top + Me.labItem(i - 2).Height + ITEM_DISTANCE '+ ITEM_DISTANCE / 2 - Me.labItem(i - 2).Height / 2
Me.labItem(i - 2).Height = Me.labItem(i - 1).Top - Me.labItem(i - 2).Top
End If
'检查菜单字串里面是否有“&”
Dim CharPos As Integer
Dim CharValue As Integer
CharPos = InStr(Menus(CurrSubMenuID(i)).MenuText, "&")
If CharPos > 1 Then '如果能找到“&”，并且不在第一个字符
CharValue = Asc(Mid(Menus(CurrSubMenuID(i)).MenuText, CharPos + 1, 1))
CharValue = CharValue And (Not 32) '把小写字母的Ascii码转换成大写的Ascii码
If CharValue >= vbKeyA And CharValue <= vbKeyZ Then '如果“&”前面的字符在字母表范围内，就把菜单项和对应的按键绑定起来
KeyBindingList(CharValue) = i
End If
End If
If Menus(CurrSubMenuID(i)).CheckBox = True And Menus(CurrSubMenuID(i)).MenuText <> "-" Then
HasCheckBox = True
If nCheckBoxes > 0 Then
Load Me.imgMenuCheckBox(nCheckBoxes)
Me.imgMenuCheckBox(nCheckBoxes).Height = Me.labItem(i - 1).Height + ITEM_DISTANCE
End If
Me.imgMenuCheckBox(nCheckBoxes).Left = 60 'ITEM_HORZ_MARGIN
Me.imgMenuCheckBox(nCheckBoxes).Top = Me.labItem(i - 1).Top '+ Me.labItem(i - 1).Height / 2 - Me.imgMenuCheckBox(nCheckBoxes).Height / 2
If Menus(CurrSubMenuID(i)).Checked Then
Me.imgMenuCheckBox(nCheckBoxes).LoadImage_FromStdPicture Me.imgChecked.Picture
Else
Me.imgMenuCheckBox(nCheckBoxes).LoadImage_FromStdPicture Me.imgUnchecked.Picture
End If
Me.imgMenuCheckBox(nCheckBoxes).Visible = True
Me.imgMenuCheckBox(nCheckBoxes).ZOrder 0
nCheckBoxes = nCheckBoxes + 1
ElseIf (Not Menus(CurrSubMenuID(i)).MenuIcon) <> -1 And Menus(CurrSubMenuID(i)).MenuText <> "-" Then
HasCheckBox = True
If nCheckBoxes > 0 Then
Load Me.imgMenuCheckBox(nCheckBoxes)
Me.imgMenuCheckBox(nCheckBoxes).Height = Me.labItem(i - 1).Height + ITEM_DISTANCE
End If
Me.imgMenuCheckBox(nCheckBoxes).Left = ITEM_HORZ_MARGIN + 90
Me.imgMenuCheckBox(nCheckBoxes).Top = Me.labItem(i - 1).Top '+ Me.labItem(i - 1).Height / 2 - Me.imgMenuCheckBox(nCheckBoxes).Height / 2
Me.imgMenuCheckBox(nCheckBoxes).Width = 16 * Screen.TwipsPerPixelX
Me.imgMenuCheckBox(nCheckBoxes).Height = 16 * Screen.TwipsPerPixelY
Me.imgMenuCheckBox(nCheckBoxes).LoadImage_FromArray Menus(CurrSubMenuID(i)).MenuIcon
Me.imgMenuCheckBox(nCheckBoxes).Visible = True
Me.imgMenuCheckBox(nCheckBoxes).ZOrder 0
nCheckBoxes = nCheckBoxes + 1
End If
If UBound(Menus(CurrSubMenuID(i)).SubMenuID) > 0 Then
HasSubMenu = True
If nSubMenus > 0 Then
Load Me.imgShowSubMenu(nSubMenus)
End If
Me.imgShowSubMenu(nSubMenus).Top = Me.labItem(i - 1).Top + Me.labItem(i - 1).Height / 2 - Me.imgShowSubMenu(nSubMenus).Height / 2
Me.imgShowSubMenu(nSubMenus).Visible = True
nSubMenus = nSubMenus + 1
End If
Me.labItem(i - 1).Enabled = Menus(CurrSubMenuID(i)).Enabled
If Me.labItem(i - 1).Width > NewWidth Then
NewWidth = Me.labItem(i - 1).Width
End If
Me.labItem(i - 1).Visible = True
Else
If i > 1 Then
Load Me.labItem(i - 1)
Me.labItem(i - 1).Top = Me.labItem(i - 2).Top
Me.labItem(i - 1).Height = Me.labItem(i - 2).Height
Me.labItem(i - 1).Visible = False
Else
Me.labItem(0).Top = -Me.labItem(0).Height
Me.labItem(0).Visible = False
End If
End If
Next i
If HasCheckBox Then
For i = 0 To Me.labItem.UBound
Me.labItem(i).Caption = " " & Me.labItem(i).Caption
If i > 0 Then
Dim NextVisibleItem As Integer
NextVisibleItem = i
Do While Me.labItem(NextVisibleItem).Visible = False
NextVisibleItem = NextVisibleItem + 1
If NextVisibleItem = UBound(CurrSubMenuID) Then
Exit Do
End If
Loop
If NextVisibleItem < UBound(CurrSubMenuID) Then
Me.labItem(i - 1).Height = Me.labItem(NextVisibleItem).Top - Me.labItem(i - 1).Top
End If
End If
Next i
NewWidth = NewWidth + Me.imgMenuCheckBox(0).Width + ITEM_HORZ_MARGIN
End If
LabelWidth = ControlWidth
Me.Height = Me.labItem(Me.labItem.UBound).Top + Me.labItem(Me.labItem.UBound).Height + ITEM_DISTANCE * 2
For i = Me.labItem.UBound To 0 Step -1
If Me.labItem(i).Visible = True Then
Exit For
End If
Next i
If i <> -1 Then
Me.labItem(i).Height = Me.Height - Me.labItem(i).Top - ITEM_DISTANCE
Me.Width = NewWidth + ITEM_HORZ_MARGIN * 2
If Me.Width < MIN_WIDTH Then
Me.Width = MIN_WIDTH
End If
For i = 0 To Me.labItem.UBound
Me.labItem(i).Width = Me.Width
Next i
If HasSubMenu Then
NewWidth = NewWidth + Me.imgShowSubMenu(0).Width + ITEM_HORZ_MARGIN
For i = 0 To Me.imgShowSubMenu.UBound
Me.imgShowSubMenu(i).Left = Me.Width - Me.imgShowSubMenu(0).Width - ITEM_HORZ_MARGIN * 2
Me.imgShowSubMenu(i).ZOrder 0
Next i
End If
For i = 0 To Me.labItem.UBound
If Trim(Me.labItem(i).Caption) = "-" Then
Me.labItem(i).Visible = False
If nSplitters > 0 Then
Load Me.lnSplitter(nSplitters)
End If
With Me.lnSplitter(nSplitters)
.X1 = ITEM_HORZ_MARGIN * 2
.Y1 = Me.labItem(i).Top + SPLITTER_VERT_MARGIN
.X2 = Me.Width - ITEM_HORZ_MARGIN * 2
.Y2 = Me.labItem(i).Top + SPLITTER_VERT_MARGIN
.Visible = True
End With
nSplitters = nSplitters + 1
'------------------------------------------------
Dim j As Integer
For j = i + 1 To Me.labItem.UBound
Me.labItem(j).Top = Me.labItem(j).Top - Me.labItem(i).Height + SPLITTER_VERT_MARGIN * 2
Next j
For j = 0 To Me.imgMenuCheckBox.UBound
If Me.imgMenuCheckBox(j).Top > Me.labItem(i).Top Then
Me.imgMenuCheckBox(j).Top = Me.imgMenuCheckBox(j).Top - Me.labItem(i).Height + SPLITTER_VERT_MARGIN * 2
End If
Next j
For j = 0 To Me.imgShowSubMenu.UBound
If Me.imgShowSubMenu(j).Top > Me.labItem(i).Top Then
Me.imgShowSubMenu(j).Top = Me.imgShowSubMenu(j).Top - Me.labItem(i).Height + SPLITTER_VERT_MARGIN * 2
End If
Next j
Me.Height = Me.Height - Me.labItem(i).Height + SPLITTER_VERT_MARGIN * 2
End If
Next i
End If
For i = 0 To Me.labItem.UBound
Me.labItem(i).BackColor = RGB(27, 27, 28)
Me.imgMenuCheckBox(i).Refresh
Next i
End Sub
Public Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim PrevKeybdIndex As Integer
Select Case KeyCode
Case vbKeyDown
IsUsingKeyboard = True
KeybdIndex = KeybdIndex + 1
If KeybdIndex > Me.labItem.UBound Then
KeybdIndex = 0
End If
PrevKeybdIndex = KeybdIndex
Do While Menus(CurrSubMenuID(KeybdIndex + 1)).MenuText = "-" Or Menus(CurrSubMenuID(KeybdIndex + 1)).Enabled = False
KeybdIndex = KeybdIndex + 1
If KeybdIndex > Me.labItem.UBound Then
KeybdIndex = 0
End If
If KeybdIndex = PrevKeybdIndex Then
Exit Sub
End If
Loop
Call labItem_MouseMove(KeybdIndex, 0, 0, 0, 0)
If UBound(Menus(CurrSubMenuID(KeybdIndex + 1)).SubMenuID) = 0 Then
Me.tmrPopupTimeout.Enabled = False
End If
IsUsingKeyboard = True
Case vbKeyUp
IsUsingKeyboard = True
KeybdIndex = KeybdIndex - 1
If KeybdIndex < 0 Then
KeybdIndex = Me.labItem.UBound
End If
PrevKeybdIndex = KeybdIndex
Do While Menus(CurrSubMenuID(KeybdIndex + 1)).MenuText = "-" Or Menus(CurrSubMenuID(KeybdIndex + 1)).Enabled = False
KeybdIndex = KeybdIndex - 1
If KeybdIndex < 0 Then
KeybdIndex = Me.labItem.UBound
End If
If KeybdIndex = PrevKeybdIndex Then
Exit Sub
End If
Loop
Call labItem_MouseMove(KeybdIndex, 0, 0, 0, 0)
If UBound(Menus(CurrSubMenuID(KeybdIndex + 1)).SubMenuID) = 0 Then
Me.tmrPopupTimeout.Enabled = False
End If
IsUsingKeyboard = True
Case vbKeyLeft
IsUsingKeyboard = True
Me.CloseMenu
If IsLastMenu Then
Call BoundCtl.MoveLeft
End If
IsUsingKeyboard = True
Case vbKeyRight
IsUsingKeyboard = True
If Menus(CurrSubMenuID(KeybdIndex + 1)).Enabled Then
If KeybdIndex = -1 Then
KeybdIndex = 0
End If
If UBound(Menus(CurrSubMenuID(KeybdIndex + 1)).SubMenuID) > 0 Then
Call labItem_MouseDown(KeybdIndex, 1, 0, 0, 0)
Else
Call BoundCtl.MoveRight
End If
ElseIf KeybdIndex = -1 Then
BoundCtl.MoveRight
End If
IsUsingKeyboard = True
Case vbKeyReturn
IsUsingKeyboard = True
If Menus(CurrSubMenuID(KeybdIndex + 1)).Enabled Then
Call labItem_MouseUp(KeybdIndex, vbLeftButton, 0, 0, 0)
End If
IsUsingKeyboard = True
Case vbKeyEscape
BoundCtl.HideMenu True
End Select
'响应快捷键
If KeyCode >= vbKeyA And KeyCode <= vbKeyZ Then
If KeyBindingList(KeyCode) <> 0 Then
If Menus(KeyBindingList(KeyCode) + 1).Enabled Then
Call labItem_MouseUp(KeyBindingList(KeyCode) - 1, 1, 0, 0, 0)
End If
End If
End If
End Sub
Private Sub Form_Load()
KeybdIndex = -1
Me.imgShowSubMenu(0).LoadImage_FromStdPicture Me.imgSubMenu.Picture
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
IsUsingKeyboard = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
With Me.lnBorderBottom
.X1 = 0
.Y1 = Me.ScaleHeight - 15
.X2 = Me.ScaleWidth
.Y2 = Me.ScaleHeight - 15
End With
With Me.lnBorderLeft
.X1 = 0
.Y1 = 0
.X2 = 0
.Y2 = Me.ScaleHeight
End With
With Me.lnBorderTop
.X1 = LabelWidth
.Y1 = 0
.X2 = Me.ScaleWidth
.Y2 = 0
End With
With Me.lnBorderRight
.X1 = Me.ScaleWidth - 15
.Y1 = 0
.X2 = Me.ScaleWidth - 15
.Y2 = Me.ScaleHeight - 15
End With
End Sub
Private Sub labItem_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
ReleaseCapture
If UBound(Menus(CurrSubMenuID(Index + 1)).SubMenuID) > 0 Then
If Not SubMenuWindow Is Nothing Then
If SubMenuWindow.MatchItem <> Index Or SubMenuWindow.Visible = False Then
PopupNewMenu Index
End If
Else
PopupNewMenu Index
End If
Me.tmrPopupTimeout.Enabled = False
ElseIf Not SubMenuWindow Is Nothing Then
If SubMenuWindow.MatchItem <> Index Then
SubMenuWindow.CloseMenu
Set SubMenuWindow = Nothing
End If
End If
End If
End Sub
Private Sub labItem_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim i As Integer
If Abs(PrevX - X) > 1 Or Abs(PrevY - Y) > 1 Or IsUsingKeyboard Then
IsUsingKeyboard = False
PrevX = X
PrevY = Y
If Index <> PrevItem Then
For i = 0 To Me.labItem.UBound
Me.labItem(i).BackColor = RGB(27, 27, 28)
Next i
Me.labItem(Index).BackColor = RGB(51, 51, 52)
PrevItem = Index
KeybdIndex = Index
If UBound(Menus(CurrSubMenuID(Index + 1)).SubMenuID) > 0 Then
Me.tmrPopupTimeout.Enabled = True
Else
Me.tmrPopupTimeout.Enabled = False
End If
If Not SubMenuWindow Is Nothing And Me.tmrPopupTimeout.Enabled = False Then
If Index <> SubMenuWindow.MatchItem Then
Me.tmrPopupTimeout.Enabled = True
Else
Me.tmrPopupTimeout.Enabled = False
End If
End If
End If
End If
End Sub
Private Sub labItem_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
If UBound(Menus(CurrSubMenuID(Index + 1)).SubMenuID) = 0 Then
BoundCtl.RaiseClickEvent Menus(CurrSubMenuID(Index + 1)).MenuID
BoundCtl.HideMenu
Unload Me
End If
End If
End Sub
Private Sub tmrCheckFocus_Timer()
Dim pt As POINT
Dim i As Integer
Dim CurrTarget As Long
Dim ClassName As String * 255
GetCursorPos pt
If WindowFromPoint(pt.X, pt.Y) <> Me.hwnd And Not IsUsingKeyboard Then
PrevItem = -1
Me.tmrPopupTimeout.Enabled = False
For i = 0 To Me.labItem.UBound
If Not SubMenuWindow Is Nothing Then
If i <> SubMenuWindow.MatchItem Then
Me.labItem(i).BackColor = RGB(27, 27, 28)
End If
Else
Me.labItem(i).BackColor = RGB(27, 27, 28)
End If
Next i
End If
CurrTarget = GetForegroundWindow()
If CurrTarget <> Me.hwnd Then
GetClassNameA CurrTarget, ClassName, ByVal 255
If Left(ClassName, 21) = "XTPDockingPaneMiniWnd" And Not NoWhitelist Then '白名单，用来解决Pane浮动窗口不能弹出菜单的问题
NoWhitelist = True
Me.SetFocus
Exit Sub
End If
If SubMenuWindow Is Nothing Then
Me.CloseMenu
Else
If CurrTarget <> SubMenuWindow.hwnd And (Not SubMenuWindow.IsPopupSub) Then
Me.CloseMenu
End If
End If
End If
End Sub
Private Sub tmrPopupTimeout_Timer()
If Not SubMenuWindow Is Nothing Then
If PrevItem <> SubMenuWindow.MatchItem Then
SetLayeredWindowAttributes Me.hwnd, 0, 255, LWA_ALPHA
SubMenuWindow.CloseMenu
Set SubMenuWindow = Nothing
Me.tmrPopupTimeout.Enabled = False
IsPopupSub = False
If UBound(Menus(CurrSubMenuID(PrevItem + 1)).SubMenuID) > 0 Then
PopupNewMenu PrevItem
End If
Exit Sub
End If
End If
If SubMenuWindow Is Nothing Then
PopupNewMenu PrevItem
ElseIf SubMenuWindow.Visible = False Then
PopupNewMenu PrevItem
End If
Me.tmrPopupTimeout.Enabled = False
End Sub