Tạo menu cho IconTray? (1 người xem)
- Thread starter thanhlanh
- Ngày gửi
Người dùng đang xem chủ đề này
Bạn thêm icon vào Tray cho UserForm để làm gì? Người ta mở UserForm ra để làm việc rồi đóng. Nếu tôi hiểu được triết lý của Shell_NotifyIcon thì người ta thêm icon vào Tray khi mà proccess hoạt động trên nền một cách độc lập KHÔNG CẦN sự tương tác của user nhưng CHO PHÉP user tương tác - tạo khả năng cho user tương tác. Trong khi bạn mở UserForm để mà làm việc trên Form rồi đóng. Khi mà cửa sổ nằm tơ hơ trên màn hình thì icon trong Tray để làm gì?
Nếu bạn chủ ý "vọc" thì xin mời.
Code của bạn tôi rút gọn và bổ sung.
code Module1
Mã:
Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Private Const WM_COMMAND = &H111
Private Const WM_RBUTTONUP = &H205
Private Const TPM_CENTERALIGN As Long = &H4&
Private Const MF_STRING = 0
Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer
Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Long) As Long
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
Private Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Public OldWindowProc As Long
Public hMenu As Long
Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo end_
Dim pt As POINTAPI
' [COLOR=#0000ff]thông điệp có giá trị = WM_SER + 100 là thông điệp "liên quan" tới icon trong Tray [/COLOR]
If uMsg = WM_USER + 100 Then
' [COLOR=#0000ff]user click và nhả chuột phải (Right Button) trên icon trong Tray[/COLOR]
If lParam = WM_RBUTTONUP Then
GetCursorPos pt
SetForegroundWindow Application.hwnd
If hMenu > 0 Then DestroyMenu hMenu
' [COLOR=#0000ff]tạo menu ngữ cảnh[/COLOR]
hMenu = CreatePopupMenu
' [COLOR=#0000ff]thêm mục menu vào menu và gán cho mục menu 1 số nhận dạng (ID) bằng 1000
[/COLOR]' [COLOR=#0000ff]bạn có thể chọn số khác[/COLOR]
AppendMenu hMenu, MF_STRING, 1000, "Muc menu 1"
' [COLOR=#0000ff]thêm mục menu vào menu và gán cho mục menu 2 số nhận dạng (ID) bằng 1001
[/COLOR]' [COLOR=#0000ff]bạn có thể chọn số khác[/COLOR]
AppendMenu hMenu, MF_STRING, 1001, "Muc menu 2"
' [COLOR=#0000ff]hiển thị menu
[/COLOR] TrackPopupMenu hMenu, TPM_CENTERALIGN, pt.x, pt.y, 0, hwnd, 0
End If
ElseIf uMsg = WM_COMMAND Then
Select Case wParam
' [COLOR=#0000ff]mục menu 1 được user chọn - viết code để phục vụ, ở đây là code ví dụ[/COLOR]
Case 1000
Debug.Print "Muc menu 1 duoc chon"
' [COLOR=#0000ff]mục menu 2 được user chọn - viết code để phục vụ, ở đây là code ví dụ
[/COLOR] Case 1001
Debug.Print "Muc menu 2 duoc chon"
End Select
End If
end_:
WindowProc = CallWindowProc(OldWindowProc, hwnd, uMsg, wParam, lParam)
End Functioncode UserForm:
Mã:
Dim nid As NOTIFYICONDATA
Dim hForm As Long
Private Sub CommandButton1_Click()
Dim s As String
s = InputBox("Enter string:")
With nid
.cbSize = Len(nid)
' [COLOR=#0000ff]hForm là handle của cửa sổ sẽ nhận từ Windows các thông điệp liên quan tới icon trong Tray
[/COLOR] .hwnd = hForm
.uID = &H100
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
' [COLOR=#0000ff]Windows sẽ gửi tới cửa sổ thông điệp có giá trị = WM_USER + 100[/COLOR]
.uCallbackMessage = WM_USER + 100
.hIcon = CommandButton1.Picture
.szTip = s & Chr(0)
End With
Shell_NotifyIconA NIM_ADD, nid
End Sub
Private Sub CommandButton2_Click()
nid.szTip = InputBox("Enter string:") & Chr(0)
Shell_NotifyIconA NIM_MODIFY, nid
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
' [COLOR=#0000ff]handle của cửa sổ UserForm[/COLOR]
hForm = FindWindow("ThunderDFrame", Me.Caption)
' [COLOR=#0000ff]thiết lập địa chỉ mới cho procedure của cửa sổ để có thể thêm code phục vụ các thông điệp
' liên quan tới icon. Phải nhớ địa chỉ của procedure "nguyên bản" của cửa sổ để truyền mọi
[/COLOR]' [COLOR=#0000ff]thông điệp khác tới nó với mục đích để cho code của procedure "nguyên bản" xử lý.
[/COLOR] OldWindowProc = SetWindowLong(hForm, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UserForm_Terminate()
Shell_NotifyIconA NIM_DELETE, nid
' [COLOR=#0000ff]delete menu đã tạo[/COLOR]
If hMenu > 0 Then DestroyMenu hMenu
' [COLOR=#0000ff]trả lại địa chỉ của procedure "nguyên bản" của cửa sổ.
[/COLOR] SetWindowLong hForm, GWL_WNDPROC, OldWindowProc
End Sub
Lần chỉnh sửa cuối:
Upvote
0
thanhlanh
Thành viên tích cực
- Tham gia
- 21/2/08
- Bài viết
- 858
- Được thích
- 1,211
Cảm ơn bạn nhiều!
Thật tình mình cũng tò mò và thử ngiệm thôi còn ứng dụng thì chưa. Mình đã tìm đỏ mắt trên google, kể cả các trang Web nước ngoài cũng có người hỏi nhưng không có trả lời (có lẽ là bí?). Chứng tỏ Bạn thật là thông thái!, ít nhất là trong lĩnh vực này.
Upvote
0
Nếu bạn muốn dùng tiếng Việt trong Tip và trong tên các mục menu thì phải dùng phiên bản Unicode của các hàm tương ứng - tức không phải xyzA (ANSI) mà dùng xyzW (WideChar)
Upvote
0
thanhlanh
Thành viên tích cực
- Tham gia
- 21/2/08
- Bài viết
- 858
- Được thích
- 1,211
Lại học được thêm một chiiêu! Xin cảm ơn!
--------------------
Trong code của mình có tạo Menu ("Worksheet Menu Bar") và lệnh trong Menu đó, chỉ dùng được cho Office 2003 về trước, vì vậy mình có ý tưởng là "dời" các lệnh đó vào Menu trên tray, sẽ tương thích với mọi phiên bản Excel. Bạn am hiểu hơn mình, tư vấn xem mình suy nghĩ vậy có đúng không?
Upvote
0
Bạn tạo menu thế nào, lệnh thế nào, có những khó khăn cụ thể nào thì bạn lập chủ đề mới và hỏi hướng giải quyết. Đừng nghĩ là "hướng phải thế này" rồi "bắt" mọi người phải đi theo hướng đó. Phương pháp hãy để người khác quyết định. Bạn chỉ nêu vấn đề thôi.
Upvote
0
