日本在线不卡一区,亚洲国产精品成人综合,午夜精品亚洲一区二区三区嫩草

View Post

我的VB托盤程序代碼

Form1 的VB代碼

Private bIsQuit As Boolean

Private Sub Form_Load()

bIsQuit = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

If Not bIsQuit Then

Dim rc As Long

Dim OwnerhWnd As Long

' 讓窗體不可見

Me.Visible = False

' 從任務管理器列表中移除

OwnerhWnd = GetWindow(Me.HWnd, GW_OWNER)

rc = ShowWindow(OwnerhWnd, SW_HIDE)

Call Icon_Add(Form1, Me.topmenu, Me.Timer1, Me.HWnd, "ICON Test", Me.Icon, 0)

Cancel = 1

Else

Cancel = 0

End If

End Sub

Private Sub mnuQuit_Click()

bIsQuit = True

Call Icon_Del(Me.HWnd, 0) '刪除通知欄圖標

Unload Me

End Sub

Private Sub mnuShow_Click()

Call Icon_Del(Me.HWnd, 0) '刪除通知欄圖標

Me.Show '調出窗口

Me.WindowState = 0

End Sub

Private Sub Timer1_Timer()

Call Common.procesSD

End Sub

Common模塊代碼

'Window消息處理函數,目的是: 窗口最小化到托盤時,程序自己處理消息

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

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'點擊X時,最小化到托盤

Public Const SW_HIDE = 0

Public Const GW_OWNER = 4

Declare Function GetWindow Lib "user32" (ByVal HWnd As Long, ByVal wCmd As Long) As Long

Declare Function ShowWindow Lib "user32" (ByVal HWnd As Long, ByVal nCmdShow As Long) As Long

'添加、刪除、更改托盤圖標 Windows API

Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const DefaultIconIndex = 1 '圖標缺省索引

Public Const WM_LBUTTONDOWN = &H201 '按鼠標左鍵

Public Const WM_RBUTTONDOWN = &H204 '按鼠標右鍵

Public Const WM_LBUTTONDBLCLK = &H203 '雙擊左鍵

Public Const WM_USER = &H400

Public Const TRAY_CALLBACK = (WM_USER + 1001&)

Public Const GWL_WNDPROC = (-4)

Public Const NIM_ADD = 0 '添加圖標

Public Const NIM_MODIFY = 1 '修改圖標

Public Const NIM_DELETE = 2 '刪除圖標

Public Const NIF_MESSAGE = 1 'message 有效

Public Const NIF_ICON = 2 '圖標操作（添加、修改、刪除）有效

Public Const NIF_TIP = 4 'ToolTip(提示）有效

Type NOTIFYICONDATA

cbSize As Long '需填入NOTIFYICONDATA數據結構的長度

HWnd As Long '設置成窗口的句柄

Uid As Long '為圖標所設置的ID值

UFlags As Long '設置uCallbackMessage,hIcon,szTip是否有效

UCallbackMessage As Long '消息編號

hIcon As Long '顯示在狀態欄上的圖標

SzTip As String * 64 '提示信息

End Type

'聲明上述類型的對象

Private IconVa As NOTIFYICONDATA

'聲明獲取處理Windows 消息前的window句柄

Public OldWindowProc As Long

'判斷單擊,雙擊的兩個標志

Private bIsSingle As Boolean

Private bIsDouble As Boolean

'聲明主窗體,右鍵菜單和時鐘,這里的時鐘是為了區分單雙擊左鍵,顯得比較笨拙

Private frmMain As Form

Private topmenu As Menu

Private timMain As Timer

'函數定義

'添加圖標至通知欄

Public Function Icon_Add(frmParent As Form, mnuParent As Menu, timParent As Timer, iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long

'參數說明：iHwnd：窗口句柄，sTips：當鼠標移到通知欄圖標上時顯示的提示內容

'hIcon：圖標句柄，IconID：圖標Id號

'初始化控件成員

Set frmMain = frmParent

Set topmenu = mnuParent

Set timMain = timParent

With IconVa

.HWnd = iHwnd

.SzTip = sTips + Chr$(0)

.hIcon = hIcon

.Uid = IconID

.UCallbackMessage = TRAY_CALLBACK

.cbSize = Len(IconVa)

.UFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP

End With

'獲得讓程序處理事件的權利

OldWindowProc = SetWindowLong(iHwnd, GWL_WNDPROC, AddressOf NewWindowProc)

'初始化單雙擊的判別標志

bIsSingle = False

bIsDouble = False

'初始化時鐘

timMain.Enabled = True

timMain.Interval = 500

Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)

End Function

'刪除通知欄圖標(參數說明同Icon_Add)

Function Icon_Del(iHwnd As Long, lIndex As Long) As Long

Dim IconVa As NOTIFYICONDATA

Dim L As Long

With IconVa

.HWnd = iHwnd

.Uid = lIndex

.cbSize = Len(IconVa)

End With

'當圖標從托盤刪除后,關閉時鐘,不在監視單雙擊事件

timMain.Enabled = True

'讓操作系統處理消息

SetWindowLong iHwnd, GWL_WNDPROC, OldWindowProc

Icon_Del = Shell_NotifyIcon(NIM_DELETE, IconVa)

End Function

'修改通知欄圖標(參數說明同Icon_Add)

Public Function Icon_Modify(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long

Dim IconVa As NOTIFYICONDATA

With IconVa

.HWnd = iHwnd

.SzTip = sTips + Chr$(0)

.hIcon = hIcon

.Uid = IconID

.UCallbackMessage = TRAY_CALLBACK

.cbSize = Len(IconVa)

.UFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP

End With

Icon_Modify = Shell_NotifyIcon(NIM_MODIFY, IconVa)

End Function

'程序處理Windows傳遞的消息

Public Static Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'如果用戶點擊了托盤中的圖標，則進行判斷是點擊了左鍵單雙擊,還是右鍵

If Msg = TRAY_CALLBACK Then

'如果點擊了右鍵

If lParam = WM_RBUTTONDOWN Then

'則彈出右鍵菜單

frmMain.PopupMenu topmenu

Exit Function

End If

'如果雙擊左鍵

If lParam = WM_LBUTTONDBLCLK Then

bIsDouble = True

bIsSingle = False

Exit Function

End If

'如果點擊了左鍵

If lParam = WM_LBUTTONDOWN Then

bIsSingle = True

bIsDouble = False

Exit Function

End If

'如果是其他類型的消息則傳遞給原有默認的窗口函數

NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam)

End Function

'被時鐘調用,來區分單擊,還是雙擊,以及事件處理內容

Public Sub procesSD()

'如果是雙擊,就恢復窗口,并把圖標從托盤刪除

If bIsDouble Then

Call Icon_Del(frmMain.HWnd, 0) '刪除通知欄圖標

frmMain.Show '調出窗口

frmMain.WindowState = 0

frmMain.SetFocus

ElseIf bIsSingle Then

'如果是單擊,就彈出左鍵菜單

frmMain.PopupMenu topmenu

End If

'恢復單雙擊判斷的標志

bIsSingle = False

bIsDouble = False

End Sub

posted on 2005-11-07 16:33 MingIsMe 閱讀(2369) 評論(0) 編輯收藏所屬分類: 05 微軟編程

Samuel Learning

文章分類(203)

新聞分類(52)

.NET資源

Ajax

Java開源

Mobile

WEB資源

Workflow

其他連接

大牛人

開源軟件

敏捷

數據庫

未歸類

經典框架

網絡教程

著名站點

項目管理

最新評論

View Post

我的VB托盤程序代碼