desplazar form estilo msn

[vivachapas]

bueno... hoy a pedido de un amigo jaja hice un codigo de como desplazar un form al estilo de la ventana de aviso de msn... el codigo es bastante sencillo...

solo necesita un timer:

Dim Cont As Long, Dire As Byte

Private Sub Form_Load()
Timer1.Interval = 10
Me.Left = 8000
Me.Top = 8500
Dire = 1
Cont = 0
End Sub

Private Sub Timer1_Timer()

If Dire = 1 Then
Me.Top = Me.Top - 50
Cont = Cont + 1
    If Cont = 50 Then
    Dire = 2
    Cont = 0
    End If
End If

If Dire = 2 Then
Cont = Cont + 1
    If Cont = 100 Then
    Dire = 3
    Cont = 0
    End If
End If

If Dire = 3 Then
Me.Top = Me.Top + 50
Cont = Cont + 1
    If Cont = 50 Then
    End
    End If
End If
End Sub

espero q a alguien le sea ultil...

[billarxxx]

jeje  esta suabe

sencillo pero inovador bueno al menos a mi no se me avia ocurrido jeje

[LeandroA]

hola si les gusta algo un poquito mas rebuscado

en un modulo

Código [Seleccionar] Expandir


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
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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public Posicion As Integer
Public m_Form As Form
Public m_FrmHeight As Long
Public m_Direccion As Boolean
Public m_Velosidad As Integer

Public Sub SlideForm(FRM As Form, Mostrar As Boolean, LEVEL As Byte, Optional velocidad As Integer = 50)
Dim Tamaño As Integer, hwnd As Long, res As Long, Rec As RECT

Set m_Form = FRM
m_Direccion = Mostrar
m_FrmHeight = FRM.Height
m_Velosidad = velocidad
hwnd = FindWindow("Shell_TrayWnd", "")
If hwnd > 0 Then
res = GetWindowRect(hwnd, Rec)
If res > 0 Then
Tamaño = CStr(Rec.Bottom - Rec.Top) * Screen.TwipsPerPixelY
If Rec.Left <= 0 And Rec.Top > 0 Then Posicion = 1
If Rec.Left > 0 And Rec.Top <= 0 Then Posicion = 2: Tamaño = (Rec.Right - Rec.Left) * 15
If Rec.Left <= 0 And Rec.Top <= 0 And Rec.Right < 600 Then Posicion = 3: Tamaño = Rec.Right * 15
If Rec.Left <= 0 And Rec.Top <= 0 And Rec.Right > 600 Then Posicion = 4
End If
Else
Posicion = 1
End If


If m_Direccion = True Then
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
End If

res = SetWindowPos(FRM.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
Call SetWindowLong(FRM.hwnd, GWL_EXSTYLE, GetWindowLong(FRM.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(FRM.hwnd, 0, LEVEL, LWA_ALPHA)
SetTimer FRM.hwnd, 0, 1, AddressOf TimerProc

End Sub
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
If m_Direccion = True Then
    m_Form.Height = m_Form.Height + m_Velosidad
    If Not Posicion = 4 Then m_Form.Top = m_Form.Top - m_Velosidad
    If m_Form.Height >= m_FrmHeight Then KillTimer m_Form.hwnd, 0
Else
    If m_Form.Height <= 520 Then
        KillTimer m_Form.hwnd, 0
        Unload m_Form
    Else
        m_Form.Height = m_Form.Height - m_Velosidad
        If Not Posicion = 4 Then m_Form.Top = m_Form.Top + m_Velosidad
    End If
End If
End Sub



y en el proyecto con dos formularios y en el form1 con dos botones

Código [Seleccionar] Expandir


Private Sub Command1_Click()
'200 es valor de transparencia si no se quiere poner 255
'100 es la velocidad en estiarse, mientras mas alto el valor mas rapido
SlideForm Form2, True, 200, 100
End Sub

'para ocultarla
Private Sub Command2_Click()
SlideForm Form2, False, 200, 100
End Sub


pd: tengo otro pero para usar multi hilo si les hace falta avisan
Saludos

[vivachapas]

me salio este problema... no se ve como se desplaza el form si tengo otra ventana abierta...
como puedo hacer a que quede siempre visible... o a que (en este caso el form3) se inicie adelante de todo??

[Jareth]

Código [Seleccionar] Expandir

Form3.Show vbModall
Asi,espero te sirva.
Saludos.

[vivachapas]

no... si tengo otra ventana no se muestra... nadie sabe otra forma??

[billarxxx]

Creo Que esta es la solucion Este es tu Code y anexe lo que creo que querias jejeje

Ay te va jejeje

y por su puesto se tiene que agregar el timer jejeje lo menciono por si alguien mas quiere hacer esto y  no se confunda jeje

Código [Seleccionar] Expandir

Option Explicit

Dim Cont As Long, Dire As Byte

Private Declare Function SetWindowPos Lib "user32" _
            (ByVal hWnd As Long, ByVal hWndREPLACEAfter As Long, _
            ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
            ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Sub Form_Load()
Timer1.Interval = 20
Me.Left = 14070
Me.Top = 15585
VentanaSiempreFregando Me.hWnd
Dire = 1
Cont = 0
End Sub

Private Sub Timer1_Timer()

If Dire = 1 Then
Me.Top = Me.Top - 50
Cont = Cont + 1
    If Cont = 50 Then
    Dire = 2
    Cont = 0
    End If
End If

If Dire = 2 Then
Cont = Cont + 1
    If Cont = 100 Then
    Dire = 3
    Cont = 0
    End If
End If

If Dire = 3 Then
Me.Top = Me.Top + 50
Cont = Cont + 1
    If Cont = 50 Then
    End
    End If
End If
End Sub
Public Sub VentanaSiempreFregando(hWnd As Long)
            SetWindowPos hWnd, HWND_TOPMOST, _
                        0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Public Sub VentanaNormal(hWnd As Long)
            SetWindowPos hWnd, HWND_NOTOPMOST, _
                        0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub


Quiero pensar que es lo que nesesitas por que la verdad no eh leido la opinion de los demas alamejor asta ya te lo postearon

ay me dices si te sirvio

[vivachapas]

siii de 10! muchisimas gracias!!!