声明：
Declare Function MCISendString& Lib "MMSYSTEM" (ByVal LPSTRCOMMAND$, ByVal LPSTRRETURNSTR As Any, ByVal WRETURNLEN%, ByVal HCALLBACK%)
开始播放：
R% = MCISendString&("OPEN EXAMPLE.MID TYPE SEQUENCER ALIAS NN", 0&, 0, 0)
R% = MCISendString&("PLAY NN FROM 0", 0&, 0, 0)
R% = MCISendString&("CLOSE ANIMATION", 0&, 0, 0)
停止：
R% = MCISendString&("OPEN EXAMPLE.MID TYPE SEQUENCER ALIAS NN", 0&, 0, 0)
R% = MCISendString&("STOP NN", 0&, 0, 0)
R% = MCISendString&("CLOSE ANIMATION", 0&, 0, 0)
其中EXAMPLE.MID 为播放的文件，NN为自定义名称标志。
返回

WAV 文件基本信息包括如是否立体声，采样频率等。
声明：
Public Const RIFF_ID = 1179011410
Public Const RIFF_WAVE = 1163280727
Public Const RIFF_FMT = 544501094
'Typical header of a simple RIFF WAVE file
Public Type WAVInfo
  Riff_Format As Long
  chunk_size As Long
  ChunkID As Long fmt As Long
  Wave_Format As Integer
  Channels As Integer '0 = 单声道, 1 = 立体声
  SamplesPerSecond As Long
  AverageBytesPerSecond As Long '11.025kHz, 22.05kHz, 等
  BlockAlign As Integer 'Size of blocks for low level playback
End Type
函数：
Public Function GetWaveInfo(Byval filename As String, Byref w As WAVInfo) _
As Boolean

Dim ff As Integer
ff = FreeFile

On Error GoTo ehandler
Open filename For Binary Access Read As #ff

On Error GoTo ehandler_fo
Get #ff, , w
Close #ff

On Error GoTo ehandler

If w.Riff_Format = RIFF_ID And w.ChunkID = _
RIFF_WAVE And w.fmt = RIFF_FMT Then

GetWaveInfo = True
Else
GetWaveInfo = False
End If

Exit Function

ehandler_fo:
Close #ff
ehandler:
GetWaveInfo = False
End Function
返回

声明：
Declare Function waveOutGetNumDevs Lib "winmm.dll" Alias "waveOutGetNumDevs" () As Long
例子：
Dim i As Integer
i = waveOutGetNumDevs()
If i > 0 Then
MsgBox "系统安装声卡"
Else
MsgBox "系统无声音卡"
End If
返回

Public Declare Function sndPlaySound& Lib "winmm.dll" Alias"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
Global Const SND_SYNC = &H0
Global Const SND_ASYNC = &H1
Global Const SND_NODEFAULT = &H2
Global Const SND_LOOP = &H8
Global Const SND_NOSTOP = &H10


Sub PlayWav(SoundName As String)
Dim tmpSoundName As String
Dim wFlags%, X%
tmpSoundName = pathWavFiles & SoundName
wFlags% = SND_ASYNC Or SND_NODEFAULT
X% = sndPlaySound(tmpSoundName, wFlags%)
End Sub
返回

VB 提供的方法使我们可以很容易地使用资源文件中的字符、图片等资源。我们可以用以下方法播放资源文件中的 wav 声音：
首先，在你的资源文件的源文件 (RC) 文件加入下面一行：
MySound WAVE c:\music\vanhalen.wav
然后将其编译为 RES 文件。
最后使用下面的声明及代码：
Private Declare Function PlaySound Lib _ "winmm.dll" Alias "PlaySoundA" ( _ ByVal lpszName As String, _ ByVal hModule As Long, _ ByVal dwFlags As Long) As Long Private
Const SND_ASYNC& = &H1
Private Const SND_NODEFAULT& = &H2
Private Const SND_RESOURCE& = &H40004
Dim hInst As Long
Dim sSoundName As String
Dim lFlags As Long
Dim lRet As Long Private
Sub Command1_Click() hInst = App.hInstance
sSoundName = "MySound"
lFlags = SND_RESOURCE + SND_ASYNC + _ SND_NODEFAULT
lRet = PlaySound(sSoundName, hInst, lFlags)
End Sub
返回

'thanks to Rick Ratayczak of Future Works Media (rickr@execpc.com)
'save file and rename them to [name].BAS


Attribute VB_Name = "MIXER"
'****************************************************************************
'* This constant holds the value of the Highest Custom volume setting. The *
'* lowest value will always be zero. *
'****************************************************************************
Public Const HIGHEST_VOLUME_SETTING = 12

'Put these into a module
' device ID for aux device mapper
Public Const AUX_MAPPER = -1&
Public Const MAXPNAMELEN = 32

Type AUXCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
wTechnology As Integer
dwSupport As Long
End Type

' flags for wTechnology field in AUXCAPS structure
Public Const AUXCAPS_CDAUDIO = 1 ' audio from internal CD-ROM drive
Public Const AUXCAPS_AUXIN = 2 ' audio from auxiliary input jacks

' flags for dwSupport field in AUXCAPS structure
Public Const AUXCAPS_VOLUME = &H1 ' supports volume control
Public Const AUXCAPS_LRVOLUME = &H2 ' separate left-right volume control

Declare Function auxGetNumDevs Lib "winmm.dll" () As Long
Declare Function auxGetDevCaps Lib "winmm.dll" Alias "auxGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As AUXCAPS, ByVal uSize As Long) As Long

Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Declare Function auxGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByRef lpdwVolume As Long) As Long
Declare Function auxOutMessage Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long

'****************************************************************************
'* Possible Return values from auxGetVolume, auxSetVolume *
'****************************************************************************
Public Const MMSYSERR_NOERROR = 0
Public Const MMSYSERR_BASE = 0
Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)

'****************************************************************************
'* Use the CopyMemory function from the Windows API *
'****************************************************************************
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

'****************************************************************************
'* Use this structure to break the Long into two Integers *
'****************************************************************************
Public Type VolumeSetting
LeftVol As Integer
RightVol As Integer
End Type

Sub lCrossFader()
'Vol1 = 100 - Slider1.Value ' Left
'Vol2 = 100 - Slider5.Value ' Right
'E = CrossFader.Value
'F = 100 - E
'If Check4.Value = 1 Then ' Half Fader Check
' LVol = (F * Val(Vol1) / 100) * 2
' RVol = (E * Val(Vol2) / 100) * 2
' If LVol > (50 * Val(Vol1) / 100) * 2 Then
' LVol = (50 * Val(Vol1) / 100) * 2
' End If
' If RVol > (50 * Val(Vol2) / 100) * 2 Then
' RVol = (50 * Val(Vol2) / 100) * 2
' End If
'Else
' LVol = (F * Val(Vol1) / 100)
' RVol = (E * Val(Vol2) / 100)
'End If
'Label1.Caption = "Fader: " + LTrim$(Str$(LVol)) + " x " + LTrim$(Str$(RVol))
'
End Sub


Public Function lSetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
'****************************************************************************
'* This function sets the current Windows volume settings to the specified *
'* device using two Custom numbers from 0 to HIGHEST_VOLUME_SETTING for the *
'* right and left volume settings. *
'* *
'* The return value of this function is the Return value of the auxGetVolume*
'* Windows API call. *
'****************************************************************************

Dim bReturnValue As Boolean ' Return Value from Function
Dim Volume As VolumeSetting ' Type structure used to convert a long to/from
' two Integers.

Dim lAPIReturnVal As Long ' Return value from API Call
Dim lBothVolumes As Long ' The API passed value of the Combined Volumes


'****************************************************************************
'* Calculate the Integers *
'****************************************************************************
Volume.LeftVol = nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
Volume.RightVol = nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)

'****************************************************************************
'* Combine the Integers into a Long to be Passed to the API *
'****************************************************************************
lDataLen = Len(Volume)
CopyMemory lBothVolumes, Volume.LeftVol, lDataLen

'****************************************************************************
'* Set the Value to the API *
'****************************************************************************
lAPIReturnVal = auxSetVolume(lDeviceID, lBothVolumes)
lSetVolume = lAPIReturnVal

End Function


Public Function lGetVolume(ByRef lLeftVol As Long, ByRef lRightVol As Long, lDeviceID As Long) As Long
'****************************************************************************
'* This function reads the current Windows volume settings from the *
'* specified device, and returns two numbers from 0 to *
'* HIGHEST_VOLUME_SETTING for the right and left volume settings. *
'* *
'* The return value of this function is the Return value of the auxGetVolume*
'* Windows API call. *
'****************************************************************************

Dim bReturnValue As Boolean ' Return Value from Function
Dim Volume As VolumeSetting ' Type structure used to convert a long to/from
' two Integers.
Dim lAPIReturnVal As Long ' Return value from API Call
Dim lBothVolumes As Long ' The API Return of the Combined Volumes

'****************************************************************************
'* Get the Value from the API *
'****************************************************************************
lAPIReturnVal = auxGetVolume(lDeviceID, lBothVolumes)

'****************************************************************************
'* Split the Long value returned from the API into to Integers *
'****************************************************************************
lDataLen = Len(Volume)
CopyMemory Volume.LeftVol, lBothVolumes, lDataLen

'****************************************************************************
'* Calculate the Return Values. *
'****************************************************************************
lLeftVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535
lRightVol = HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535

lGetVolume = lAPIReturnVal
End Function

Public Function nSigned(ByVal lUnsignedInt As Long) As Integer
Dim nReturnVal As Integer ' Return value from Function

If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
MsgBox "Error in conversion from Unsigned to nSigned Integer"
nSignedInt = 0
Exit Function
End If

If lUnsignedInt > 32767 Then
nReturnVal = lUnsignedInt - 65536
Else
nReturnVal = lUnsignedInt
End If

nSigned = nReturnVal

End Function

Public Function lUnsigned(ByVal nSignedInt As Integer) As Long
Dim lReturnVal As Long ' Return value from Function

If nSignedInt < 0 Then
lReturnVal = nSignedInt + 65536
Else
lReturnVal = nSignedInt
End If

If lReturnVal > 65535 Or lReturnVal < 0 Then
MsgBox "Error in conversion from nSigned to Unsigned Integer"
lReturnVal = 0
End If

lUnsigned = lReturnVal
End Function
返回

PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:4.00
OPER/SYS:WINDOWS
KEYWORDS:kbprg kbcode kbhowto

----------------------------------------------------------------------
The information in this article applies to:

- Professional and Enterprise Editions of Microsoft Visual Basic,
32-bit only, for Windows, version 4.0
----------------------------------------------------------------------

SUMMARY
=======

To size a picture box to fit an AVI image at run time, you must first get
the dimensions of the AVI file. This article demonstrates how to do it.

MORE INFORMATION
================

The example uses the mciSendCommand function to get the dimensions of the
AVI file currently referenced by an MCI control.

Step-by-Step Example
--------------------

1. Start a new project in Visual Basic. Add a module (.BAS) file, and make
sure the MCI control is included in the project. Add a MCI control
(MMControl1), a Command Button (Command1), and a Picture box (Picture1)
to Form1. Set Form1's ScaleMode property to Pixels (3).

2. In the General declarations section of the .BAS file, add this code:

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type MCI_OVLY_RECT_PARMS
dwCallback As Long
rc As RECT
End Type

Global Const MCI_OVLY_WHERE_SOURCE = &H20000
Global Const MCI_OVLY_WHERE_DESTINATION = &H40000
Global Const MCI_WHERE = &H843

'Enter the following Declare statement:
Declare Function mciSendCommand Lib "winmm.dll" _
Alias "mciSendCommandA" ( _
ByVal wDeviceID As Long, _
ByVal uMessage As Long, _
ByVal dwParam1 As Long,
dwParam2 As Any) As Long

' Enter the following Declare statement:
Declare Function mciGetErrorString Lib "winmm.dll" _
Alias "mciGetErrorStringA" ( _
ByVal dwError As Long, _
ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long

3. In the Command1_Click() method for the Command button on Form1, enter
this code:

Sub Command1_Click ()
Const MB_OK = 0
Const MB_ICONSTOP = 16

Dim Retval&, Buffer$
Dim dwParam2 As MCI_OVLY_RECT_PARMS

MMControl1.Command = "Close"
MMControl1.Filename = "WndSurf1.avi" 'Sample AVI file to be
'played.

'Get the MCI control to display the video in Picture1:
MMControl1.hWndDisplay = Picture1.hWnd

MMControl1.Command = "Open"

'Initialize the structure being passed with mciSendCommand, and
'set it in case you want to use the Notify property:
dwParam2.dwCallback = MMControl1.hWnd
dwParam2.rc.Left = 0
dwParam2.rc.Top = 0
dwParam2.rc.Right = 0
dwParam2.rc.Bottom = 0

'Send the message:
'Enter the following two lines as one, single line of code:
Retval& = mciSendCommand(MMControl1.DeviceID, MCI_WHERE,
MCI_OVLY_WHERE_SOURCE, dwParam2)

If Retval& <> 0 Then ' An error occurred.
Buffer$ = Space$(100)
'Get a description of the error:
Retval& = mciGetErrorString(Retval&, Buffer$, Len(Buffer$))
MsgBox Trim$(Buffer$), MB_OK + MB_ICONSTOP, "ERROR"
Else
'Resize the picture box:
Picture1.Width = dwParam2.rc.right - dwParam2.rc.left
Picture1.Height = dwParam2.rc.bottom - dwParam2.rc.top

'Play the video:
MMControl1.Wait = True ' Wait for the next command to complete
MMControl1.Command = "play" 'Play the video clip
MMControl1.Command = "close"
End If
End Sub

4. Test the program by pressing the F5 key to run it, and clicking the
command button. The AVI file will play back in the picture box, which
will have been resized to fit the video clip exactly.
返回

'Author: Gordon F. MacLeod
'How to play an .AVI file using API and the MMSYSTEM.DLL..
'-------------------------------------------------------------------
' Here's how to play an .AVI file via API

' Declare this API:

Declare Function mciSendString& Lib "MMSYSTEM" (ByVal pstrCommand$,
ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal CallBack%)

'Add this code to the appropriate event:

Dim CmdStr$
Dim ReturnVal&

    ' Modify path and filename as necessary
    CmdStr$ = "play G:\VFW_CINE\AK1.AVI"
    ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0&)

' To play the AVI 'fullscreen' append to CmdStr$:

    CmdStr$ = "play G:\VFW_CINE\AK1.AVI fullscreen"
返回

'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'How to detect if a sound card exists on a system.
'-------------------------------------------------------------------
' Here's how to detect if a sound card exists

' Declare this API
    Declare Function auxGetNumDevs% Lib "MMSYSTEM" ()

' In the appropriate routine:

Dim i As Integer
    i = auxGetNumDevs()

If i > 0 Then ' There is at least one sound card on the system
    MsgBox "A Sound Card has been detected."

Else ' auxGetNumDevs returns a 0 if there is no sound card
    MsgBox "There is no Sound Card on this system."
End If
返回

'-------------------------------------------------------------------
'Author: Gordon F. MacLeod
'How to extract sounds from the SOUND.DRV library..
' Here are 4 different sound effects that can called
' via API's to the "SOUND.DRV" library. You can modify
' the values to create your own unique sounds.

' Declare these API's:

Declare Function OpenSound% Lib "sound.drv" ()
Declare Function VoiceQueueSize% Lib "sound.drv" (ByVal nVoice%, ByVal nByteS)
Declare Function SetVoiceSound% Lib "sound.drv" (ByVal nSource%, ByVal Freq&,
ByVal nDuration%)
Declare Function StartSound% Lib "sound.drv" ()
Declare Function CloseSound% Lib "sound.drv" ()
Declare Function WaitSoundState% Lib "sound.drv" (ByVal State%)

' Add this routine, to be used with SirenSound1 routine

Sub Sound (ByVal Freq As Long, ByVal Duration As Integer)
Dim S As Integer
' Shift frequency to high byte.
   Freq = Freq * 2 ^ 16
   S = SetVoiceSound(1, Freq, Duration)
   S = StartSound()
   While (WaitSoundState(1) <> 0): Wend
End Sub
 

' Here are the 4 sound routines:

'* Attention Sound #1 *
Sub AttenSound1 ()
Dim Succ, S As Integer
   Succ = OpenSound()
   S = SetVoiceSound(1, 1500 * 2 ^ 16, 50)
   S = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
   S = SetVoiceSound(1, 1500 * 2 ^ 16, 100)
   S = SetVoiceSound(1, 1000 * 2 ^ 16, 100)
   S = SetVoiceSound(1, 800 * 2 ^ 16, 40)

   S = StartSound()
   While (WaitSoundState(1) <> 0): Wend
   Succ = CloseSound()

End Sub

'* Click Sound #1 *
Sub ClickSound1 ()
Dim Succ, S As Integer
   Succ = OpenSound()
   S = SetVoiceSound(1, 200 * 2 ^ 16, 2)
   S = StartSound()
   While (WaitSoundState(1) <> 0): Wend
   Succ = CloseSound()

End Sub

'* Error Sound #1 *
Sub ErrorSound1 ()
Dim Succ, S As Integer
   Succ = OpenSound()
   S = SetVoiceSound(1, 200 * 2 ^ 16, 150)
   S = SetVoiceSound(1, 100 * 2 ^ 16, 100)
   S = SetVoiceSound(1, 80 * 2 ^ 16, 90)
   S = StartSound()
   While (WaitSoundState(1) <> 0): Wend
   Succ = CloseSound()
End Sub

'* SirenSound #1 *
Sub SirenSound1 ()
Dim Succ As Integer
Dim J As Long
   Succ = OpenSound()
   For J = 440 To 1000 Step 5
      Call Sound(J, J / 100)
   Next J
   For J = 1000 To 440 Step -5
      Call Sound(J, J / 100)
   Next J
   Succ = CloseSound()

End Sub
返回

'Author: Gordon F. MacLeod
' How to play a CD Audio disc via API

' Declare the following API
Declare Function mciSendString& Lib "MMSYSTEM" (ByVal lpstrCommand$,
ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal hCallBack%)

'Add the code below to appropriate routines

Sub cmdPlay_Click ()
Dim lRet As Long
Dim nCurrentTrack As Integer

'Open the device
lRet = mciSendString("open cdaudio alias cd wait", 0&, 0, 0)

'Set the time format to Tracks (default is milliseconds)
lRet = mciSendString("set cd time format tmsf", 0&, 0, 0)

'Then to play from the beginning
lRet = mciSendString("play cd", 0&, 0, 0)

'Or to play from a specific track, say track 4
nCurrentTrack = 4
lRet = mciSendString("play cd from" & Str(nCurrentTrack), 0&, 0, 0)

End Sub
 

' Remember to Close the device when ending playback

Sub cmdStop_Click ()
Dim lRet As Long

'Stop the playback
lRet = mciSendString("stop cd wait", 0&, 0, 0)

DoEvents  'Let Windows process the event

'Close the device
lRet = mciSendString("close cd", 0&, 0, 0)

End Sub
返回

如果你想通过VB打开或者关闭CD-ROM，你可以向Windows Multimedia DLL发出一条相关的命令请求，但是你必须先声明DLL：

在模块文件中加入以下代码：

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

以下是打开CD-ROM的过程代码：

retvalue = mcisendstring("set CDAudio door open", _

returnstring, 127, 0)

关闭CD-ROM用以下代码：

retvalue = mcisendstring("set CDAudio door closed", _returnstring, 127, 0)
返回

下面的定义以及代码可以实现播放一个Wav文件。
Private Declare Function mciExecute Lib "winmm.dll" (ByVal strFilename As String) As Integer

Dim lngResult As Long
lngResult = mciExecute("Play C:\Windows\Media\logoff.wav")
返回

Back to top