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




                          

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


                           

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 !