USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Deixar o programa do lado do Relógio?
João Paulo
ARCOS
MG - BRASIL
Postada em 27/12/2005 14:33 hs            
Alguém sabe como faço isso?
     
vilmarbr
Pontos: 2843
SAO PAULO
SP - BRASIL
Postada em 27/12/2005 16:10 hs         
TENTA ENTENDER ESTE CÓDIGOOOO ABAIXO:
COLOCAR NUM MÓDULO de classe chamado clsTrayIcon:
' clsTrayIcon (System Tray Icon)
' Creator:  Michael Hawkins (Lancerlot Programming)
' Date:     5th December 2004
' Website:  http://lancerlot.net/index.php
' Email:    info@lancerlot.net
Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
' Constants used to detect clicking on the icon
Private Const WM_LBUTTONDBLCLK = &H203
'Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONUP = &H205
'Private Const WM_LBUTTONUP = &H202
Private Const WM_MOUSEMOVE = &H200
' Constants used to control the icon
Private Const NIM_ADD = &H0
'Private Const NIM_MODIFY = &H1
Private Const NIF_MESSAGE = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
' Used by Shell_NotifyIcon (TrayIcon)
Private 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
'create variable of type NOTIFYICONDATA (TrayIcon)
Private TrayIcon As NOTIFYICONDATA
Private st_Err() As String
Private ln_ErrCount As Long
Private Sub Class_Initialize()
    Erase st_Err()
    ln_ErrCount = -1
End Sub
Private Function hf_StoreErr(st_Func As String, ErrorNumber As Long)
    ln_ErrCount = ln_ErrCount + 1
    ReDim Preserve st_Err(ln_ErrCount)
    st_Err(ln_ErrCount) = st_Func & ": Error " & Error(ErrorNumber) & " - " & Err.Description
End Function
Function hf_DumpErr()
Dim ln_Index As Long
    If ln_ErrCount = -1 Then Exit Function
    Debug.Print ""
    Debug.Print "clsTrayIcon Class Module Errors"
    Debug.Print "-------------------------------"
    For ln_Index = 0 To ln_ErrCount
        Debug.Print st_Err(ln_Index)
    Next
End Function
Function fn_ShowIcon(frm_hWnd As Long, ob_Icon As IPictureDisp, st_Tooltip As String) As Long
On Local Error Resume Next
    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hwnd = frm_hWnd
    TrayIcon.uId = vbNull
    TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    TrayIcon.ucallbackMessage = WM_MOUSEMOVE
    TrayIcon.hIcon = ob_Icon
    TrayIcon.szTip = st_Tooltip & Chr$(0)
    Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
    If Err <> 0 Then
        Call hf_StoreErr("fn_ShowIcon", Err.Number)
        Err.Clear
    End If
End Function
Function fn_HideIcon(frm_hWnd As Long) As Long
On Local Error Resume Next
    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hwnd = frm_hWnd
    TrayIcon.uId = vbNull
    Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
    If Err <> 0 Then
        Call hf_StoreErr("fn_HideIcon", Err.Number)
        Err.Clear
    End If
End Function
Function fn_MouseMove(ob_Form As Form, Button As Integer, x As Single, Y As Single, Optional int_ShowWindState As Integer = 0, Optional ob_PopupMenu As Menu = Nothing) As Long
On Local Error Resume Next
Static Message As Long
Static RR As Boolean
   
    Message = x / Screen.TwipsPerPixelX
    If RR = False Then
        RR = True
        Select Case Message
            Case WM_LBUTTONDBLCLK
                If ob_Form.WindowState = 1 Then ob_Form.WindowState = int_ShowWindState
                ob_Form.Show
            Case WM_RBUTTONUP
                If Not ob_PopupMenu Is Nothing Then ob_Form.PopupMenu ob_PopupMenu
        End Select
        RR = False
    End If
    fn_MouseMove = Err.Number
    If Err <> 0 Then
        Call hf_StoreErr("fn_MouseMove", Err.Number)
        Err.Clear
    End If
    Err.Clear
End Function
 
COLOCAR NUM FORM:
pode ser no form_load mesmo:
Private objTrayIcon  As clsTrayIcon
    '--- Cria o objeto TrayIcon ---'
    Set objTrayIcon = New clsTrayIcon
    objTrayIcon.fn_ShowIcon Me.hwnd, Me.Icon, "texto xxxxx"
 
Private Sub Form_Unload(Cancel As Integer)
   '--- Destrói o objeto do TrayIcon, tirando a aplicação do SysTray ---'
   objTrayIcon.fn_HideIcon Me.hwnd
   objTrayIcon.hf_DumpErr
  
   '--- Destrói o objeto de comunicação ---'
   Set m_objTrayIcon = Nothing
   End
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
   objTrayIcon.fn_MouseMove Me, Button, x, Y, 0, mnuPopup_TrayIcon
'CRIE UM MENU CHAMADO mnuPopup_TrayIcon: POR EXEMPLO

Begin VB.Menu mnuPopup_TrayIcon

Caption = "PopupTrayIcon"

Visible = 0 'False

Begin VB.Menu mnuShowForm_TrayIcon

Caption = "Mostrar Janela Principal"

End

Begin VB.Menu mnuFechar_TrayIcon

Caption = "Fechar Aplicação"

End

Begin VB.Menu mnuLinha

Caption = "-"

End

Begin VB.Menu mnuCancelar

Caption = "Cancelar"

End

End


End Sub

http://www.vilmarbro.com.br
TÓPICO EDITADO
   
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
Postada em 27/12/2005 16:18 hs            
Coloque em um modulo:

Option Explicit

Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu

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 Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public 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

Private TheData As NOTIFYICONDATA
' *********************************************
' The replacement window proc.
' *********************************************
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = TRAY_CALLBACK Then
        ' The user clicked on the tray icon.
        ' Look for click events.
        If lParam = WM_LBUTTONUP Then
            ' On left click, show the form.
            If TheForm.WindowState = vbMinimized Then _
                TheForm.WindowState = TheForm.MaxState
            TheForm.SetFocus
            Exit Function
        End If
        If lParam = WM_RBUTTONUP Then
            ' On right click, show the menu.
            TheForm.PopupMenu TheMenu
            Exit Function
        End If
    End If
    
    ' Send other messages to the original
    ' window proc.
    NewWindowProc = CallWindowProc( _
        OldWindowProc, hwnd, Msg, _
        wParam, lParam)
End Function
' *********************************************
' Add the form's icon to the tray.
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
    ' ShowInTaskbar must be set to False at
    ' design time because it is read-only at
    ' run time.

    ' Save the form and menu for later use.
    Set TheForm = frm
    Set TheMenu = mnu
    
    ' Install the new WindowProc.
    OldWindowProc = SetWindowLong(frm.hwnd, _
        GWL_WNDPROC, AddressOf NewWindowProc)
    
    ' Install the form's icon in the tray.
    With TheData
        .uID = 0
        .hwnd = frm.hwnd
        .cbSize = Len(TheData)
        .hIcon = frm.Icon.Handle
        .uFlags = NIF_ICON
        .uCallbackMessage = TRAY_CALLBACK
        .uFlags = .uFlags Or NIF_MESSAGE
        .cbSize = Len(TheData)
    End With
    Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' Remove the icon from the system tray.
' *********************************************
Public Sub RemoveFromTray()
    ' Remove the icon from the tray.
    With TheData
        .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    
    ' Restore the original window proc.
    SetWindowLong TheForm.hwnd, GWL_WNDPROC, _
        OldWindowProc
End Sub
' *********************************************
' Set a new tray tip.
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .szTip = tip & vbNullChar
        .uFlags = NIF_TIP
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
' *********************************************
' Set a new tray icon.
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
    ' Do nothing if the picture is not an icon.
    If pic.Type <> vbPicTypeIcon Then Exit Sub

    ' Update the tray icon.
    With TheData
        .hIcon = pic.Handle
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub


E no formulário :

Option Explicit

Public MaxState As Integer

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Private Sub Form_Load()
    If WindowState = vbMinimized Then
        MaxState = vbNormal
    Else
        MaxState = WindowState
    End If

    AddToTray Me, mnuTray
    
    SetTrayTip "VB Helper tray icon program"
End Sub

' Enable the correct tray menu items.
Private Sub Form_Resize()
    Select Case WindowState
        Case vbMinimized
            mnuTrayMaximize.Enabled = True
            mnuTrayMinimize.Enabled = False
            mnuTrayMove.Enabled = False
            mnuTrayRestore.Enabled = True
            mnuTraySize.Enabled = False
        Case vbMaximized
            mnuTrayMaximize.Enabled = False
            mnuTrayMinimize.Enabled = True
            mnuTrayMove.Enabled = False
            mnuTrayRestore.Enabled = True
            mnuTraySize.Enabled = False
        Case vbNormal
            mnuTrayMaximize.Enabled = True
            mnuTrayMinimize.Enabled = True
            mnuTrayMove.Enabled = True
            mnuTrayRestore.Enabled = False
            mnuTraySize.Enabled = True
    End Select

    If WindowState <> vbMinimized Then _
        MaxState = WindowState
End Sub
' Important! Remove the tray icon.
Private Sub Form_Unload(Cancel As Integer)
    RemoveFromTray
End Sub


Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub mnuTrayClose_Click()
    Unload Me
End Sub


Private Sub mnuTrayMaximize_Click()
    WindowState = vbMaximized
End Sub


Private Sub mnuTrayMinimize_Click()
    WindowState = vbMinimized
End Sub


Private Sub mnuTrayMove_Click()
    SendMessage hwnd, WM_SYSCOMMAND, _
        SC_MOVE, 0&
End Sub


Private Sub mnuTrayRestore_Click()
    SendMessage hwnd, WM_SYSCOMMAND, _
        SC_RESTORE, 0&
End Sub


Private Sub mnuTraySize_Click()
    SendMessage hwnd, WM_SYSCOMMAND, _
        SC_SIZE, 0&
End Sub


Existem varios outros exemplos um pouco mais complexos, mas esta é a base.

   
PS: se vc quiser outros exemplos, basta procurar por Tray Ico 
em sites que oferecem exemplos grátuitos,
 como http://www.planet-source-code.com/ que vc ira encontrar varios.

"O pior inimigo que você poderá encontrar será sempre você mesmo."
     
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
Postada em 27/12/2005 16:19 hs            
'Primeiramente insira este codigo em um modulo

'======================================================================================
'Para colocar um Icone na bandeja(tray) da barra do menu Iniciar
'======================================================================================
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public 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

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4

'Faca sua propria constante
Public Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP

Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
'======================================================================================
'FIM Para colocar um Icone na bandeja(tray) da barra do menu Iniciar
'======================================================================================


Crie um Form com dois botoes de comando e uma caixa de figura com um ícone dentro
(Command1, Command2, Picture1)



'Insira no Form este código abaixo

Public Sub CreateIcon()

    Dim Tic As NOTIFYICONDATA
    Tic.cbSize = Len(Tic)
    Tic.hwnd = Picture1.hwnd
    Tic.uID = 1&
    Tic.uFlags = NIF_DOALL
    Tic.uCallbackMessage = WM_MOUSEMOVE
    Tic.hIcon = Picture1.Picture
    Tic.szTip = "Visual Basic Demo Project" & Chr$(0)
    erg = Shell_NotifyIcon(NIM_ADD, Tic)
    
End Sub

Public Sub DeleteIcon()
    
    Dim Tic As NOTIFYICONDATA
    Tic.cbSize = Len(Tic)
    Tic.hwnd = Picture1.hwnd
    Tic.uID = 1&
    erg = Shell_NotifyIcon(NIM_DELETE, Tic)
    
End Sub

Private Sub Command1_Click()
    CreateIcon
End Sub

Private Sub Command2_Click()
    
    DeleteIcon

End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    X = X / Screen.TwipsPerPixelX
    
    Select Case X
    Case WM_LBUTTONDOWN
    Caption = "Left Click"
    Case WM_RBUTTONDOWN
    Caption = "Right Click"
    Case WM_MOUSEMOVE
    Caption = "Move"
    Case WM_LBUTTONDBLCLK
    Caption = "Double Click"
    End Select


End Sub

"O pior inimigo que você poderá encontrar será sempre você mesmo."
     
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
Postada em 27/12/2005 16:20 hs            
Agora c vc quiser um ícone animado (na verdade dois icones alternando) faça o seguinte:
Crie um projeto com dois pictures box (um array com os indices 0 e 1)
coloque os icones desejados nas propiedades picture..., acrescente um timer com um interval 
de 100 (por exemplo) e um menu (que irá aparecer quando o ícone do seu porgrama for clicado 
(botão direito)


Option Explicit

Private 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

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim t As NOTIFYICONDATA

Private Sub Form_Load()
    t.cbSize = Len(t)
    t.hWnd = Picture1(0).hWnd
    t.uId = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_MOUSEMOVE
    t.hIcon = Picture1(0).Picture
    t.szTip = "Shell_NotifyIcon ..." & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    Timer1.Enabled = True
    Me.Hide
    App.TaskVisible = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Timer1.Enabled = False
    t.cbSize = Len(t)
    t.hWnd = Picture1(0).hWnd
    t.uId = 1&
    Shell_NotifyIcon NIM_DELETE, t
End Sub

Private Sub Menu_Click(Index As Integer)
    Unload Me
End Sub

Private Sub picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Hex(X) = "1E3C" Then
        Me.PopupMenu NomedoseuMenu
    End If
End Sub

Private Sub timer1_Timer()
    Static i As Long, img As Long
    t.cbSize = Len(t)
    t.hWnd = Picture1(0).hWnd
    t.uId = 1&
    t.uFlags = NIF_ICON
    t.hIcon = Picture1(i).Picture
    Shell_NotifyIcon NIM_MODIFY, t
    Timer1.Enabled = True
    i = i + 1
    If i = 2 Then i = 0
End Sub


"O pior inimigo que você poderá encontrar será sempre você mesmo."
     
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2025   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página