Mensajes

en elvento Query Unload del form, checa de que forma se cierra. y adaptas este code a tu comodidad:
http://foro.elhacker.net/programacion_vb/efecto_minimizar_al_systray_con_drawanimatedrect_shellnoty-t284088.0.html

http://foro.elhacker.net/programacion_vb/tutorial_del_control_winsock-t75832.0.html

bueno, este code lo hize el 14 de febrero(domingo), no mas porque si (no tenia nada que hacer, estoy solo como perro, jaja).
la funcion convierte el Texto a la base en la que se especifica (2 para binario, 16 para hexadecima, Etc), le puse un limite de base (35) porque se acabaron las letras del abecedario y no me parecio ponerles los valores despues de la 'Z'. El code quiza se puede optimizar, pero no he tenido tiempo de checkarlo (por las tareas, el servicio social, etc).

Código [Seleccionar] Expandir

'Autor: Xmbeat (JHCC)
'e-mail: xmbeat:-com, xmbeat@yahoo.com
'Fecha: 14 de Febrero del 2010
'Descripcion: Algoritmo para convertir el valor de la tabla _
asii/ansi (255) a otro sistema de base y viceversa
'You can distribute the code freely without eliminating these commentaries
'0x35 = 232W0W3G363C0W1Q152T36373G0W2R352U0W2A2R3A3B2V160W3B2Y2V350D0A0W0W1W2R33330W2D3C2T320W150Y273G0W1X302T320Y190W2J363C160D0A1Y333A2V0D0A0W0W1W2R33330W2E2Y2R35323A0W152036390W2C2V2R2U0W3B2Y2V0W2T3634342V353B3A160D0A1Y352U0W232W


'StringToBase Function:
'Strings: Cadena de texto la cual se desea toString/detoString
'toString: Valor Booleano, cuando es seteado a True Convierte el Texto a la Base, _
           Cuando esta en False se hace lo opuesto
'Base: Valor Byte que indica la base de conversion, si la base  tiene mas de 1 digito _
       se convierte en Alfanumerico. Los valores para Base deben ser mayor que 1 y _
       menor a 36 (solo se usa el Abecedario (A-Z) para alfanumerico)
Private Function StringToBase(Strings As String, Optional toString As Boolean = False, _
Optional Base As Byte = 2) As String
Dim I           As Long
Dim NS          As String
Dim TS          As String
Dim CT          As Integer
Dim E           As Integer
Dim Limit       As Integer
Dim Rest        As Integer
Dim toBase      As Integer
On Error GoTo fallo
If Base > 35 Then Err.Raise 6, , "La Base no puede ser mayor a 35"
If Base < 2 Then Err.Raise 6, , "La Base no puede ser menor a 2"
Rest = 256
Do Until Rest <= 1
   Limit = Limit + 1
   Rest = Rest \ Base
Loop
For I = 1 To Len(Strings) Step IIf(toString = True, Limit, 1)
   NS = ""
   CT = IIf(toString, 0, Asc(Mid(Strings, I, 1)))
   For E = 1 To Limit
       If toString Then
           If Len(Mid(Strings, I)) < Limit Then Exit For
           NS = Mid(Mid(Strings, I, Limit), Limit + 1 - E, 1)
           If IsNumeric(NS) = False Then NS = CStr(Asc(NS) - 55)
           CT = CT + Val(NS) * Base ^ (E - 1)
       Else
           toBase = CT Mod Base
           If toBase < 10 Then
               NS = CStr(toBase) & NS
           Else
               NS = Chr$(55 + toBase) & NS
           End If
           
           CT = CT \ Base
       End If
   Next
   TS = TS & IIf(toString, Chr(CT), NS)
Next
StringToBase = TS
Exit Function
fallo:
If Err.Number = 6 Then
   Err.Raise 6, , Err.Description
   Exit Function
End If
Err.Raise 1, , "El Texto no esta codificado con la base " _
           & Base & "  y por lo tanto no se puede DetoString"

End Function

Private Sub Form_Load()
Const Texto As String = "by xmbeat"
Dim Binario As String
Dim Hexa As String
AutoRedraw = True
Binario = StringToBase(Texto)
Hexa = StringToBase(Texto, , 16)
Print Binario
Print Hexa
Print StringToBase(Hexa, True, 16)
End Sub

espero funcione con los commond Dialog
gracias.. Sin resentimientos?

tranquilo wey que no es para que te molestes!!


es mas, si te hace sentir bien retiro lo dicho, no vengo a pelear, uno viene aprender, ojalá sepas entender

me encataria que me dieras un ejemplo

es decir que si por ejemplo, usé el API CreateWindowEx o el Controls.Add para crearlo. como puedo darles eventos? o no se puede?

En eso tienes toda la razon, en cuanto a seguridad creo que no

bueno, he visto que algunos de aqui usan esto para sus aplicaciones, pero yo solo le agregué un "efecto" mas   para que se vea como el original de otras aplicaciones, como el Ares u otras babosadas....

Código [Seleccionar] Expandir


'insertar un command button
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
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

Private Const NOTIFYICON_VERSION = 3
Private Const NOTIFYICON_OLDVERSION = 0
 
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
 
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
 
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
 
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
 
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2
 
Private Const NIIF_NONE = &H0
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_INFO = &H1
Private Const NIIF_GUID = &H4
 
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206

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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Sub MinimizeToTray(Poner As Boolean, Optional Titulo As String, _
Optional Contenido As String, Optional ToolTip As String)
On Error Resume Next
Dim SisIcon As Long
Dim TrW As Long
Dim sRect As RECT
Dim dRect As RECT
Static Systray As NOTIFYICONDATA
With Systray
       .cbSize = Len(Systray)
       .hwnd = Me.hwnd
       .uID = vbNull
       .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
       .uCallbackMessage = WM_MOUSEMOVE
       .hIcon = Me.Icon
       .dwStateMask = 0
       .szTip = ToolTip & Chr(0)
       .dwState = &H2
       .dwStateMask = 0
       .szInfo = Contenido & Chr(0)
       .szInfoTitle = Titulo
       .dwInfoFlags = NIIF_INFO
       .uTimeout = 100
 End With
App.TaskVisible = Not (Poner)
SisIcon = FindWindow("Shell_TrayWnd", "") 'ENCONTRAMOS LA BARRA DE TAREAS
TrW = FindWindowEx(SisIcon, ByVal 0&, "TrayNotifyWnd", vbNullString) 'ENCONTRAMOS _
EL AREA DE NOTYCACIONES
GetWindowRect TrW, sRect 'Obtenemos la posicion del AREA
sRect.Right = sRect.Left
sRect.Bottom = sRect.Top
GetWindowRect Me.hwnd, dRect
'Obtenemos la posicion  de nuestro Form
'Otra forma >>|
'SetRect dRect, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, _
'(Me.Left + Me.Width) / Screen.TwipsPerPixelX, (Me.Top + Me.Height) / Screen.TwipsPerPixelY
If Poner Then
Me.Visible = False
DrawAnimatedRects Me.hwnd, &H3, dRect, sRect
Shell_NotifyIcon NIM_ADD, Systray
Shell_NotifyIcon NIM_MODIFY, Systray
Else
DrawAnimatedRects Me.hwnd, &H3, sRect, dRect
Me.Visible = True
Shell_NotifyIcon NIM_DELETE, Systray
End If
End Sub

Private Sub Command1_Click()
MinimizeToTray True, "Algo por aqui", "Que coño me ves", "Tu mama se la come"
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Mensaje As Long
On Local Error Resume Next
If (ScaleMode = vbPixels) Then
   Mensaje = X
Else
   Mensaje = X / Screen.TwipsPerPixelX
End If
If Me.Visible = False Then
If Mensaje = WM_LBUTTONDBLCLK Then
MinimizeToTray False
ElseIf Mensaje = WM_RBUTTONDOWN Then
'aqui ponen algun menu que quieren que se muestre
End If
End If
End Sub




el code es seguro que ya lo sepan pero por si no

cuando se invoca esta api,  se le pasa como argumento la tecla virtual para corroborar si esta presionada, en caso de que sea asi, te devuelve un valor (no se cual).
el bucle lo hace para ir probando tecla por tecla a ver si esta presionada.

en  mi opinion el interval del timer ponlo en 1

http://msdn.microsoft.com/en-us/library/ms646293(VS.85).aspx