pregunta: "Como hacer que salga un icono en la barra donde sale la fecha?"

[700esoj]

Bueno mi pregunta es que si alguien saber si alguien nos puede explicar el como sacar un icono cuando arranco mi applicacion. Por ejemplo, el messenger. Cuando uno abre el messenger, sale un icono de messenger en la parte inferior de la derechar. Entonces como uno puede hacer que aparesca un icono pero con nuestra aplicacion. Sera posible desde visual basic?

[Ther0x]

En la biblioteca de Ranefi viene esto:


Para ver este enlace Registrate o Inicia Sesion

foro.portalhac ker.net/index.php/topic,11478.msg34561.html#msg34561

Es lo más parecido que he encontrado a lo que tu quieres.

Saludos

[ziBboh]

Te dejo esta parte de un manual acerca de las apis en VB6. Espero y te sirva.

Un segundo ejemplo (Ocultar en el área de notificación)
En este ejemplo vamos a utilizar otra API para ocultar una aplicación junto al reloj del sistema, es decir, en el área de notificación. Para ello la aplicación usará un “Picture Box” como pivote entre la aplicación y la API, para los que hayan visitado el sitio del “Guille” esta aplicación es algo parecida a una que el expone en su sitio Web (pero no es copiada, sino revisen el código y verán). Empezamos con este formulario:

Código:

Empezamos en la sección de declaraciones generales:

Option Explicit ‘ Sólo variables explicitas
Private Type NOTIFICAR ‘ Notificar a Windows que ha ocurrido algo
cbSize As Long ‘ tamaño del mensaje
hwnd As Long ‘ manejador (handle) de la aplicación
uId As Long ‘ Identificador del mensaje
uFlags As Long ‘ banderas del mensaje
ucallbackMessage As Long ‘ mensaje de la API
hIcon As Long ‘ icono de la aplicación
szTip As String * 64 ‘ tool tip de la aplicación
End Type

‘la siguiente lista son las constantes del sistema para algunos mensajes ‘sobre la aplicación, las puedes llamar como quieras pero los valores así ‘van tal cual.

Private Const TRAY_ADD = &H0  ‘agregar al systray
Private Const TRAY_MODIFY = &H1 ‘modificarlo en el systray
Private Const TRAY_DELETE = &H2  ‘quitar del systray
Private Const WIN_MOUSEMOVE = &H200 ‘mover ratón sobre ventana
Private Const TRAY_MESSAGE = &H1 ‘mensaje del systray
Private Const TRAY_ICON = &H2 ‘icono en el systray
Private Const TRAY_TIP = &H4 ‘tool tip en el systray
Private Const WIN_LBUTTONDBLCLK = &H203 ‘dar doble click izquierdo
Private Const WIN_LBUTTONDOWN = &H201 ‘botón izq abajo
Private Const WIN_LBUTTONUP = &H202 ‘botón izq arriba
Private Const WIN_RBUTTONDBLCLK = &H206 ‘doble clic botón der
Private Const WIN_RBUTTONDOWN = &H204 ‘botón derecho abajo
Private Const WIN_RBUTTONUP = &H205 ‘botón derecho arriba
Private Declare Function Shell_NotifyIcon Lib "shell32" _
    (ByVal dwMessage As Long, _
    pnid As NOTIFICAR) As Boolean

‘llamada a la API Shell_NotifyIcon para notificar al sistema los mensajes ‘del systray, sus parámetros son el mensaje y el registro con los datos ‘tomados del systray

Dim X As NOTIFICAR ‘variable derivada del registro NOTIFICAR

Private Sub Form_Load()
     If App.PrevInstance Then ‘si existe alguna instancia de la aplicación
        Unload Me
        End
    End If
    X.cbSize = Len(X) ‘el mensaje es del tamaño del registro NOTIFICAR
    X.hwnd = pic_pivote.hwnd ‘ el manejador del registro NOTIFICAR es el del “Picture Box”
    X.uId = 1& “se identifica con este valor hexadecimal
    X.uFlags = TRAY_ICON Or TRAY_TIP Or TRAY_MESSAGE ‘las banderas son el icono, el tool tip y el mensaje del systray
    X.ucallbackMessage = WIN_MOUSEMOVE ‘ se captura un mensaje ‘cuando se mueve el ratón sobre la aplicación
    X.hIcon = pic_pivote.Picture ‘el icono del systray es el mismo del “Picture Box”
    X.szTip = Me.Caption & Chr$(0) ‘El tool tip del systray es el titulo del ‘formulario más un carácter 0 (esto no se porque lo hace)
    Shell_NotifyIcon TRAY_ADD, X ‘se llama a la API con los datos ‘obtenidos
    Me.Hide ‘ se oculta el formulario
    App.TaskVisible = False ‘ se quita de la barra de tareas
End Sub

‘antes de descargar el formulario avisar que hacer con la aplicación en el ‘systray

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    X.cbSize = Len(X) ‘obtener longitud del mensaje
    X.hwnd = pic_pivote.hwnd ‘obtener manejador
    X.uId = 1&  ‘obtener id
    Shell_NotifyIcon TRAY_DELETE, X ‘eliminar la aplicación del ‘systray con los datos obtenidos.
End Sub

‘Este es el truco que lo hace todo, recuerda que todo lo que se haga sobre ‘el “Picture Box” sirve de mensaje para la API, es mejor utilizar el evento ‘MouseMove, porque captura todo lo que pase sobre el objeto.

Private Sub pic_pivote_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Static verifica As Boolean, Msg As Long
    Msg = X / Screen.TwipsPerPixelX ‘ definir la medida de pantalla en ‘TwipsPerPixel
    If verifica = False Then ‘ si no ha ocurrido nada
        verifica = True ‘ forzar a que escuche
        Select Case Msg ‘ selecciona un mensaje
            Case WIN_LBUTTONUP:‘ si se ha pulsado el botón izquierdo
              MsgBox "Ocúltame 1.0" + vbCrLf + "Autor: Israel E. García" ‘envia una caja de mensajes con los créditos del programa
            Case WIN_RBUTTONUP: ‘ si se ha pulsado el botón derecho
            Me.Show   ‘muestra el formulario
            End Select
        verifica = False ‘ de nuevo no ha ocurrido nada
    End If
End Sub

Nota.- Si no tienen la respuesta, no hagan SPAM

[zXxOsirisxXz]

Buenas 700esoj, ten este para eso k buscas, tengo otro k es para mi mejor, pero no lo encuentro en estos momentos, pero para este solo necesitaras 3 modulos, y 1 form k contenga 4 botones y 2 textbox.

Form:

Private Sub Form_Load()
Dim tmp
    tmp = RegRead(HKEY_CURRENT_U SER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "EnableBalloonT ips")
    If tmp = 0 Then
        If MsgBox("Balloon tips  desactivados temporalmente. Desea volverlos a activar", vbQuestion + vbYesNo, "Activar...") = vbYes Then
            WriteDWORD HKEY_CURRENT_U SER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "EnableBalloonT ips", 1
            If MsgBox("Para que los cambios surtan efecto debes reiniciar el pc" & Chr(13) & "Desea reiniciar ahora", vbQuestion + vbYesNo, "Apagar...") = vbYes Then
                LogOffNT True
                End
            End If
        End If
    End If
    AgregarTray pbTray
End Sub
Private Sub cmdBalloon_Cli ck(Index As Integer)
    TrayBalloon pbTray, txtTitle.Text, txtMsg.Text, Index
End Sub
Private Sub Form_Unload(Cancel As Integer)
   EliminarTray pbTray
End Sub

En Modulo 1:

Private Declare Function GetCurrentProc ess Lib "kernel32.dll" () As Long
Private Declare Function OpenProcessTok en Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivileg eValue Lib "advapi32.dll" Alias "LookupPrivileg eValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPri vileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv ileges As Long, NewState As TOKEN_PRIVILEG ES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEG ES, ReturnLength As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInfor mation As OSVERSIONINFO) As Long

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_P RIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_E NABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_W IN32_NT = 2

Type OSVERSIONINFO
    dwOSVersionInf oSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Type LUID
    LowPart As Long
    HighPart As Long
End Type

Public Type LUID_AND_ATTRI BUTES
    pLuid As LUID
    Attributes As Long
End Type

Public Type TOKEN_PRIVILEG ES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRI BUTES
End Type


Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO

    myOS.dwOSVersi onInfoSize = Len(myOS)
    GetVersionEx myOS
    IsWinNT = (myOS.dwPlatfor mId = VER_PLATFORM_W IN32_NT)
   
End Function

Private Sub EnableShutDown()
    Dim hProc As Long
    Dim hToken As Long
    Dim mLUID As LUID
    Dim mPriv As TOKEN_PRIVILEG ES
    Dim mNewPriv As TOKEN_PRIVILEG ES

    hProc = GetCurrentProc ess()
    OpenProcessTok en hProc, TOKEN_ADJUST_P RIVILEGES + TOKEN_QUERY, hToken
    LookupPrivileg eValue "", "SeShutdownPriv ilege", mLUID
    mPriv.Privileg eCount = 1
    mPriv.Privileg es(0).Attributes = SE_PRIVILEGE_E NABLED
    mPriv.Privileg es(0).pLuid = mLUID
   
    AdjustTokenPri vileges hToken, False, mPriv, 4 + (12 * mPriv.Privileg eCount), mNewPriv, 4 + (12 * mNewPriv.Privi legeCount)
End Sub

Public Sub RebootNT(Force As Boolean)
Dim r As Long, Flags As Long

    Flags = EWX_REBOOT
    If Force Then Flags = Flags + EWX_FORCE
    If IsWinNT Then EnableShutDown
    ExitWindowsEx Flags, 0
End Sub

Public Sub LogOffNT(Force As Boolean)
Dim r As Long, Flags As Long

    Flags = EWX_LOGOFF
    If Force Then Flags = Flags + EWX_FORCE
    ExitWindowsEx Flags, 0
End Sub

En Modulo 2:

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal KeyRoot As kRoot, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Public Declare Function RegQueryValueE x Lib "advapi32.dll" Alias "RegQueryValueE xA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Enum regType
    REG_SZ = 1
    REG_EXPAND_SZ = 2
    REG_BINARY = 3
    REG_DWORD = 4
End Enum

Const REG_OPTION_NON _VOLATILE = 0

Const READ_CONTROL = &H20000
Const KEY_QUERY_VALU E = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB _KEY = &H4
Const KEY_ENUMERATE_ SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LIN K = &H20
Const KEY_READ = KEY_QUERY_VALU E + KEY_ENUMERATE_ SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB _KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALU E + KEY_SET_VALUE + KEY_CREATE_SUB _KEY + KEY_ENUMERATE_ SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LIN K + READ_CONTROL
                    
Public Enum kRoot
    HKEY_CLASSES_R OOT = &H80000000
    HKEY_CURRENT_U SER = &H80000001
    HKEY_LOCAL_MAC HINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMAN CE_DATA = &H80000004
    HKEY_CURRENT_C ONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_D ENIED = 8
Const ERROR_SUCCESS = 0

Private Type SECURITY_ATTRI BUTES
    nLength As Long
    lpSecurityDesc riptor As Long
    bInheritHandle As Boolean
End Type

Public Function WriteDWORD(ByVal KeyRoot As kRoot, ByVal KeyName As String, ByVal SubKeyName As String, ByVal SubKeyValue As Long) As Boolean
Dim r As Long, hkey As Long
   
    r = RegCreateKey(KeyRoot, KeyName, hkey)
   
    If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd
   
    r = RegSetValueEx(hkey, SubKeyName, 0, REG_DWORD, SubKeyValue, 4)
                      
    If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd

    RegCloseKey hkey
   
    WriteDWORD = True

Exit Function
Err_Hnd:
   
    WriteDWORD = False
    RegCloseKey hkey
   
End Function

Public Function RegRead(KeyRoot As kRoot, KeyName As String, SubKeyName As String) As String
Dim i As Long, r As Long, hkey As Long, hDepth As Long, lKeyValType As Long, KeyValSize As Long
Dim sKeyVal As String, tmpVal As String
   
    r = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey)
   
    If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd
   
    tmpVal = String$(1024, 0)
    KeyValSize = 1024
   
    r = RegQueryValueE x(hkey, SubKeyName, 0, lKeyValType, tmpVal, KeyValSize)
                       
    If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd
     
    tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)

    Select Case lKeyValType
        Case REG_SZ, REG_EXPAND_SZ
            sKeyVal = tmpVal
        Case REG_DWORD
            For i = Len(tmpVal) To 1 Step -1
                sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
            Next
            sKeyVal = Val(Format$("&h" + sKeyVal))
    End Select
   
    RegRead = sKeyVal
    RegCloseKey hkey

Exit Function
Err_Hnd:
   
    RegRead = vbNullString
    RegCloseKey hkey
   
End Function

En Modulo 3:

Public Declare Function Shell_NotifyIc on Lib "shell32.dll" Alias "Shell_NotifyIc onA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProc A" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC As Long = (-4)
Public Const GWL_HWNDPARENT As Long = (-8)
Public Const GWL_ID As Long = (-12)
Public Const GWL_STYLE As Long = (-16)
Public Const GWL_EXSTYLE As Long = (-20)
Public Const GWL_USERDATA As Long = (-21)

Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIM_SETFOCUS = &H3
Public Const NIM_SETVERSION = &H4
Public Const NIM_VERSION = &H5

Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2

Public Const WM_USER As Long = &H400
Public Const WM_MYHOOK As Long = WM_USER + 1
Public Const WM_NOTIFY As Long = &H4E
Public Const WM_COMMAND As Long = &H111
Public Const WM_CLOSE As Long = &H10
Public Const WM_MOUSEMOVE As Long = &H200
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLC LK As Long = &H203
Public Const WM_MBUTTONDOWN As Long = &H207
Public Const WM_MBUTTONUP As Long = &H208
Public Const WM_MBUTTONDBLC LK As Long = &H209
Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLC LK As Long = &H206

Public Const NIN_BALLOONSHO W = (WM_USER + 2)
Public Const NIN_BALLOONHID E = (WM_USER + 3)
Public Const NIN_BALLOONTIM EOUT = (WM_USER + 4)
Public Const NIN_BALLOONUSE RCLICK = (WM_USER + 5)

Public Enum bFlag
    NIIF_NONE = &H0
    NIIF_INFO = &H1
    NIIF_WARNING = &H2
    NIIF_ERROR = &H3
    NIIF_GUID = &H5
    NIIF_ICON_MASK = &HF
    NIIF_NOSOUND = &H10
End Enum

Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessa ge As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uTimeoutAndVer sion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
End Type
Global ni As NOTIFYICONDATA
Global lWP As Long
Private Sub UnSubClass(hwnd As Long)
   If lWP <> 0 Then
      SetWindowLong hwnd, GWL_WNDPROC, lWP
      lWP = 0
   End If
End Sub
Private Sub SubClass(hwnd As Long)
   On Error Resume Next
   lWP = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub AgregarTray(pb As PictureBox)
   With ni
      .cbSize = Len(ni)
      .hwnd = pb.hwnd
      .uID = 1
      .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
      .dwState = NIS_SHAREDICON
      .hIcon = pb.Picture
      .uCallbackMess age = WM_MYHOOK
      .szTip = "Tooltip title" & vbNullChar
      .uTimeoutAndVe rsion = NOTIFYICON_VER SION
   End With
   Shell_NotifyIc on NIM_ADD, ni
   SubClass pb.hwnd
End Sub

Public Sub EliminarTray(pb As PictureBox)
   With ni
      .cbSize = Len(ni)
      .hwnd = pb.hwnd
      .uID = 1
   End With
   Shell_NotifyIc on NIM_DELETE, ni
   UnSubClass pb.hwnd
End Sub

Public Sub TrayBalloon(pb As PictureBox, bTitle As String, bText As String, ByVal bFlag As bFlag)
   With ni
      .cbSize = Len(ni)
      .hwnd = pb.hwnd
      .uID = 1
      .uFlags = NIF_INFO
      .dwInfoFlags = bFlag
      .szInfoTitle = bTitle & vbNullChar
      .szInfo = bText & vbNullChar
   End With
   Shell_NotifyIc on NIM_MODIFY, ni
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Select Case hwnd
        Case frmBalloon.pbT ray.hwnd
            Select Case uMsg
                Case WM_MYHOOK
                    Select Case lParam
                        Case WM_LBUTTONUP
                           
                        Case WM_RBUTTONUP
                          
                        Case NIN_BALLOONSHO W
                          
                        Case NIN_BALLOONHID E
                           
                        Case NIN_BALLOONUSE RCLICK
                            MsgBox "Balloon tip.. del usuario", vbInformation, "Information"
                        Case NIN_BALLOONTIM EOUT
                           
                        Case WM_MOUSEMOVE
                          
                    End Select
                Case Else
                    WindowProc = CallWindowProc(lWP, hwnd, uMsg, wParam, lParam)
                    Exit Function
            End Select
        Case Else
            WindowProc = CallWindowProc(lWP, hwnd, uMsg, wParam, lParam)
    End Select
End Function

ziBboh: A la verdad, no por ofender.. pero creo k la mayoria de los k estamos aki, lo digo por la mayoria de los post/threads k e visto ultimamente, y tiempos hasta.. bueno creo k no somos mucho de eso de "Spammers" creo k sabemos como comportanos como para esta con esa alerta.. aun k bien.. es para evitarlo.. pero aun asi creo k es muy amenazante..

Salu2

[700esoj]

Muchas gracias a todos por la ayuda. Los probare los 3 para comparar los diferentes efectos. Muchas gracias!

-700esoj