用Visual Basic 6.0設計TrayIcon

[魔術王子]

本程式是參考 王國榮先生 所著的Visual Basic 6.0 Windows API講座
不過有一點遺憾,就是在結束時若以End指令結束會出現錯誤
若按表單的關閉鈕則不會,不知是VB的Bug還是小王子的系統有問題
請建一個選單(名稱:Menu):
Caption = "選單"
Visible = 0 'False
Begin VB.Menu Exit
Caption = "還原"
End
另外再新增一個模組...
Form1.frm內容:

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '系統預設值
   Begin VB.Menu Menu 
      Caption         =   "選單"
      Visible         =   0   'False
      Begin VB.Menu Exit 
         Caption         =   "還原"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Exit_Click()
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
    
    ' 刪除圖示
    Dim nid As NOTIFYICONDATA
    
    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    Shell_NotifyIcon NIM_DELETE, nid
    Me.Show
End Sub

Private Sub Form_Load()
    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
    Dim nid As NOTIFYICONDATA
    
    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
    nid.hIcon = Me.Icon
    nid.szTip = "TrayIcon"
    nid.uCallbackMessage = uMessage
    Shell_NotifyIcon NIM_ADD, nid
    Me.Hide
    Exit Sub
End Sub

模組Module1.bas內容:

Attribute VB_Name = "Module1"
Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONUP = &H205

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 uID = 9998
Public Const uMessage = WM_USER + 100

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

Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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

Public prevWndProc As Long

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_USER + 100 Then
        If lParam = WM_LBUTTONUP Then
            Form1.WindowState = vbNormal
            Form1.Show
        ElseIf lParam = WM_RBUTTONUP Then
            Form1.PopupMenu Form1.Menu
        End If
    End If
    WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function

粗體部分需要自行KeyIn

[JOVI]

不用那麼辛苦了，VB.net就有那個功能，只要加入NotifyIcon員件，在設定幾行程式，以前vb6要辛苦的爬程式，現在會輕鬆一點。

[魔術王子]

作者: JOVI

不用那麼辛苦了，VB.net就有那個功能，只要巧w幾行程式，以前vb6要辛苦的爬程式，現在會輕鬆一點。

其實C++ Builder也有
只是小王子認為若真的要打好程式基礎,還是從最基本學起比較好
否則最後只會變成"元件有提供的功能都會用,元件不會的就不會,元件不行的就沒輒了,元件的限制就是你的限制"

[劍痞憶秋年]

作者: 魔術王子

若以End指令結束會出現錯誤
若按表單的關閉鈕則不會,不知是VB的Bug還是小王子的系統有問題

小弟試的結果是，不是系統的問題，該是 Bug 吧！
or 有什麼該釋放的沒釋放！！

[不知道]

作者: 劍痞憶秋年

小弟試的結果是，不是系統的問題，該是 Bug 吧！
or 有什麼該釋放的沒釋放！！

SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc

應該是程式還沒將這段訊息改回來時就離開造成的吧
試試加個DoEvxxx(忘了怎麼拼了)

<參考>

[魔術王子]

作者: 不知道

SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
應該是程式還沒將這段訊息改回來時就離開造成的吧
試試加個DoEvxxx(忘了怎麼拼了)

<參考>

DoEvents
一樣不行

[魔術王子]

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '系統預設值
   Begin VB.Menu Menu 
      Caption         =   "選單"
      Visible         =   0   'False
      Begin VB.Menu Exit 
         Caption         =   "離開"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Exit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
    Dim nid As NOTIFYICONDATA
    
    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
    nid.hIcon = Me.Icon
    nid.szTip = "TrayIcon"
    nid.uCallbackMessage = uMessage
    Shell_NotifyIcon NIM_ADD, nid
    Me.Hide
    Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
    
    ' 刪除圖示
    Dim nid As NOTIFYICONDATA
    
    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    Shell_NotifyIcon NIM_DELETE, nid
    Me.Show
End Sub

小王子將End改成Unload Me就行了
大家試試吧

[mini]

像這種問題除錯就要試著 Step除錯 及 利用 Msgbox 來看哪裡是錯誤中斷點
的確 End 不如 Unload ME

End 停止執行，可以放在程序中的任何位置，它可以關閉以 Open 陳述式所開啟的檔案，且可以清除變數。

End (有時)會繞過 Form_Unload 而直接結束程式