Solo se nesesita un modulo
No requiere Formulario
No tiene dependencias
Por ende quite el WindowsMediaPlayer y ya trabaja sobre MCI
Al estar COMPILADO y al Arrastrar un Archivo de Música, Video o Imagen se reproduce (OJO las imagenes no tardan mucho en cerrar Sorry jem)
Al termino de la Reproducción del Archivo se Cierra Automaticamente.
Source Solo se nesesita un Modulo
Código
Post Original
Option Explicit 'By Leandro Ascierto 'Modificado por BlackZeroX (Parte MCI) 'Corrección Api SystemParametersInfo 'Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, byval lpvParam As Any, ByVal fuWinIni As Long) As Long Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long Private Declare Function SetSysColors Lib "user32.dll" (ByVal nChanges As Long, ByRef lpSysColor As Long, ByRef lpColorValues As Long) As Long Private Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long 'Declraciones Anidadas Private Const SPI_GETWORKAREA = 48 Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 'Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 'Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function WaitMessage Lib "user32" () As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Fin Private Const COLOR_BACKGROUND As Long = 1 Private Const SPIF_UPDATEINIFILE As Long = &H1 Private Const SPIF_SENDWININICHANGE As Long = &H2 Private Const SPI_GETDESKWALLPAPER As Long = 115 Private Const SPI_SETDESKWALLPAPER As Long = 20 Dim lOldColor As Long Dim sOldWallPaper As String Sub Main() 'Sustitución de la Dependencia WindowsMediaPlayer por el MCI Dim T_rect As RECT Dim data As String data = Space(255) mciSendString "close all ", 0, 0, 0 'Activa la linea si Aun no lo compilas mciSendString "open " & Command$ & " alias MedioX style popup ", 0, 0, 0 SystemParametersInfo SPI_GETWORKAREA, 0, T_rect, 0 mciSendString "put MedioX window at 0 0 1 1 ", 0, 0, 0 mciSendString "play MedioX ", 0, 0, 0 mciSendString "window MedioX state hide", 0, 0, 0 mciSendString "put MedioX window at 0 0 " & Int(T_rect.Right - T_rect.Left) & " " & Int(T_rect.Bottom - T_rect.Top + 40) & " ", 0, 0, 0 'ShowWindow GetActiveWindow, 0 '-------------------------------------- 'Source Leandro Ascierto sOldWallPaper = Space(255) 'SystemParametersInfo SPI_GETDESKWALLPAPER, 255, sOldWallPaper, 0 'Original SystemParametersInfo SPI_GETDESKWALLPAPER, 255, ByVal sOldWallPaper, 0 'Corrección lOldColor = GetSysColor(COLOR_BACKGROUND) Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, " ", 0) Call SetSysColors(1, COLOR_BACKGROUND, RGB(16, 0, 16)) Do mciSendString "status MedioX mode", data, 255, 0 If Not Left(data, 7) = "playing" Then Exit Do End If DoEvents Debug.Print Left(data, 7) WaitMessage Loop Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, sOldWallPaper, 0) Call SetSysColors(1, COLOR_BACKGROUND, lOldColor) End Sub