|
その昔、ランチャーを作った時に使ったなぁ。
コールバックを使用するのでソース量が多い。直接コールバックを使用しない方法に NOTIFYICONDATA 構造体のメンバ uCallbackMessage に WM_MOUSEMOVE を指定する方法があるが、それについてはこちらを参照。 Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const GWL_WNDPROC = (-4)
Private Type NOTIFYICONDATA
cbSize As Long '構造体のサイズ
hWnd As Long 'マウスメッセージを受け取るウィンドウのハンドル
uID As Long 'アイコンのID
uFlags As Long 'フラグを組み合わせて指定する
uCallbackMessage As Long 'マウスメッセージを受け取る時のメッセージを指定する
hIcon As Long '表示するアイコンハンドル
szTip As String * 64 'ヒントメッセージ
End Type
Private udtNotifyIcon As NOTIFYICONDATA
'タスクトレイにアイコンを操作する
Private Const NIM_ADD = &H0 'アイコン追加
Private Const NIM_MODIFY = &H1 'アイコン変更
Private Const NIM_DELETE = &H2 'アイコン削除
Private Const NIF_ICON = &H2 'アイコンを表示
Private Const NIF_MESSAGE = &H1 'マウスのメッセージを受け取る
Private Const NIF_TIP = &H4 'ヒントメッセージを表示
Private Const TRAY_TOOLTIP_TEXT As String = "タスクトレイ - サンプル"
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_USER = &H400
Private Const WM_TASKTRAY_ICON = WM_USER + &H200 '200は適当
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
'ポップアップメニューを表示する
'メニューのハンドルを取得する
'サブメニューのハンドルを取得する
'カーソルの位置を取得する
'ウインドウサイズを取得する
Private Const TPM_BOTTOMALIGN = &H20& '下
'指定ウインドウをアクティブにする
'前回のウインドウプロシージャ
'-----------------------------------------------------------------------
' 関数名 ： SubClass
' 機能 ： サブクラス化を開始する
' 引数 ： (in) hWnd … コールバック対象となるウインドウのハンドル
' 戻り値 ： なし
'-----------------------------------------------------------------------
Public Function SubClass(ByVal hWnd As Long) As Long
OldWindowhwnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
SubClass = OldWindowhwnd
End Function
'-----------------------------------------------------------------------
' 関数名 ： UnSubClass
' 機能 ： サブクラス化を終了する
' 引数 ： (in) hWnd … コールバック対象となるウインドウのハンドル
' 戻り値 ： なし
'-----------------------------------------------------------------------
Public Sub UnSubClass(ByVal hWnd As Long)
Dim ret As Long
If OldWindowhwnd <> 0 Then
ret = SetWindowLong(hWnd, GWL_WNDPROC, OldWindowhwnd)
OldWindowhwnd = 0
End If
End Sub
'-----------------------------------------------------------------------
' 関数名 ： SetIconToTasktray
' 機能 ： タスクトレイにアイコンを設定する
' 引数 ： (in) hWnd … メインウインドウのハンドル
' (in) hIcon … 表示するアイコンのハンドル
' 戻り値 ： 正常：１ エラー：１以外
'-----------------------------------------------------------------------
Public Function SetIconToTasktray(ByVal hWnd As Long, ByVal hIcon As Long) As Long
Dim FuncRet As Long
With udtNotifyIcon
.cbSize = Len(udtNotifyIcon)
.hWnd = hWnd
'.uID = 1
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_TASKTRAY_ICON
.hIcon = hIcon
.szTip = TRAY_TOOLTIP_TEXT & vbNullChar
End With
SetIconToTasktray = Shell_NotifyIcon(NIM_ADD, udtNotifyIcon)
End Function
'-----------------------------------------------------------------------
' 関数名 ： DeleteTasktrayIcon
' 機能 ： タスクトレイにアイコンを破棄する
' 戻り値 ： 正常：１ エラー：１以外
'-----------------------------------------------------------------------
Public Function DeleteTasktrayIcon() As Long
DeleteTasktrayIcon = Shell_NotifyIcon(NIM_DELETE, udtNotifyIcon)
End Function
'-----------------------------------------------------------------------
' 関数名 ： WindowProc
' 機能 ： いわずとしれたウインドウプロシージャ
'-----------------------------------------------------------------------
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_TASKTRAY_ICON
Select Case lParam
Case WM_LBUTTONDOWN
'左から０番目のメニューを表示
Call ShowPopUpMenu(hWnd, 0)
Case WM_RBUTTONDOWN
'左から１番目のメニューを表示
Call ShowPopUpMenu(hWnd, 1)
End Select
End Select
WindowProc = CallWindowProc(OldWindowhwnd, hWnd, uMsg, wParam, lParam)
End Function
'-----------------------------------------------------------------------
' 関数名 ： ShowPopUpMenu
' 機能 ： マウスポインタ位置にメニューを表示する
' 引数 ： (in) hWnd … 表示するメニューを持つウインドウのハンドル
' (in) MenuPos … 最上位メニュー位置(0-Base)
' 戻り値 ： 正常：１ エラー：０
'-----------------------------------------------------------------------
Public Function ShowPopUpMenu(ByVal hWnd As Long, ByVal MenuPos As Long) As Long
Dim udtPA As POINTAPI
Dim udtRect As RECT
Dim MenuhWnd As Long
Dim SubMenuhWnd As Long
'カーソルの位置を取得
Call GetCursorPos(udtPA)
'ウインドウ座標取得
Call GetWindowRect(hWnd, udtRect)
'メニューのハンドルを取得
MenuhWnd = GetMenu(hWnd)
'サブメニューのハンドルを取得
SubMenuhWnd = GetSubMenu(MenuhWnd, MenuPos)
'おまじない
'こうすると、メニューが出ている状態でデスクトップをクリックしたら
'メニューが消えてくれる
Call SetForegroundWindow(hWnd)
'ポップアップメニュー表示
ShowPopUpMenu = TrackPopupMenu(SubMenuhWnd, TPM_CENTERALIGN, _
udtPA.X, udtPA.Y, 0&, hWnd, udtRect)
End Function
あとはフォームに適当なメニューを作り、Load、UnLoad イベントで各処理を呼べばよい。
Private Sub Form_Load()
Dim FuncRet As Long
'タスクトレイにアイコンを設定
FuncRet = SetIconToTasktray(Me.hWnd, Me.Icon)
If FuncRet <> 1 Then
Call MsgBox("タスクトレイにアイコンを設定できません", vbOKOnly + vbInformation)
Unload Me
End If
Call SubClass(Me.hWnd)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim FuncRet As Long
'タスクトレイからアイコンを削除
FuncRet = DeleteTasktrayIcon
If FuncRet <> 1 Then
Call MsgBox("タスクトレイからアイコンを破棄できません", vbOKOnly + vbInformation)
End If
Call UnSubClass(Me.hWnd)
End Sub
Private Sub mnuBeep_Click()
Beep
End Sub
Private Sub mnuEnd_Click()
Unload Me
End Sub
|