| 
	
		|  Autor | Tema: desplazar form estilo msn  (Leído 3,229 veces) |  
	| 
			| 
					
						| vivachapas 
								 
								
								 Desconectado 
								Mensajes: 612
								
								   | 
 
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...
 
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  |  |  | 
			| 
					
						| LeandroA | 
 
hola si les gusta algo un poquito mas rebuscado  en un modulo Option ExplicitPrivate 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 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| vivachapas 
								 
								
								 Desconectado 
								Mensajes: 612
								
								   | 
 
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??
 |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| Jareth 
								 
								
								 Desconectado 
								Mensajes: 334
								
								   | 
 
Asi,espero te sirva. Saludos. |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| vivachapas 
								 
								
								 Desconectado 
								Mensajes: 612
								
								   | 
 
no... si tengo otra ventana no se muestra... nadie sabe otra forma?? |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  | 
			| 
					
						| billarxxx 
								
								 Desconectado 
								Mensajes: 43
								
								 
								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
 
 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   |  
						| 
								|  |  
								|  |  En línea | 
 
  Quieren correr y no saben ni caminar,mejor tomen un taxi  |  |  |  | 
			| 
					
						| vivachapas 
								 
								
								 Desconectado 
								Mensajes: 612
								
								   | 
 
siii de 10! muchisimas gracias!!! |  
						| 
								|  |  
								|  |  En línea | 
 
 |  |  |  |  |  
 
	
 
 
				
					
						| Mensajes similares |  
						|  | Asunto | Iniciado por | Respuestas | Vistas | Último mensaje |  
						|   |   | Ubuntu va a desplazar a Windows en China Noticias
 | wolfbcn | 2 | 3,037 |  23 Marzo 2013, 00:50 am por OmarHack
 |  
						|   |   | Editar estilo de plugin Contact Form 7 con tema CSS Desarrollo Web
 | Danick | 0 | 2,628 |  27 Mayo 2013, 22:02 pm por Danick
 |  
						|   |   | Problema al desplazar el EOF Análisis y Diseño de Malware
 | Binary_Death | 0 | 2,151 |  29 Agosto 2013, 20:40 pm por Binary_Death
 |  
						|   |   | Desplazar picture box entre varios form Programación Visual Basic
 | coronelo | 0 | 1,842 |  16 Diciembre 2013, 01:17 am por coronelo
 |  
						|   |   | [Batch] Arrastrar Y Desplazar Scripting
 | KZN | 3 | 3,258 |  2 Abril 2014, 16:30 pm por Eleкtro
 |    |