Can I disappear my DB to the system tray...? Please? (1 Viewer)

Randomblink

The Irreverent Reverend
Local time
Today, 12:38
Joined
Jul 23, 2001
Messages
279
Ok...
I have the code that removes the Access window from the screen. So...
PLEASE PLEASE PLEASE tell me HOW I can drop my database from the TaskBar down to a simple system tray icon...
I have looked everywhere, through reams of code that promise similar BUT DONT HAPPEN! Argh!

If you tell me I will be so happy that I might just cry...

<sniff sniff>

(thanks in advance...but only if you tell me how!)

:)
 
R

Rich

Guest
This comes from an application I found some time ago.
Option Compare Database
Option Explicit

'************** Code Start *************
'
'------------------------------
' Do NOT try to step through
' this code. Entering debug mode
' will cause a GPF if the window
' is subclassed.
'------------------------------

'//LoadImage flags
Private Const WM_GETICON = &H7F 'message is sent to a window to retrieve a handle _
to the large or small icon associated with a window
Private Const WM_SETICON = &H80 'message to associate a new large or small icon with a window
Private Const IMAGE_BITMAP = 0 'Loads a bitmap.
Private Const IMAGE_ICON = 1 ' Loads an icon.
Private Const IMAGE_CURSOR = 2 'Loads a cursor.
Private Const LR_LOADFROMFILE = &H10 'Loads the image from the file specified by _
the lpszName parameter. If this flag is not _
specified, lpszName is the name of the resource.
Private Const ICON_SMALL = 0& 'Retrieve the small icon for the window.
Private Const ICON_BIG = 1& 'Retrieve the large icon for the window.

'loads an icon, cursor, or bitmap.
Private Declare Function apiLoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpszName As String, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long

Private Declare Function apiSendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'//SHGetFileInfo flags
Private Const SHGFI_ICON = &H100 '// get icon
Private Const SHGFI_DISPLAYNAME = &H200 '// get display name
Private Const SHGFI_TYPENAME = &H400 '// get type name
Private Const SHGFI_ATTRIBUTES = &H800 '// get attributes
Private Const SHGFI_ICONLOCATION = &H1000 '// get icon location
Private Const SHGFI_EXETYPE = &H2000 '// return exe type
Private Const SHGFI_SYSICONINDEX = &H4000 '// get system icon index
Private Const SHGFI_LINKOVERLAY = &H8000 '// put a link overlay on icon
Private Const SHGFI_SELECTED = &H10000 '// show icon in selected state
Private Const SHGFI_ATTR_SPECIFIED = &H20000 '// get only specified attributes
Private Const SHGFI_LARGEICON = &H0 '// get large icon
Private Const SHGFI_SMALLICON = &H1 '// get small icon
Private Const SHGFI_OPENICON = &H2 '// get open icon
Private Const SHGFI_SHELLICONSIZE = &H4 '// get shell size icon
Private Const SHGFI_PIDL = &H8 '// pszPath is a pidl
Private Const SHGFI_USEFILEATTRIBUTES = &H10 '// use passed dwFileAttribute

Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const MAX_PATH = 260

Private Type SHFILEINFO
hIcon As Long 'Handle to the icon that represents the file.
iIcon As Long 'Index of the icon image within the _
system image list.
dwAttributes As Long 'Array of values that indicates the _
attributes of the file object.
szDisplayName As String * MAX_PATH 'String that contains the name of the _
file as it appears in the Windows shell
szTypeName As String * 80 'String that describes the type of file.
End Type

'Retrieves information about an object in the file system,
'such as a file, a folder, a directory, or a drive root.
Private Declare Function apiSHGetFileInfo Lib "shell32.dll" _
Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) _
As Long

Private Declare Function apiDestroyIcon Lib "user32" _
Alias "DestroyIcon" _
(ByVal hIcon As Long) _
As Long

'Declared here so we can use DestroyIcon afterwards
Private psfi As SHFILEINFO

'//ShowWindow flags
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3

'sets the specified window's show state.
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) _
As Long

'//Shell_NotifyIcon Flags
Private Const NIM_ADD As Long = &H0 'Add an icon to the status area.
Private Const NIM_MODIFY As Long = &H1 'Modify an icon in the status area.
Private Const NIM_DELETE As Long = &H2 'Delete an icon from the status area.

'//NOTIFYICONDATA flags
Private Const NIF_TIP As Long = &H4 'The szTip member is valid.
Private Const NIF_MESSAGE As Long = &H1 'The uCallbackMessage member is valid.
Private Const NIF_ICON As Long = &H2 'The hIcon member is valid.

'//Messages
Private Const WM_MOUSEMOVE = &H200 'posted to a window when the cursor moves.
Private Const WM_LBUTTONDBLCLK = &H203 'Left Double-click
Private Const WM_LBUTTONDOWN = &H201 'Left Button down
Private Const WM_LBUTTONUP = &H202 'Left Button up
Private Const WM_RBUTTONDBLCLK = &H206 'Right Double-click
Private Const WM_RBUTTONDOWN = &H204 'Right Button down
Private Const WM_RBUTTONUP = &H205 'Right Button up

Private Type NOTIFYICONDATA
cbSize As Long 'Size of this structure, in bytes.
hwnd As Long 'Handle to the window that will receive _
notification messages associated with an _
icon in the taskbar status area
uID As Long 'Application-defined identifier of the _
taskbar icon.
uFlags As Long 'Array of flags that indicate which of _
the other members contain valid data.
uCallbackMessage As Long 'Application-defined message identifier.
hIcon As Long 'Handle to the icon to be added, modified, _
or deleted
szTip As String * 64 'Pointer to a NULL-terminated string _
with the text for a standard tooltip.
End Type

'Sends a message to the taskbar's status area.
Private Declare Function apiShellNotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) _
As Long

'passes message information to the specified window procedure.
Private Declare Function apiCallWindowProc 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

'changes an attribute of the specified window.
Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long

Private nID As NOTIFYICONDATA
Private lpPrevWndProc As Long
Private mblnCustomIcon As Boolean

Private Const GWL_WNDPROC As Long = (-4) 'Sets a new address for the window procedure.


Function fWndProcTray(ByVal hwnd As Long, _
ByVal uMessage As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
'receives messages indirectly from the operating system
'but allows us to perform additional functions
'for some of those messages.
'
On Error Resume Next

Select Case lParam
Case WM_LBUTTONUP: 'Left Button Up
Call apiShowWindow(hwnd, SW_SHOWNORMAL)

Case WM_LBUTTONDBLCLK: 'Left Button Double click
Call apiShowWindow(hwnd, SW_SHOWNORMAL)

Case WM_LBUTTONDOWN: 'Left Button down
'Debug.Print "Left Button Down"

Case WM_RBUTTONDBLCLK: 'Right Double-click
'Debug.Print "Right Button Double Click"

Case WM_RBUTTONDOWN: 'Right Button down
'Debug.Print "Right button Down"

Case WM_RBUTTONUP: 'Right Button Up
Call apiShowWindow(hwnd, SW_SHOWNORMAL)
End Select

'return the messages back
fWndProcTray = apiCallWindowProc( _
ByVal lpPrevWndProc, _
ByVal hwnd, _
ByVal uMessage, _
ByVal wParam, _
ByVal lParam)
End Function

Sub sHookTrayIcon(frm As Form, _
strFunction As String, _
Optional strTipText As String, _
Optional strIconPath As String)
'Initialize the tray icon first
If fInitTrayIcon(frm, strTipText, strIconPath) Then
'hide the form window
frm.Visible = False

'Set new address for window's message handler
lpPrevWndProc = apiSetWindowLong(frm.hwnd, _
GWL_WNDPROC, _
AddrOf(strFunction))
End If
End Sub

Sub sUnhookTrayIcon(frm As Form)
'Restore the original message handler
Call apiSetWindowLong(frm.hwnd, _
GWL_WNDPROC, _
lpPrevWndProc)
'Remove the icon in the SysTray
Call apiShellNotifyIcon(NIM_DELETE, nID)

'If a custom icon was used, reset the form's icon
If mblnCustomIcon Then
Call fRestoreIcon(frm.hwnd)
End If
'Destroy the icon
Call apiDestroyIcon(psfi.hIcon)
End Sub

Private Function fExtractIcon() As Long
' Extracts the icon associated with an Access form
'
On Error GoTo ErrHandler
Dim hIcon As Long

'Don't need the full file name as Access form shortcuts
'have MAF extension. The SHGFI_USEFILEATTRIBUTES
'lets us pass an "invalid" file name to SHGetFileInfo
hIcon = apiSHGetFileInfo(".MAF", FILE_ATTRIBUTE_NORMAL, _
psfi, LenB(psfi), _
SHGFI_USEFILEATTRIBUTES Or _
SHGFI_SMALLICON Or SHGFI_ICON)
'Make sure there were no errors
If Not hIcon = 0 Then fExtractIcon = psfi.hIcon
ExitHere:
Exit Function
ErrHandler:
fExtractIcon = False
Resume ExitHere
End Function

Private Function fRestoreIcon(hwnd As Long)
'Load the default form icon and assign it to the window
Call apiSendMessageLong(hwnd, WM_SETICON, 0&, fExtractIcon())
End Function

Private Function fSetIcon(frm As Form, strIconPath As String) As Long
Dim hIcon As Long
'Load the 16x16 icon from file
hIcon = apiLoadImage(0&, strIconPath, IMAGE_ICON, 16&, 16&, LR_LOADFROMFILE)
If hIcon Then
'First set the form's icon
Call apiSendMessageLong(frm.hwnd, WM_SETICON, 0&, hIcon&)
'This will tell us afterwards if we need to reset the form's icon
mblnCustomIcon = True
'Now return the hIcon
fSetIcon = hIcon
End If
End Function

Private Function fInitTrayIcon(frm As Form, strTipText As String, strIconPath As String) As Boolean
Dim hIcon As Long

'If the user didn't specify the tip text, use a default value
If strTipText = vbNullString Then strTipText = "MSAccess Form"

If (strIconPath = vbNullString) Or (Dir(strIconPath) = vbNullString) Then
'if there's no icon specified, use the form's default icon
hIcon = fExtractIcon()
Else
'load and set the icon
hIcon = fSetIcon(frm, strIconPath)
End If

'If we were successful in previous step, then continue
'to place the icon in the system tray
If hIcon Then
With nID
.cbSize = LenB(nID)
.hwnd = frm.hwnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = hIcon
.szTip = strTipText & vbNullChar
End With
Call apiShellNotifyIcon(NIM_ADD, nID)
fInitTrayIcon = True
End If
End Function
'************** Code End *************


Best of luck
 

Randomblink

The Irreverent Reverend
Local time
Today, 12:38
Joined
Jul 23, 2001
Messages
279
SWEET! This will be cool...

Ok...

So I have created a module that holds this code...

What Call Statement do I execute to run it...?

Can ANYONE help me...???

This is purely for looks...but it would look WAY cool...

Thanks in advance...
 

BukHix

Registered User.
Local time
Today, 13:38
Joined
Feb 21, 2002
Messages
379
Here is more information about this particular function: Subclassing form for SysTray functionality

From that link - Note: In order to test the code in this article, you will need the AddressOf code as well.

The only problem is that the two links mentioned are outdated and now require a subscription to get to.
 

Cosmos75

Registered User.
Local time
Today, 12:38
Joined
Apr 22, 2002
Messages
1,281
Does this work?

Has anybody tried this?
 

homer2002

Registered User.
Local time
Today, 17:38
Joined
Aug 27, 2002
Messages
152
Does anyone have a copy of the AddressOf function?

I can't find it anywhere?
 

bretto

Registered User.
Local time
Today, 17:38
Joined
Jun 25, 2003
Messages
29
I'm not 100% on this but addressof is supported in Access 2000 onwards. I maybe wrong however but it does ring a bell!!
 

homer2002

Registered User.
Local time
Today, 17:38
Joined
Aug 27, 2002
Messages
152
I think it is supported in 2000.
Unfortuantly I have access 97 (cause i'm at work :-( )
I know there were copies of the code floating around, but the site I go to now asks for a subscription to get hold of it.
 

Fuga

Registered User.
Local time
Today, 18:38
Joined
Feb 28, 2002
Messages
566
Ok...
I have the code that removes the Access window from the screen.

Could you post that one here?

Fuga.
 

IMO

Now Known as ___
Local time
Today, 17:38
Joined
Sep 11, 2002
Messages
723
Fuga said:


Could you post that one here?

Fuga.

Fuga,

This code hides the Access Window and removes the DB from the TaskBar. You must have your forms set as PopUp = Yes and Modal = Yes.
Code:
Option Compare Database
Option Explicit

Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3

Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long

Function fSetAccessWindow(nCmdShow As Long)

Dim loX As Long
Dim loForm As Form
On Error Resume Next
Set loForm = Screen.ActiveForm

If Err <> 0 Then
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If

If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then
MsgBox "Cannot minimize Access with " _
& (loForm.Caption + " ") _
& "form on screen"
ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then
MsgBox "Cannot hide Access with " _
& (loForm.Caption + " ") _
& "form on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
End If
fSetAccessWindow = (loX <> 0)
End Function
Call the function with...
Code:
Call fSetAccessWindow(0)
in the FormLoad event.

IMO
 

Fuga

Registered User.
Local time
Today, 18:38
Joined
Feb 28, 2002
Messages
566
Great! Thanks IMO.

I´m going to use this a lot in the future.

Fuga.
 

tembenite

Registered User.
Local time
Today, 13:38
Joined
Feb 10, 2005
Messages
38
For those of you looking for the 97 Addressof code, I followed the links and was never asked for a membership. Below is the excel document with the "Addressof" information, referenced from the links earlier in this post.
 

Attachments

  • CallBacks.zip
    23.8 KB · Views: 532
S

syri

Guest
How

How to test this code?


This comes from an application I found some time ago.
Option Compare Database
Option Explicit

'************** Code Start *************
'

'------------------------------
' Do NOT try to step through
' this code. Entering debug mode
' will cause a GPF if the window
' is subclassed.
'------------------------------

'//LoadImage flags
Private Const WM_GETICON = &H7F 'message is sent to a window to retrieve a handle _
to the large or small icon associated with a window
Private Const WM_SETICON = &H80 'message to associate a new large or small icon with a window
Private Const IMAGE_BITMAP = 0 'Loads a bitmap.
Private Const IMAGE_ICON = 1 ' Loads an icon


Thanks.
 
N

nescafe

Guest
hey

do you know how to configure the icon from system tray to maximize form when you do double click into the icon?



thx ><
 

Keith Nichols

Registered User.
Local time
Today, 19:38
Joined
Jan 27, 2006
Messages
431
Not actually what is asked for but might be useful to some

This is not quite what is being asked for but it does make for a very clean interface and uses hardly any code at all.

The switchboard is set to pop up, modal no, and sized to run off the right and bottom sides of the screen which results in it always filling the screen entirely.

Other forms & reports are set to Pop up on & Modal yes or they would not be visible as they would appear "behind" the switchboard.

The DB opens with the switchboard so the user cannot get to the database window.

2 Command Buttons are added to the switchboard, one to minimize the application and the other to close the application.

The DB appears as a single item in the task bar. If the minimize command on the switchboard is used, the db drops down to the task bar and a single click on the task bar icon restores the DB with the Switchboard showing.

The only irritation with this is that you have to open the DB with the shift key held down if you want access to the database window yourself. And if you are looking to modify the switchboard, you have to reload after every test viewing. Not big problems really.

In conclusion, this works well and is simple, albeit a savy user can get into the DB if they wish to.

Set the Switchboard to display on startup.

Set Switchboard
Pop up Yes
Modal no

Switchboard On Open event
Code:
'Set Switchboard size & position
    Me.Move Left:=0
    Me.InsideHeight = 15000    'Any number that is greater than the screen height
    Me.InsideWidth = 20000     'Any number that is greater than the screen width

Switchoard Command button:
Code:
Private Sub cmd_Minimize_App_Click()
Application.RunCommand acCmdAppMinimize
End Sub

Some of the solutions offered on this thread runs to dozens of lines of code so this simple solution may be suficient for some situations that do not warrent any added functionality provided.

I hope this is of some interest or use to others.

Kind regards,

Keith.
 

Banana

split with a cherry atop.
Local time
Today, 10:38
Joined
Sep 1, 2005
Messages
6,318
I used to have my database hidden using Dev's code that IMO posted, but later I found it to be too problematic to work with.

1) Setting my forms modal and popup causes all 'Docmd.RunCommand' commands to be "inavailable" and I ended up writing *more* code to duplicate those commands which in end, was more buggy and inconsistent

2) The Access Windows behave quite inconsistently. Once you've shown the Access windows, it cannot be re-hidden unless the form is restarted. Again, it takes more to juggle it to work, which is unnecessary, IMO.

While I would love to hide Access window, I don't think it's really worth it if you end up making 100x workarounds to support this.
 

popeye

Work smarter, not harder.
Local time
Today, 10:38
Joined
Aug 23, 2004
Messages
75
how to trigger the unhook codes when double click icon in sytem tray

i got this to work, got the vba332.dll and also the addressof code and i got it to work as far as minimizing to the system tray, but i would also like to double click the icon to bring back up the form.. sadly i dont know how to... i see the sUnhookTrayIcon line of code, but dont know how to trigger it.... like how do i put an event to the double - click for the icon in the sytem tray?
 

Users who are viewing this thread

Top Bottom