Resumen Reproducir y grabar wavs

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>



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com