sacado de un foro de visual, el cual no se cual era
Este código lo que hace es una que se despliegue una ventanita notificadora sobre el reloj estilo Msn Messenger o Norton Antivirus entre otros, no importa donde se encuentre la barra de herramientas, si en la parte superior o al costado, la ventana siempre aparece junto al reloj.
Agregar un modulo1, dos formularios (Form1 y Form2) y dentro del Form1 dos CommandButton(command1 y Command2)
En el modulo:
Option Explicit
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub SlideForm(FRM As Form, Direccion As Long)
Dim Posicion As Integer
Dim Tamaño As Integer
Dim hwnd As Long
Dim res As Long
Dim buffRECT As RECT
hwnd& = FindWindow("Shell_TrayWnd", "")
If hwnd > 0 Then
res = GetWindowRect(hwnd, buffRECT)
If res > 0 Then
Tamaño = CStr(buffRECT.Bottom - buffRECT.Top) * 15
If buffRECT.Left <= 0 And buffRECT.Top > 0 Then Posicion = 1
If buffRECT.Left > 0 And buffRECT.Top <= 0 Then Posicion = 2: Tamaño = (buffRECT.Right - buffRECT.Left) * 15
If buffRECT.Left <= 0 And buffRECT.Top <= 0 And buffRECT.Right < 600 Then Posicion = 3: Tamaño = buffRECT.Right * 15
If buffRECT.Left <= 0 And buffRECT.Top <= 0 And buffRECT.Right > 600 Then Posicion = 4
End If
Else
Posicion = 1
End If
res = SetWindowPos(FRM.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
If Direccion = 0 Then
FRM.Show
FRM.Height = 0
Select Case Posicion
Case 1
FRM.Move Screen.Width - FRM.Width, Screen.Height - FRM.Height - Tamaño
Case 2
FRM.Move Screen.Width - FRM.Width - Tamaño, Screen.Height - FRM.Height
Case 3
FRM.Move Tamaño, Screen.Height - FRM.Height
Case 4
FRM.Move Screen.Width - FRM.Width, Tamaño
End Select
Do Until FRM.Height = 3000 ' la altura que se quiera
DoEvents
FRM.Height = FRM.Height + 1
If Not Posicion = 4 Then FRM.Top = FRM.Top - 1
Loop
Else
Do Until FRM.Height = 520
DoEvents
FRM.Height = FRM.Height - 1
If Not Posicion = 4 Then FRM.Top = FRM.Top + 1
Loop
Unload FRM
End If
End Sub
Y en el Form1:
'para desplegar
Private Sub Command1_Click()
SlideForm Form2, 0
End Sub
'para ocultarla
Private Sub Command2_Click()
SlideForm Form2, 1
End Sub
'en fin , funciona bien
'sacado de www.canalvisualbasic.net
:-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X
esta bastante bien, gracias por el aporte.
gracias, alguien sabe donde puedo sacar el gif que aparece en la portada del messenger al iniciar la secion, ese el que gira mientras trata de conectarse...???
jocker
:-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X
hola el codigo de la ventana lo sacaste de www.canalvisualbasic.net
y es mio ;D
y la imagen gif que andan buscando
http://celularchat.unlugar.com/includes/Foto1.gif
Saludos
muy interesante el código, pero cuando lo probé al darle el boton aparecia el form2 encima dl reloj y seguidamente m daba un error...al final lo solucione con un "On error resume next" en el command1, pero alguien sabria decirme pq da ese error? saludos ;)!
gracias leandroA sos muy bueno e esto, no sabia que tambien andabas por aca tambien, muy bueno el programa, ya lo he estado usando... nos vemos
ah y gracias por el gif, lo estaba buscando... jejeje
jocker
:-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X :-X