El siguiente módulo contiene funciones para la reproducción y grabación de
wav
Attribute VB_Name = "MóduloMci"
Option Explicit
Public Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function mciGetDeviceID Lib "winmm.dll" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
Public Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
Public 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
Public Declare Function midiOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function midiOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function waveInMessage Lib "winmm.dll" (ByVal hWaveIn As Long, ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
Dim Rs As String, cb As Long, s As Single
Public FicheroGrabación As String
Public Type lVolType
v As Long
End Type
Public Type VolType
lv As Integer
rv As Integer
End Type
Const Rapidito = &H4002&
Const SM_CXBORDER = 5
Const SM_CYBORDER = 6
Const VK_SNAPSHOT As Byte = &H2C
Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Const MCI_SET = &H80D
Const MCI_SET_DOOR_OPEN = &H100&
Public Sub Reproduce(Fichero As String)
Rs = Space(128): Dim Tipo As String, Dispositivo
parar
Tipo = UCase(Right(Canciones(CanciónActual).NombreCanción, 3))
If Tipo = "MID" Or Tipo = "RMI" Then Dispositivo = 1
If Tipo = "WAV" Then Dispositivo = 2
If Tipo = "MOD" Or Tipo = ".XM" Or Tipo = "S3M" Or Tipo = "MTM" Or Tipo = "669" Or Tipo = "MOL" Or Tipo = "OKT" Or Tipo = ".IT" Or Tipo = "FAR" Or Tipo = "WOW" Or Tipo = "NST" Or Tipo = "STM" Then Dispositivo = 3
Select Case Dispositivo
Case 1
mciSendString "open Sequencer!" & Fichero & " alias sound", Rs, 128, cb
Case 2
mciSendString "open WaveAudio!" & Fichero & " alias sound", Rs, 128, cb
Case 3
mciSendString "open M4W_MCI!" & Fichero & " alias sound", Rs, 128, cb
End Select
mciSendString "play sound", Rs, 128, cb
End Sub
Public Sub parar()
'***Parar reproducción***
mciSendString "stop sound", Rs, 128, cb
mciSendString "close sound", Rs, 128, cb
'***Para la grabación***
mciSendString "stop capture", Rs, 128, cb
mciSendString "save capture " + FicheroGrabación, Rs, 128, cb
mciSendString "close capture", Rs, 128, cb
End Sub
Public Sub Grabar(Fichero As String)
Dim i As Long
FicheroGrabación = Fichero: On Local Error Resume Next
Kill Fichero
mciSendString "record rate 44100", Rs, 128, cb
i = mciSendString("open new type waveaudio alias capture", Rs, 128, cb)
i = mciSendString("record capture", Rs, 128, cb)
End Sub
'Public Sub CSonido()
'esto es para saber si el sonido se está reproduciendo todavía
' mciSendString "status sound length", Rs, 128, cb'
' s = Val(Rs)
' If s Then
' mciSendString "status sound position", Rs, 128, cb
' If Val(Rs) > s - 10 Then
' 'FFraseo.Reproduciendo.Enabled = True: Parar
' End If
' s = Val(Rs) / s
' FFraseo.Progreso.Line (0, 0)-(FFraseo.Progreso.Width * s, FFraseo.Progreso.Height), QBColor(4), BF
' End If
'end Sub
Public Function Posicionar(Optional Longitud_Total As Long, Optional Minuto As Long, Optional Segundo As Long, Optional Centésima As Long) As Long
Rs = Space$(128)
mciSendString "status sound length", Rs, 128, cb
Longitud_Total = Val(Rs)
Rs = Space$(128)
mciSendString "status sound position", Rs, 128, cb
Posicionar = Val(Rs)
Minuto = Int(Posicionar / 60000)
Segundo = Int((Posicionar - Minuto * 60000) / 1000)
Centésima = Int((Posicionar - Minuto * 60000 - Segundo * 1000) / 10)
End Function
Public Sub Modificar(Posición As Long)
Rs = Space$(128)
mciSendString "play sound from " & Posición, Rs, 128, cb
End Sub
Raúl Ferrer Costa" <rfc@retemail.es>