Título: Crear Globo en la barra del reloj Publicado por: HJZR4 en 5 Octubre 2007, 20:59 pm Hola.
Alguien puede ayudarme a crear el globo este de Windows que sale en la zona de notificación? El de la barra del reloj. Gracias de antemano. Título: Re: Crear Globo en la barra del reloj Publicado por: zXxOsirisxXz en 5 Octubre 2007, 21:25 pm d k globo hablas?
Título: Re: Crear Globo en la barra del reloj Publicado por: HJZR4 en 5 Octubre 2007, 21:35 pm Mas cosas... El mensaje este que estorba siempre de Windows de que no tienes un antivirus y tal... abajo a la derecha.
Ahora? XD Título: Re: Crear Globo en la barra del reloj Publicado por: Sancho.Mazorka en 5 Octubre 2007, 22:46 pm El Ballon Tool Tip Text decis, entra ACA (http://www.aldeamix.com/ocio/harryx/mods/index.html) (que es mi super web :xD esta re vacia la pobre porque el host es horrible) y bajate el primero modSystray.zip, lo programe yo al modulo, tiene una ayuda en la cabecera de como usar todos los comandos, cualquier cosa postea aca que yo te respondo ;)
Sancho.Mazorka :¬¬ Título: Re: Crear Globo en la barra del reloj Publicado por: zXxOsirisxXz en 5 Octubre 2007, 22:50 pm Te pondre este codigo hecho de otra persona.
Pero de ahi ps, partes, y haces tu propio globo, y tu propio simbolo. Necesitas. 4 Commands Buttons. 2 TextBox. 1 Pb Tray (No importante >.>) En Form Citar Private Sub Form_Load() Dim tmp tmp = RegRead(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "EnableBalloonTips") If tmp = 0 Then If MsgBox("Balloon tips desactivados temporalmente.Desea volverlos a activar", vbQuestion + vbYesNo, "Activar...") = vbYes Then WriteDWORD HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "EnableBalloonTips", 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_Click(Index As Integer) TrayBalloon pbTray, txtTitle.Text, txtMsg.Text, Index End Sub Private Sub Form_Unload(Cancel As Integer) EliminarTray pbTray End Sub Private Sub pbTray_Click() End Sub Modulo 1. (LogOff) Citar Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, 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 lpVersionInformation 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_PRIVILEGES = &H20 Private Const TOKEN_QUERY = &H8 Private Const SE_PRIVILEGE_ENABLED = &H2 Private Const ANYSIZE_ARRAY = 1 Private Const VER_PLATFORM_WIN32_NT = 2 Type OSVERSIONINFO dwOSVersionInfoSize 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_ATTRIBUTES pLuid As LUID Attributes As Long End Type Public Type TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES End Type Public Function IsWinNT() As Boolean Dim myOS As OSVERSIONINFO myOS.dwOSVersionInfoSize = Len(myOS) GetVersionEx myOS IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT) End Function Private Sub EnableShutDown() Dim hProc As Long Dim hToken As Long Dim mLUID As LUID Dim mPriv As TOKEN_PRIVILEGES Dim mNewPriv As TOKEN_PRIVILEGES hProc = GetCurrentProcess() OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID mPriv.PrivilegeCount = 1 mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED mPriv.Privileges(0).pLuid = mLUID AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount) 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 Modulo 2. (RedEdit) Citar 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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (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_VALUE = &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_LINK = &H20 Const KEY_READ = KEY_QUERY_VALUE + 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_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL Public Enum kRoot HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_PERFORMANCE_DATA = &H80000004 HKEY_CURRENT_CONFIG = &H80000005 HKEY_DYN_DATA = &H80000006 End Enum Const ERROR_NONE = 0 Const ERROR_BADKEY = 2 Const ERROR_ACCESS_DENIED = 8 Const ERROR_SUCCESS = 0 Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor 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 = RegQueryValueEx(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 Modulo 3. (Tray o "Simbolo en barra reloj") Citar Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (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 "CallWindowProcA" (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_LBUTTONDBLCLK As Long = &H203 Public Const WM_MBUTTONDOWN As Long = &H207 Public Const WM_MBUTTONUP As Long = &H208 Public Const WM_MBUTTONDBLCLK As Long = &H209 Public Const WM_RBUTTONDOWN As Long = &H204 Public Const WM_RBUTTONUP As Long = &H205 Public Const WM_RBUTTONDBLCLK As Long = &H206 Public Const NIN_BALLOONSHOW = (WM_USER + 2) Public Const NIN_BALLOONHIDE = (WM_USER + 3) Public Const NIN_BALLOONTIMEOUT = (WM_USER + 4) Public Const NIN_BALLOONUSERCLICK = (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 uCallbackMessage As Long hIcon As Long szTip As String * 128 dwState As Long dwStateMask As Long szInfo As String * 256 uTimeoutAndVersion 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 .uCallbackMessage = WM_MYHOOK .szTip = "Tooltip title" & vbNullChar .uTimeoutAndVersion = NOTIFYICON_VERSION End With Shell_NotifyIcon 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_NotifyIcon 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_NotifyIcon 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.pbTray.hwnd Select Case uMsg Case WM_MYHOOK Select Case lParam Case WM_LBUTTONUP Case WM_RBUTTONUP Case NIN_BALLOONSHOW Case NIN_BALLOONHIDE Case NIN_BALLOONUSERCLICK MsgBox "Balloon tip.. del usuario", vbInformation, "Information" Case NIN_BALLOONTIMEOUT 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 Es todo, creok de ahi podras hacerlo como kieras. Io ise el mio de ahi ^^ Salu2 |