Minizar form y ponerlo al lado del reloj

Iniciado por _CrisiS_, 1 Septiembre 2010, 03:45 AM

0 Miembros y 1 Visitante están viendo este tema.

_CrisiS_

Buenas otra dudilla =P, Como aria que por un boton se minise mi sistema  desaparesca la ventana del form para situarse al lado del reloj y al aserle doble clic se me abra asia un form ejemplo login


_katze_

#2
noc si te sirva man no son como los grandes codes que postean aki estos grandes !

Código (vb) [Seleccionar]
'esto va en un modulo.bas
'lo modifique y lo cree a mi gusto con funciones esta bn pero lo pueden modificar mas si kieren
'_k4tz3_ vb6.0
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
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
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_INFO = &H10
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public nID As NOTIFYICONDATA
Public Function CierraTray(frm As Form)
With nID
.cbSize = Len(nID)
.hwnd = frm.hwnd
.uId = 1&
End With
Shell_NotifyIcon NIM_DELETE, nID
End Function
Public Function showfrm(frm As Form)
   If frm.WindowState = 1 Then frm.WindowState = 0
   frm.Show
   End Function
Public Function tray(frm As Form, Title As String)
With nID
.cbSize = Len(nID)
.hwnd = frm.hwnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE Or NIF_INFO
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = frm.Icon
.szTip = Title & Chr(0) '& vbNullChar
.dwState = 0
.dwStateMask = 0
.szInfoTitle = "mensaje" & Chr(0)
.szInfo = "mensaje" & vbNullChar
.uTimeout = 1
End With
Shell_NotifyIcon NIM_ADD, nID
End Function




con esto seria mas o menos una forma de aplicarlo !!!
Código (vb) [Seleccionar]
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN      As Long = &HA1
Private Const HTCAPTION             As Long = 2

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 
   ReleaseCapture
   SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

  Dim lResult As Long
   Dim lMsg As Long

   If Me.ScaleMode = vbPixels Then
       lMsg = x
   Else
       lMsg = x / Screen.TwipsPerPixelX
   End If

   Select Case lMsg
       Case WM_RBUTTONUP
           lResult = SetForegroundWindow(Me.hwnd)
          Me.PopupMenu mmenutray 'click derecho en el systray llama al popumenu dado en parametro !
       Case WM_LBUTTONDBLCLK
           If Me.Visible = False Then
               Call showfrm(Me) ' llamamos al formulario llamando a showfrm!
                         
           End If
   End Select
   End Sub
'para llamar al systray cuando se minimized
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
           Call tray(Me, "hola")
           Me.Hide
       End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call CierraTray(Me)
end sub
'mas claro que el agua



_CrisiS_

xkiz > por alguna razon nunca puedo ver paginas de support.microsoft =S.

_katze_> no me funciono =S

xmbeat92

El hombre encuentra a Dios detrás de cada puerta que la ciencia logra abrir. -Einstein

xkiz ™

Cita de: _CrisiS_ en  1 Septiembre 2010, 06:47 AM
xkiz > por alguna razon nunca puedo ver paginas de support.microsoft =S.

pongo aca el code que muestra  Microsoft:

Código (vb) [Seleccionar]

'user defined type required by Shell_NotifyIcon API call
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

'constants required by Shell_NotifyIcon API call:
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
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201     'Button down
Public Const WM_LBUTTONUP = &H202       'Button up
Public Const WM_LBUTTONDBLCLK = &H203   'Double-click
Public Const WM_RBUTTONDOWN = &H204     'Button down
Public Const WM_RBUTTONUP = &H205       'Button up
Public Const WM_RBUTTONDBLCLK = &H206   'Double-click

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Public nid As NOTIFYICONDATA


Código (vb) [Seleccionar]

Private Sub Form_Load()
       'the form must be fully visible before calling Shell_NotifyIcon
Me.Show
Me.Refresh
With nid
    .cbSize = Len(nid)
    .hwnd = Me.hwnd
    .uId = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = Me.Icon
    .szTip = "Your ToolTip" & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'this procedure receives the callbacks from the System Tray icon.
Dim Result As Long
Dim msg As Long
'the value of X will vary depending upon the scalemode setting
If Me.ScaleMode = vbPixels Then
    msg = X
Else
    msg = X / Screen.TwipsPerPixelX
End If

Select Case msg
    Case WM_LBUTTONUP        '514 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hwnd)
         Me.Show
    Case WM_LBUTTONDBLCLK    '515 restore form window
         Me.WindowState = vbNormal
         Result = SetForegroundWindow(Me.hwnd)
         Me.Show
    Case WM_RBUTTONUP        '517 display popup menu
         Result = SetForegroundWindow(Me.hwnd)
         Me.PopupMenu Me.mPopupSys
End Select

End Sub

Private Sub Form_Resize()
'this is necessary to assure that the minimized window is hidden
If Me.WindowState = vbMinimized Then Me.Hide
End Sub

Private Sub Form_Unload(Cancel As Integer)
'this removes the icon from the system tray
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub mPopExit_Click()
'called when user clicks the popup menu Exit command
Unload Me
End Sub

Private Sub mPopRestore_Click()
'called when the user clicks the popup menu Restore command
Dim Result As Long
Me.WindowState = vbNormal
Result = SetForegroundWindow(Me.hwnd)
Me.Show
End Sub




_katze_

#6
hay te modifique mi code, lo saque de un soft que tenia y es por eso que te daba un error en el resise ! proba y copia y veras que funciona!!
tmb te dejo un ejemplo echo para que veas ! modifiques a gusto
http://www.sendspace.com/file/mp5lx3

_CrisiS_

=o vaya si funciono, solo un par de cosillas:
-Cuando se le haga doble clic seria bueno q desaparesca de la barra y vuelva como una ventana normal .

- Lo estoy pasando para vb net (que es donde lo nesesito , por q en el 6 salio =P), mi problema asta ahorita para migrarlo es en esta linea:

vb6> szTip As String * 128

vb net > Dim szTip As String * 128    // pero me marca error y dice se esperaba fin de la instruccion

_katze_

con mi code cada uno lo modifica a gusto! con lo que dices ni idea !nunca intente migrarlo para vb.net  :-X

ranslsad

Miren para ahorrar cantidad de codigo en sus formularios/modulos les dejo un UserControl que maneja esto a la perfeccion!

http://www.filefront.com/17305067/SysTray.rar

Espero que les sea de mas utilidad!, Es el que uso yo en mis aplicaciones.
Y tambien os da la posibilidad de enviar mensajes popupbaloon nose si algunos saben lo que es, compruebenlo!

Código (vb) [Seleccionar]

'Agregar Icono
SysTray1.AgregarIcono Me.Icon, "Nombre"
'qUITAR Icono
SysTray1.QuitarIcono

'Clickear en el icono
Private Sub SysTray1_MouseUp(Button As Integer)
PopupMenu MenuSystray
End Sub

'Minimizar Programa AL Tray
SysTray1.AnimateWindow Me

'Enviar Mensaje
systray1.mostrarglobo "Hola", ..., "titulo"


Salu2

Ranslsad