亚洲AV无码专区国产乱码不卡,亚洲午夜无码久久久久,国外亚洲成AV人片在线观看

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

' 從任務(wù)管理器列表中移除

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) '刪除通知欄圖標(biāo)

Unload Me

End Sub

Private Sub mnuShow_Click()

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

Me.Show '調(diào)出窗口

Me.WindowState = 0

End Sub

Private Sub Timer1_Timer()

Call Common.procesSD

End Sub

Common模塊代碼

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

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

'點(diǎn)擊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

'添加、刪除、更改托盤圖標(biāo) 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 '圖標(biāo)缺省索引

Public Const WM_LBUTTONDOWN = &H201 '按鼠標(biāo)左鍵

Public Const WM_RBUTTONDOWN = &H204 '按鼠標(biāo)右鍵

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 '添加圖標(biāo)

Public Const NIM_MODIFY = 1 '修改圖標(biāo)

Public Const NIM_DELETE = 2 '刪除圖標(biāo)

Public Const NIF_MESSAGE = 1 'message 有效

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

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

Type NOTIFYICONDATA

cbSize As Long '需填入NOTIFYICONDATA數(shù)據(jù)結(jié)構(gòu)的長度

HWnd As Long '設(shè)置成窗口的句柄

Uid As Long '為圖標(biāo)所設(shè)置的ID值

UFlags As Long '設(shè)置uCallbackMessage,hIcon,szTip是否有效

UCallbackMessage As Long '消息編號

hIcon As Long '顯示在狀態(tài)欄上的圖標(biāo)

SzTip As String * 64 '提示信息

End Type

'聲明上述類型的對象

Private IconVa As NOTIFYICONDATA

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

Public OldWindowProc As Long

'判斷單擊,雙擊的兩個標(biāo)志

Private bIsSingle As Boolean

Private bIsDouble As Boolean

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

Private frmMain As Form

Private topmenu As Menu

Private timMain As Timer

'函數(shù)定義

'添加圖標(biāo)至通知欄

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

'參數(shù)說明：iHwnd：窗口句柄，sTips：當(dāng)鼠標(biāo)移到通知欄圖標(biāo)上時顯示的提示內(nèi)容

'hIcon：圖標(biāo)句柄，IconID：圖標(biāo)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

'獲得讓程序處理事件的權(quán)利

OldWindowProc = SetWindowLong(iHwnd, GWL_WNDPROC, AddressOf NewWindowProc)

'初始化單雙擊的判別標(biāo)志

bIsSingle = False

bIsDouble = False

'初始化時鐘

timMain.Enabled = True

timMain.Interval = 500

Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)

End Function

'刪除通知欄圖標(biāo)(參數(shù)說明同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

'當(dāng)圖標(biāo)從托盤刪除后,關(guān)閉時鐘,不在監(jiān)視單雙擊事件

timMain.Enabled = True

'讓操作系統(tǒng)處理消息

SetWindowLong iHwnd, GWL_WNDPROC, OldWindowProc

Icon_Del = Shell_NotifyIcon(NIM_DELETE, IconVa)

End Function

'修改通知欄圖標(biāo)(參數(shù)說明同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

'如果用戶點(diǎn)擊了托盤中的圖標(biāo)，則進(jìn)行判斷是點(diǎn)擊了左鍵單雙擊,還是右鍵

If Msg = TRAY_CALLBACK Then

'如果點(diǎn)擊了右鍵

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

'如果點(diǎn)擊了左鍵

If lParam = WM_LBUTTONDOWN Then

bIsSingle = True

bIsDouble = False

Exit Function

End If

'如果是其他類型的消息則傳遞給原有默認(rèn)的窗口函數(shù)

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

End Function

'被時鐘調(diào)用,來區(qū)分單擊,還是雙擊,以及事件處理內(nèi)容

Public Sub procesSD()

'如果是雙擊,就恢復(fù)窗口,并把圖標(biāo)從托盤刪除

If bIsDouble Then

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

frmMain.Show '調(diào)出窗口

frmMain.WindowState = 0

frmMain.SetFocus

ElseIf bIsSingle Then

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

frmMain.PopupMenu topmenu

End If

'恢復(fù)單雙擊判斷的標(biāo)志

bIsSingle = False

bIsDouble = False

End Sub

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

Samuel Learning

文章分類(203)

新聞分類(52)

.NET資源

Ajax

Java開源

Mobile

WEB資源

Workflow

其他連接

大牛人

開源軟件

敏捷

數(shù)據(jù)庫

未歸類

經(jīng)典框架

網(wǎng)絡(luò)教程

著名站點(diǎn)

項目管理

最新評論

View Post

我的VB托盤程序代碼