|
-
May 4th, 2000, 06:51 AM
#1
Thread Starter
New Member
Hi can some tell me the code that when u minimize your program it put a icon next to where the time instead of the task bar.
i am new to this, so hope u can help me
thx
raVen_uk
Quote the raVen NEVERMORE
-
May 4th, 2000, 07:16 AM
#2
Addicted Member
Here's a little Class I wrote to put a Icon in the System
Tray. Keep in mind that you don't actually "minimize" an
app to the Tray, you just put the icon in the Tray and hide
the app yourself. In case you didn't know, to add a Class
to your project goto Project -> Add Class Module,
and paste this code into there. Name the class something
like "CSysTray".
Code:
'============================
'=== GENERAL DECLARATIONS ===
'============================
'<<< OPTION STATEMENTS >>>
Option Explicit
'<<< CONSTANTS >>>
Private Const miMAX_TOOLTIP As Integer = &H40
Private Const msSENTINEL_TOOLTIP As String = vbLf & vbCr
Private Const EMST_LOADICON As Long = vbObjectError + 101
Private Const EMST_ALREADY_IN_TRAY As Long = vbObjectError + 102
Private Const EMST_OBJECT_NOT_FORM As Long = vbObjectError + 103
Private Const EMST_SYSTRAY_ADD As Long = vbObjectError + 104
'<<< ENUMERATIONS >>>
Private Enum eImageType
IMAGE_BITMAP = 0
IMAGE_ICON = 1
IMAGE_CURSOR = 2
End Enum
Private Enum eLoadResourceFlag
LR_DEFAULTCOLOR = &H0
LR_MONOCHROME = &H1
LR_COLOR = &H2
LR_COPYRETURNORG = &H4
LR_COPYDELETEORG = &H8
LR_LOADFROMFILE = &H10
LR_LOADTRANSPARENT = &H20
LR_DEFAULTSIZE = &H40
LR_LOADMAP3DCOLORS = &H1000
LR_CREATEDIBSECTION = &H2000
LR_COPYFROMRESOURCE = &H4000
LR_SHARED = &H8000&
End Enum
Private Enum eNotifyIconFlag
NIF_MESSAGE = &H1
NIF_ICON = &H2
NIF_TIP = &H4
End Enum
Private Enum eNotifyIconMsg
NIM_ADD = &H0
NIM_MODIFY = &H1
NIM_DELETE = &H2
End Enum
Private Enum eMouseValue
WM_MOUSEMOVE = &H200
WM_LBUTTONDOWN = &H201
WM_LBUTTONUP = &H202
WM_LBUTTONDBLCLK = &H203
WM_RBUTTONDOWN = &H204
WM_RBUTTONUP = &H205
WM_RBUTTONDBLCLK = &H206
WM_MBUTTONDOWN = &H207
WM_MBUTTONUP = &H208
WM_MBUTTONDBLCLK = &H209
End Enum
'<<< TYPE DEFINITIONS >>>
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As eNotifyIconFlag
uCallbackMessage As eMouseValue
hIcon As Long
szTip As String * miMAX_TOOLTIP
End Type
'<<< DECLARES >>>
Private Declare Function apiDestroyIcon _
Lib "user32" _
Alias "DestroyIcon" _
(ByVal hIcon As Long) As Long
Private Declare Function apiLoadImage _
Lib "user32" _
Alias "LoadImageA" _
(ByVal hInst As Long, ByVal lpsz As String, _
ByVal un1 As eImageType, ByVal n1 As Long, _
ByVal n2 As Long, ByVal un2 As eLoadResourceFlag) As Long
Private Declare Function apiShell_NotifyIcon _
Lib "shell32.dll" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As eNotifyIconMsg, _
lpData As NOTIFYICONDATA) As Long
'<<< VARIABLES >>>
Private WithEvents mfrmNIcon As Form
Private mudtNID As NOTIFYICONDATA
Private mbIconLoaded As Boolean
'=====================
'=== CLASS METHODS ===
'=====================
Public Event MouseMove()
Public Event MouseDown(Button As Integer)
Public Event MouseUp(Button As Integer)
Public Event DblClick(Button As Integer)
Private Sub Class_Initialize()
mudtNID.cbSize = Len(mudtNID)
End Sub
Private Sub Class_Terminate()
Call RemoveFromSysTray
End Sub
Public Function bAddToSysTray( _
ByRef rfrmNIcon As Form, _
Optional ByVal vhIcon As Long = 0, _
Optional ByVal vsToolTip As String = msSENTINEL_TOOLTIP) _
As Boolean
Dim bSuccess As Boolean
Dim lRetVal As Long
If bIsInSysTray = True Then
Call Err.Raise(EMST_ALREADY_IN_TRAY, "bAddToSysTray", _
"Already present in System Tray.")
Else
On Error GoTo ehAddToSysTray
If TypeOf rfrmNIcon Is Form Then
Set mfrmNIcon = rfrmNIcon
mudtNID.hWnd = rfrmNIcon.hWnd
Else
Call Err.Raise(EMST_OBJECT_NOT_FORM, "bAddToSYsTray", _
"Form object reference only.")
End If
If hWndTrayOwner <> 0 Then
If vhIcon <> 0 Then
mudtNID.hIcon = vhIcon
Else
If mbIconLoaded = False Then
mudtNID.hIcon = rfrmNIcon.Icon.Handle
End If
End If
If Trim(vsToolTip) <> msSENTINEL_TOOLTIP Then
mudtNID.szTip = msVerifyToolTip(vsToolTip)
mudtNID.uFlags = mudtNID.uFlags Or NIF_TIP
End If
mudtNID.uCallbackMessage = WM_MOUSEMOVE
mudtNID.uFlags = mudtNID.uFlags Or NIF_MESSAGE Or NIF_ICON
mudtNID.uID = -1
lRetVal = apiShell_NotifyIcon(NIM_ADD, mudtNID)
If lRetVal = 0 Then
mGarbageCollection
Else
bSuccess = True
End If
End If
End If
bAddToSysTray = bSuccess
Exit Function
ehAddToSysTray:
Call mGarbageCollection
Call Err.Raise(EMST_SYSTRAY_ADD, "bAddToSysTray", _
"Could not add to System Tray. Invalid parameters.")
bAddToSysTray = False
End Function
Public Sub RemoveFromSysTray()
If bIsInSysTray = True Then
Call apiShell_NotifyIcon(NIM_DELETE, mudtNID)
End If
Call mGarbageCollection
End Sub
Public Sub LoadIcon(ByVal vsIconPath As String)
Dim hIcon As Long
Dim hOrigIcon As Long
Dim lRetVal As Long
If Trim(vsIconPath) = vbNullString _
Or Dir(vsIconPath) = vbNullString Then
Call Err.Raise(EMST_LOADICON, "LoadIcon", "Invalid icon path.")
Else
If mbIconLoaded = True Then
Call mDestroyIcon(mudtNID.hIcon)
End If
hIcon = apiLoadImage(0, vsIconPath, IMAGE_ICON, 0, 0, _
LR_LOADFROMFILE Or LR_DEFAULTCOLOR Or LR_DEFAULTSIZE Or LR_SHARED)
If hIcon <> 0 Then
mbIconLoaded = True
hOrigIcon = mudtNID.hIcon
mudtNID.hIcon = hIcon
mudtNID.uFlags = mudtNID.uFlags Or NIF_ICON
If bIsInSysTray = True Then
lRetVal = apiShell_NotifyIcon(NIM_MODIFY, mudtNID)
If lRetVal = 0 Then
Call mDestroyIcon(hIcon)
If hOrigIcon <> 0 Then
mudtNID.hIcon = hOrigIcon
mudtNID.uFlags = mudtNID.uFlags Or NIF_ICON
End If
End If
End If
End If
End If
End Sub
Public Property Get bIsInSysTray() As Boolean
bIsInSysTray = CBool(mudtNID.uID)
End Property
Public Property Get bHasMessage() As Boolean
Dim bValue As Boolean
bValue = CBool(mudtNID.uFlags And NIF_MESSAGE)
bHasIcon = bValue
End Property
Public Property Get bHasIcon() As Boolean
Dim bValue As Boolean
bValue = CBool(mudtNID.uFlags And NIF_ICON)
bHasIcon = bValue
End Property
Public Property Get bHasToolTip() As Boolean
Dim bValue As Boolean
bValue = CBool(mudtNID.uFlags And NIF_TIP)
bHasIcon = bValue
End Property
Public Property Get hWndTrayOwner() As Long
hWndTrayOwner = mudtNID.hWnd
End Property
Public Property Let hTrayIcon(ByVal vhIcon As Long)
Dim lRetVal As Long
Dim hIconOrig As Long
If vhIcon <> 0 Then
hIconOrig = mudtNID.hIcon
mudtNID.hIcon = vhIcon
mudtNID.uFlags = mudtNID.uFlags Or NIF_ICON
If bIsInSysTray = True Then
lRetVal = apiShell_NotifyIcon(NIM_MODIFY, mudtNID)
If lRetVal = 0 Then
If hOrigIcon <> 0 Then
mudtNID.hIcon = hIconOrig
mudtNID.uFlags = mudtNID.uFlags Or NIF_ICON
Else
mudtNID.uFlags = mudtNID.uFlags Xor NIF_ICON
End If
Else
If mbIconLoaded = True Then
Call mDestroyIcon(hIconOrig)
End If
End If
End If
End If
End Property
Public Property Get hTrayIcon() As Long
hTrayIcon = mudtNID.hIcon
End Property
Public Property Let sToolTip(ByVal vsToolTip As String)
Dim lRetVal As Long
Dim sTipOrig As String * miMAX_TOOLTIP
sTipOrig = mudtNID.szTip
mudtNID.szTip = msVerifyToolTip(vsToolTip)
mudtNID.uFlags = mudtNID.uFlags Or NIF_TIP
If bIsInSysTray = True Then
lRetVal = apiShell_NotifyIcon(NIM_MODIFY, mudtNID)
If lRetVal = 0 Then
mudtNID.szTip = sTipOrig
End If
End If
End Property
Public Property Get sToolTip() As String
Dim iNullPos As Integer
Dim sTTip As String
sTTip = mudtNID.szTip
iNullPos = InStr(1, sTTip, vbNullChar)
If iNullPos > 0 Then
sTTip = Left(sTTip, iNullPos - 1)
End If
sToolTip = sTTip
End Property
'==========================
'=== PRIVATE PROCEDURES ===
'==========================
Private Sub mfrmNIcon_MouseMove( _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim lFilter As Long
If mfrmNIcon.ScaleMode = vbPixels Then
lFilter = X
Else
lFilter = mfrmNIcon.ScaleX(X, mfrmNIcon.ScaleMode, vbPixels)
End If
Select Case lFilter
Case WM_MOUSEMOVE
RaiseEvent MouseMove
Case WM_LBUTTONDOWN
RaiseEvent MouseDown(vbLeftButton)
Case WM_LBUTTONUP
RaiseEvent MouseUp(vbLeftButton)
Case WM_LBUTTONDBLCLK
RaiseEvent DblClick(vbLeftButton)
Case WM_RBUTTONDOWN
RaiseEvent MouseDown(vbRightButton)
Case WM_RBUTTONUP
RaiseEvent MouseUp(vbRightButton)
Case WM_RBUTTONDBLCLK
RaiseEvent DblClick(vbRightButton)
Case WM_MBUTTONDOWN
RaiseEvent MouseDown(vbMiddleButton)
Case WM_MBUTTONUP
RaiseEvent MouseUp(vbMiddleButton)
Case WM_MBUTTONDBLCLK
RaiseEvent DblClick(vbMiddleButton)
End Select
End Sub
Private Function msVerifyToolTip(ByVal vsTip As String) As String
Dim sTTip As String
sTTip = vsTip
If Len(sTTip) >= miMAX_TOOLTIP Then
sTTip = Left(sTTip, miMAX_TOOLTIP - 1) & vbNullChar
Else
sTTip = vsTip & vbNullChar
End If
msVerifyToolTip = sTTip
End Function
Private Sub mGarbageCollection()
If mbIconLoaded = True Then
Call mDestroyIcon(mudtNID.hIcon)
Else
mudtNID.hIcon = 0
End If
mudtNID.hWnd = 0
mudtNID.szTip = vbNullString
mudtNID.uCallbackMessage = 0
mudtNID.uFlags = 0
mudtNID.uID = 0
Set mfrmNIcon = Nothing
End Sub
Private Function mDestroyIcon(ByVal vhIcon As Long)
Dim lRetVal As Long
lRetVal = apiDestroyIcon(vhIcon)
If lRetVal <> 0 Then
mbIconLoaded = False
mudtNID.uFlags = mudtNID.uFlags Xor NIF_ICON
End If
End Function
After you've done this you can implement it in a Form as follows:
Code:
Private mCSystemTray As CSysTray
Private Sub Command1_Click()
Set mCSystemTray = New CSysTray
Call mCSystemTray.gbAddIcon(Me, Me.Icon.Handle, "Test by Me")
Call Me.Hide
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set mCSystemTray = Nothing
End Sub
Private Sub mCSystemTray_DblClick(Button As Integer)
Call Me.Show
End Sub
'The following code will require a Pop-up menu called "mnuTray".
'It is not necessary to implement the System Tray, but it
'does help to add to the interface.
Private Sub mCSystemTray_MouseUp(Button As Integer)
If Button = vbRightButton Then
If Me.Visible = False Then
mnuTrayShow.Caption = "&Show"
Else
mnuTrayShow.Caption = "&Hide"
End If
Call PopupMenu(mnuTray)
End If
End Sub
If you have any questions just ask 
[Edited by SonGouki on 05-05-2000 at 12:25 PM]
Dan PM
Analyst Programmer
VB6 SP3 (also VB4 16-bit sometimes  )
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote