RE:Como hacer un reproductor de videos en VB
Uhm.. esta pregunta es de hace casi 1 mes pero aqui esta la respuesta.. a medias
Este codigo abre un AVI y lo hace funcionar
Se requieren :
2 botones (filAVI y cmdEjecutar) y un textbox y el nombre del formulario picAVI
'Variables
Dim Ejecutar As Boolean
Dim Animacion As Long
Private Sub cmdEjecutar_Click()
'Si se esta ejecutando...
If Ejecutar Then
'Restablecer la etiqueta de cmdEjecutar
cmdEjecutar.Caption = "&Ejecutar"
'Parar la animacion
SendMessage Animacion, ACM_STOP, 0, 0
Ejecutar = False
Else
'Cambiar la eiqueta de cmdEjecutar por "Parar"
cmdEjecutar.Caption = "&Parar"
'Ejecutar la animacion
SendMessage Animacion, ACM_PLAY, -1, 0
Ejecutar = True
End If
End Sub
Private Sub filAVI_Click()
If Dir(Text1) = "" Then
MsgBox "El archivo no existe"
Exit Sub
End If
'Variable que contiene el nombre del AVI a ejecutar
Dim ArchivoAVI As String
'Quitar animacion previa si es que hay
If Animacion > 0 Then DestroyWindow Animacion
'Cambia la etiqueta del boton cmdEjecutar en caso de que
'se estuviese ejecutando una animacion antes...
cmdEjecutar.Caption = "&Ejecutar"
'Cambia la variable que indica si se esta ejecutando
'la animacion a False
Ejecutar = False
'ArchivoAVI toma la ruta completa del AVI
ArchivoAVI = Text1
Animacion = CreateWindowEx(WS_EX_TRANSPARENT, ANIMATE_CLASS, "", &H50000000 Or ACS_TRANSPARENT, picAVI.ScaleLeft, picAVI.ScaleTop, picAVI.ScaleWidth, picAVI.ScaleHeight, picAVI.hwnd, 0&, App.hInstance, ByVal 0&)
'Se abre la animacion...
SendMessage Animacion, ACM_OPEN, 0&, ByVal ArchivoAVI
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Form_Load()
'Cambiando el Directorio para que muestres los AVI que
'acompañan al ejemplo
'filAVI.Path = App.Path
End Sub
' --------------------------------
En un modulo :
'Declaraciones API para el AVI
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const ANIMATE_CLASS = "SysAnimate32"
'Estilos de muestra de la animacion
Public Const WS_EX_TRANSPARENT = &H20&
Public Const ACS_TRANSPARENT = &H2&
'La animacion empieza automaticamente
Public Const ACS_AUTOPLAY = &H4&
'Constantes de control de la animacion
Public Const WM_USER = &H400&
'Constante usada para Abrir la animacion
Public Const ACM_OPEN = WM_USER + 100
'Constante usada para Ejecutar la animacion
Public Const ACM_PLAY = WM_USER + 101
'Constante usada para Parar la animacion
Public Const ACM_STOP = WM_USER + 102