Senhores consegui resolver parte, através dessa função qeu encontrei aqui no fórum... Se não me engano é do grande JPaulo.
Option Explicit
Option Base 1
'---------------------------------------------------------------------------------------
'TYPE DEFINITIONS
Private Type NOTIFYICONDATA
cbSize As Long 'Size of this structure, in bytes.
hWnd As Long 'Handle to the window that will receive notification messages from icon in systray
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
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'---------------------------------------------------------------------------------------
'DECLARE REFERENCE LIBRARIES
'Retrieve handle to specified window
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'Retrieve info from class associated with specified window (used to get handle to window's icon)
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
'Retrieve information about the specified window
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
'Send a message to the taskbar's status area.
Private Declare Function ShellNotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long
'Change settings in the specified window
Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) As Long
'Redraw window
Declare Function RedrawWindow Lib "user32" _
(ByVal hWnd As Long, _
lprcUpdate As Any, _
ByVal hrgnUpdate As Long, _
ByVal fuRedraw As Long) As Long
'Get cursor position (used to provide position for TrackPopupMenu)
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
'Create custom popup menu
Private Declare Function CreatePopupMenu Lib "user32" () As Long
'Add line item to popup menu
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
(ByVal hMenu As Long, _
ByVal wFlags As Long, _
ByVal wIDNewItem As Long, _
ByVal lpNewItem As Any) As Long
'Destroy popup menu
Private Declare Function DestroyMenu Lib "user32" _
(ByVal hMenu As Long) As Long
'Display popup menu in specified location
Private Declare Function TrackPopupMenu Lib "user32" _
(ByVal hMenu As Long, ByVal wFlags As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nReserved As Long, _
ByVal hWnd As Long, _
ByVal lprc As Any) As Long
'passes message information to the specified window procedure.
Private Declare Function CallWinProc Lib "user32" Alias "CallWinProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'sets the specified window's show state.
Private Declare Function ShowWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
'---------------------------------------------------------------------------------------
'DECLARE CONSTANTS
'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_MESSAGE As Long = &H1 'The uCallbackMessage member is valid.
Private Const NIF_ICON As Long = &H2 'The hIcon member is valid.
Private Const NIF_TIP As Long = &H4 'The szTip member is valid.
'Window Style Flags
Private Const GWL_WNDPROC = (-4)
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_MINIMIZE = &H20000000
'ShowWindow flags
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
'Redraw flags
Private Const RDW_ALLCHILDREN = &H80
Private Const RDW_ERASE = &H4
Private Const RDW_ERASENOW = &H200
Private Const RDW_FRAME = &H400
Private Const RDW_INTERNALPAINT = &H2
Private Const RDW_INVALIDATE = &H1
Private Const RDW_NOCHILDREN = &H40
Private Const RDW_NOERASE = &H20
Private Const RDW_NOFRAME = &H800
Private Const RDW_NOINTERNALPAINT = &H10
Private Const RDW_UPDATENOW = &H100
Private Const RDW_VALIDATE = &H8
'Create an empty popupmenu
Private Const MF_APPEND = &H100&
Private Const MF_CHECKED = &H8&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_RETURNCMD = &H100&
'Messages
Private Const WM_USER = &H400
Private Const TRAY_CALLBACK = (WM_USER + 1001&)
Private Const WM_MOUSEMOVE = &H200 'posted to a window when the cursor moves.
Private Const WM_LBUTTONDOWN = &H201 'Left Button down
Private Const WM_LBUTTONUP = &H202 'Left Button up
Private Const WM_LBUTTONDBLCLK = &H203 'Left Double-click
Private Const WM_RBUTTONDOWN = &H204 'Right Button down
Private Const WM_RBUTTONUP = &H205 'Right Button up
Private Const WM_RBUTTONDBLCLK = &H206 'Right Double-click
'Icon
Private Const GCL_HICON = (-14)
'---------------------------------------------------------------------------------------
'DECLARE GLOBAL VARIABLES
Private TrayItem As NOTIFYICONDATA
Private frmhWnd As Long
Private lngWndState As Long
Private hMenu As Long
Private OldWndProc As Long
Public Sub AddToTray()
'Original style of window
Dim lngStyle As Long
'Get handle to Access window
frmhWnd = FindWindow("OMain", vbNullString)
'Add Icon to SysTray
With TrayItem
.cbSize = Len(TrayItem)
.hWnd = frmhWnd
.uID = 0
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = TRAY_CALLBACK
.hIcon = GetClassLong(frmhWnd, GCL_HICON)
.szTip = "Meu Banco" & vbNullChar
End With
ShellNotifyIcon NIM_ADD, TrayItem
'Find current style of Access window
lngStyle = GetWindowLong(frmhWnd, GWL_STYLE)
'Store current state of window to restore later
If lngStyle And WS_MAXIMIZE Then
lngWndState = SW_SHOWMAXIMIZED
ElseIf lngStyle And WS_MINIMIZE Then
lngWndState = SW_SHOWMINIMIZED
Else
lngWndState = SW_SHOWNORMAL
End If
'Minimize and Hide Window
ShowWindow frmhWnd, SW_MINIMIZE
'ShowWindow frmhWnd, SW_HIDE
'Set function for handling respones from Icon
OldWndProc = SetWindowLongPtr(frmhWnd, GWL_WNDPROC, AddressOf NewWinProc)
'Create Popup Menu
hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, ByVal 1&, "Restaurar"
AppendMenu hMenu, MF_STRING, ByVal 2&, "Exit"
AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&
'AppendMenu hMenu, MF_CHECKED, ByVal 3&, "About..."
End Sub
Public Function NewWinProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim intSelection As Integer
Dim pos As POINTAPI
If msg = TRAY_CALLBACK Then
If lParam = WM_RBUTTONUP Then
GetCursorPos pos
intSelection = TrackPopupMenu(hMenu, TPM_LEFTALIGN + TPM_RETURNCMD, pos.X, pos.Y, 0, hWnd, ByVal 0&)
Select Case intSelection
Case 1:
'Restore window to previous state
RemoveFromTray
'ShowWindow frmhWnd, lngWndState
ShowWindow frmhWnd, SW_MAXIMIZE
ShowWindow frmhWnd, SW_SHOW
'RedrawWindow frmhWnd, False, 0, RDW_UPDATENOW + RDW_INVALIDATE
'SetWindowPos Null, 0, 0, 0, 0, SWP_FRAMECHANGED
Exit Function
Case 2:
Exit Function
End Select
End If
End If
NewWinProc = CallWinProc(OldWndProc, hWnd, msg, wParam, lParam)
End Function
Public Sub RemoveFromTray()
'Restore Window Settings
SetWindowLongPtr frmhWnd, GWL_WNDPROC, OldWndProc
'Remove Icon from SysTray
ShellNotifyIcon NIM_DELETE, TrayItem
'Destroy Popup Menu
DestroyMenu hMenu
End Sub
Function cIntToBin(ByVal IntNum As Long)
Dim TempValue As Long
Dim binValue As String
Do While IntNum > 0
'Use the Mod operator to get the current binary digit from the
'Integer number
TempValue = IntNum Mod 2
binValue = CStr(TempValue) + binValue
'Divide the current number by 2 and get the integer result
IntNum = IntNum \ 2
Loop
cIntToBin = binValue
End Function
Function cBinToInt(ByVal BinNum As String)
Dim Length As Integer, X As Integer
Dim TempValue As Integer
'Get the length of the binary string
Length = Len(BinNum)
'Convert each binary digit to its corresponding integer value
'and add the value to the previous sum
'The string is parsed from the right (LSB - Least Significant Bit)
'to the left (MSB - Most Significant Bit)
For X = 1 To Length
TempValue = TempValue + Val(Mid(BinNum, Length - X + 1, 1)) * 2 ^ (X - 1)
Next
cBinToInt = TempValue
End Function
'-----------------------------------------------------------------------------
No botão Minimizar:
Private Sub cmdMinimiza_Click()
AddToTray
End Sub
No Botão Ao fechar do form
Private Sub Form_Close()
RemoveFromTray
End Sub
'-----------------------------------------------------------------------------
Há um problema aqui nessa função:
Quando minimiza, que passo o mouse sobre o pop-up não está ficando visível a descrição dos botões da Pop-up.
'Create Popup Menu
hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, ByVal 1&, "Restaurar"
AppendMenu hMenu, MF_STRING, ByVal 2&, "Exit"
AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&
'AppendMenu hMenu, MF_CHECKED, ByVal 3&, "About..."
Se poderem me ajudar e obviamente, outros que faram uso dessa rotina...
Desde já agradeço vossa atenção...
Abraço a todos...
Início
cjsilva2013 31/10/2016, 21:36