el codigo es original de Leandro Ascierto solo cambie un poco este:
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
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
Post Original
Mostrar Mensajes
