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:
CitarDim 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...
jeje esta suabe
sencillo pero inovador bueno al menos a mi no se me avia ocurrido jeje
hola si les gusta algo un poquito mas rebuscado
en un 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
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
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
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??
Form3.Show vbModall
Asi,espero te sirva.
Saludos.
no... si tengo otra ventana no se muestra... nadie sabe otra forma??
Creo Que esta es la solucion Este es tu Code y anexe lo que creo que querias jejeje :xD
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
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 :xD
ay me dices si te sirvio ::)
siii de 10! muchisimas gracias!!!