Autor
|
Tema: Necesito el archivo NotifyIcon.OCX (Leído 2,841 veces)
|
Blasito48
Desconectado
Mensajes: 1
|
Cordial Saludo, Tengo una aplicacion de VB y cuando la ejecuto me dice que falta este archivo NotifyIcon.OCX necesito saber si alguien tiene este archivo para ver si me lo puede mandar por http://www.yousendit.com/ Agradezco de antemano. Ing. Bladimir Silva T.
|
|
« Última modificación: 18 Octubre 2007, 04:09 am por sirdarckcat »
|
En línea
|
|
|
|
Tengu
Desconectado
Mensajes: 330
2+1 = 1 , despues de todo , tdo es relativo
|
sera lo mismo? http://200.43.68.137:99/HOOSoftNotifyIcon.rary sino tbn tengo un modulo con el mismo nombre q no se de donde lo saque jej modulo bas code: [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 * 128 dwState As Long dwStateMask As Long szInfo As String * 256 uTimeout As Long szInfoTitle As String * 64 dwInfoFlags As Long End Type
Dim nf_IconData As NOTIFYICONDATA
Const NOTIFYICON_VERSION = 3 Const NOTIFYICON_OLDVERSION = 0
Const NIM_ADD = &H0 Const NIM_MODIFY = &H1 Const NIM_DELETE = &H2
Const NIM_SETFOCUS = &H3 Const NIM_SETVERSION = &H4
Const NIF_MESSAGE = &H1 Const NIF_ICON = &H2 Const NIF_TIP = &H4
Const NIF_STATE = &H8 Const NIF_INFO = &H10
Const NIS_HIDDEN = &H1 Const NIS_SHAREDICON = &H2
Public Enum Mensage NIIF_NONE = &H0 NIIF_INFO = &H1 NIIF_WARNING = &H2 NIIF_ERROR = &H3 NIIF_GUID = &H4 End Enum
Const WM_MOUSEMOVE = &H200 Const WM_LBUTTONDOWN = &H201 Const WM_LBUTTONUP = &H202 Const WM_LBUTTONDBLCLK = &H203 Const WM_RBUTTONDOWN = &H204 Const WM_RBUTTONUP = &H205 Const WM_RBUTTONDBLCLK = &H206 Const IDANI_OPEN = &H1 Const IDANI_CLOSE = &H2 Const IDANI_CAPTION = &H3 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
Const SW_SHOWNORMAL = 1
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function DrawAnimatedRects Lib "user32" (ByVal hwnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Function ActivateWindows(Caption As String) As Boolean Dim Handle As Long Handle = FindWindow("ThunderRT6FormDC", Caption)
Dim rDest As RECT GetWindowRect Handle, rDest DrawAnimatedRects Handle, IDANI_CLOSE Or IDANI_CAPTION, GetTrayRec, rDest ShowWindow Handle, SW_SHOWNORMAL DoEvents ActivateWindows = SetForegroundWindow(Handle)
End Function
Private Function GetTrayRec() As RECT Dim Handle As Long, ScreenWidth As Long, ScreenHeight As Long
Handle = FindWindow("Shell_TrayWnd", vbNullString) Handle = FindWindowEx(Handle, ByVal 0&, "TrayNotifyWnd", vbNullString)
If GetWindowRect(Handle, GetTrayRec) = 0 Then ScreenWidth = Screen.Width / Screen.TwipsPerPixelX ScreenHeight = Screen.Height / Screen.TwipsPerPixelY SetRect GetTrayRec, ScreenWidth, ScreenHeight, ScreenWidth, ScreenHeight End If
End Function Public Sub AnimateWindow(Frm As Form) Dim rDest As RECT, ScreenWidth As Long, ScreenHeight As Long
GetWindowRect Frm.hwnd, rDest Frm.Visible = False DrawAnimatedRects Frm.hwnd, IDANI_CLOSE Or IDANI_CAPTION, rDest, GetTrayRec
End Sub Public Sub AgregarIcono(ico As StdPicture, Handle As Long) With nf_IconData .cbSize = Len(nf_IconData) .hwnd = Handle .uID = vbNull .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP .uCallbackMessage = WM_MOUSEMOVE .hIcon = ico .szTip = App.EXEName & vbNullChar .dwState = 0 .dwStateMask = 0 End With
Shell_NotifyIcon NIM_ADD, nf_IconData 'NIM_ADD Agregamos el icono a la barra End Sub Public Sub MostrarGlobo(Texto As String, Tipo As Mensage) With nf_IconData .szInfo = Texto & Chr(0) 'Texto del globo .szInfoTitle = App.EXEName & Chr(0) 'Titulo del globo .dwInfoFlags = Tipo 'Selecionamos el tipo globo, de informacion en este caso)(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR) .uTimeout = 1 'Tiempo de espera (millisec.) End With Shell_NotifyIcon NIM_MODIFY, nf_IconData 'Activamos el globo End Sub
Public Sub CambiarIcono(ico As StdPicture) nf_IconData.hIcon = ico nf_IconData.szInfo = Chr(0)
Shell_NotifyIcon NIM_MODIFY, nf_IconData 'Activamos el globo End Sub
Public Sub QuitarIcono() Shell_NotifyIcon NIM_DELETE, nf_IconData 'NIM_DELETE Quitar el icono de la barra End Sub Public Sub Eventos(X As Single) Dim lMsg As Long Dim sFilter As String lMsg = X / Screen.TwipsPerPixelX Select Case lMsg 'you can play with other events as I did as per your use Case WM_LBUTTONDOWN Case WM_LBUTTONUP FrmMain.PopupMenu FrmMain.MnuPopUp Case WM_LBUTTONDBLCLK ActivateWindows FrmMain.Caption Case WM_RBUTTONDOWN Case WM_RBUTTONUP FrmMain.PopupMenu FrmMain.MnuPopUp 'PopupMenu MnuIcono Case WM_RBUTTONDBLCLK End Select End Sub
/code]
es todo lo k tengo man
|
|
|
En línea
|
Encuentros por Video y Chat !!
|
|
|
CeLaYa
Desconectado
Mensajes: 543
|
Tengu ..::Fireb0y::.. tengo una duda, ya probe el código del módulo, pero cuando se agrega el icono a la bandeja y paso el mouse por encima, el icono desaparece... tendras algun ejemplo?, para ver si estoy haciendo algo mal...
|
|
« Última modificación: 17 Octubre 2007, 19:21 pm por CeLaYa »
|
En línea
|
"La soledad es el elemento de los grandes talentos". Cristina de Suecia (1626-1689) Reina de Suecia.
|
|
|
nhaalclkiemr
Desconectado
Mensajes: 1.678
Máximo exponente 9DB9F1AEED2FADBDE 997BBE20FEDA92
|
Eso es pork cerraste la aplicación sin ejecutar antes la función QuitarIconoY no hace falta un control, con saber usar un poco la API ya está, aqui os pongo un ejemplo de la API-Guide: 'Download the full source+pictures+... at http://kpdteam.hypermart.net/download/tray.zip 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 NIF_MESSAGE = &H1 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_RBUTTONUP = &H205 Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean Dim TrayI As NOTIFYICONDATA Private Sub Form_Load() TrayI.cbSize = Len(TrayI) 'Set the window's handle (this will be used to hook the specified window) TrayI.hWnd = pichook.hWnd 'Application-defined identifier of the taskbar icon TrayI.uId = 1& 'Set the flags TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE 'Set the callback message TrayI.ucallbackMessage = WM_LBUTTONDOWN 'Set the picture (must be an icon!) TrayI.hIcon = imgIcon(2).Picture 'Set the tooltiptext TrayI.szTip = "Recent" & Chr$(0) 'Create the icon Shell_NotifyIcon NIM_ADD, TrayI Me.Hide End Sub Private Sub Form_Unload(Cancel As Integer) 'remove the icon TrayI.cbSize = Len(TrayI) TrayI.hWnd = pichook.hWnd TrayI.uId = 1& Shell_NotifyIcon NIM_DELETE, TrayI End End Sub Private Sub mnuPop_Click(Index As Integer) Select Case Index Case 0 MsgBox "KPD-Team 1998" + Chr$(13) + "URL: http://www.allapi.net/" + Chr$(13) + "E-Mail: KPDTeam@Allapi.net", vbInformation + vbOKOnly Case 2 Unload Me End Select End Sub Private Sub pichook_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Msg = X / Screen.TwipsPerPixelX If Msg = WM_LBUTTONDBLCLK Then 'Left button double click mnuPop_Click 0 ElseIf Msg = WM_RBUTTONUP Then 'Right button click Me.PopupMenu mnuPopUp End If End Sub Private Sub Timer1_Timer() Static Tek As Integer 'Animate the icon Me.Icon = imgIcon(Tek).Picture TrayI.hIcon = imgIcon(Tek).Picture Tek = Tek + 1 If Tek = 3 Then Tek = 0 Shell_NotifyIcon NIM_MODIFY, TrayI End Sub
El timer ews por si kereis poner un icono animado... y por cierto, ese code usa un picture box desde el que carga la imgen, no hace falta, se puede uno amañar para hacerlo sin el picturebox Saludos
|
|
|
En línea
|
StasFodidoCrypter 1.0 - 100% (old) | StasFodidoCrypter 2.0 - 85% (deserted) | Fire AV/FW-Killer - 97% (deserted) | R-WlanXDecrypter 1.0- 100% |
|
|
|
CeLaYa
Desconectado
Mensajes: 543
|
Eso es pork cerraste la aplicación sin ejecutar antes la función QuitarIcono
no, pero eso pasa teniendo la aplicación en ejecución, no se porque al poner el icono y pasarle el mouse, el icono desaparece, pero la aplicacion sique activa
|
|
|
En línea
|
"La soledad es el elemento de los grandes talentos". Cristina de Suecia (1626-1689) Reina de Suecia.
|
|
|
|
|