VB技巧2 多媒体处理

音效档播放程式
------------------------------------------------------------------------
----所需物件：PictureBox(1),Label(6),CommandButton(2),CommonDialog(1),MMControl(1)。

----程式码：

Const INTERVAL = 1000
Dim CurVal As Double

Private Sub CmdEnd_Click()
MMControl1.Command = "stop"
MMControl1.Command = "close"
End
End Sub

Private Sub CmdOpen_Click()
MMControl1.Command = "stop"
MMControl1.Command = "close"
Close #1
On Error GoTo errhandler
CMDlg.Filter = "音效档(*.wav;*.mid) |*.wav;*.mid"
CMDlg.FilterIndex = 1
CMDlg.Action = 1
Open CMDlg.filename For Input As #1

If Right$(CMDlg.filename, 3) = "wav" Then
MMControl1.DeviceType = "waveaudio"
Else
MMControl1.DeviceType = "sequencer"
End If

MMControl1.filename = CMDlg.filename
MMControl1.Command = "open"
CurVal = 0#
MMControl1.UpdateInterval = 0
errhandler:
Exit Sub
End Sub

Private Sub Form_Load()
Label1.Caption = "音效档名："
Label2.Caption = "总共时间："
Label3.Caption = "目前位置："
MMControl1.UpdateInterval = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
Const MCI_MODE_NOT_OPEN = 524
If Not MMControl1.Mode = MCI_MODE_NOT_OPEN Then
MMControl1.Command = "close"
End If
End Sub

Private Sub MMControl1_PauseClick(Cancel As Integer)
MMControl1.UpdateInterval = 0
CurVal = CurVal
End Sub

Private Sub MMControl1_PlayClick(Cancel As Integer)
MMControl1.UpdateInterval = INTERVAL
End Sub

Private Sub MMControl1_PrevClick(Cancel As Integer)
CurVal = 0#
End Sub

Private Sub MMControl1_StatusUpdate()

MMControl1.TimeFormat = 0
CurVal = CurVal + MMControl1.UpdateInterval + 54

Now_position = CurVal
Now_Min = Int(Now_position / 1000 / 60)
Now_Sec = Int(Now_position / 1000) Mod 60
Total_Min = Int(MMControl1.Length / 1000 / 60)
Total_Sec = Int(MMControl1.Length / 1000) Mod 60

Label4.Caption = MMControl1.filename
Label5.Caption = Format(Total_Min, "00") + ":" + Format(Total_Sec, "00")
Label6.Caption = Format(Now_Min, "00") + ":" + Format(Now_Sec, "00")

If MMControl1.PlayEnabled = False And Now_Min = Total_Min And Now_Sec = Total_Sec Then
CurVal = 0#
MMControl1.UpdateInterval = 0
MMControl1.Command = "prev"
MMControl1.Command = "stop"
End If
End Sub

Private Sub MMControl1_StopClick(Cancel As Integer)
CurVal = 0#
MMControl1.UpdateInterval = 0
MMControl1.Command = "prev"
End Sub
返回


如何播放WAV文件
'----------------------------------------------------------------
'Author: Dr. John A. Nyhart
'
'How do I play a WAV file with VB?
'----------------------------------------------------------------
'*****************************************************************
Sub PlayWav(SoundName As String)
Dim tmpSoundName As String
Dim wFlags%, X%

' declare statements (Place in a bas module.)
''**********************************
'#If Win32 Then
'Public Declare Function sndPlaySound& Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
'#Else
'Public Declare Function sndPlaySound% Lib "mmsystem.dll" (ByVal
lpszSoundName As String, ByVal uFlags As Integer)
'#End If 'WIN32
' **********************************
' WAV Sound values
'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
' **********************************

' *** pathWavFiles is a var with the subDir where
' the sound files are stored
tmpSoundName = pathWavFiles & SoundName

wFlags% = SND_ASYNC Or SND_NODEFAULT
X% = sndPlaySound(tmpSoundName, wFlags%)

End Sub
返回


如何用API及MMSYSTEM.DLL播放WAV文件

'Author: Gordon F. MacLeod
'How to play a .WAV file using API and the MMSYSTEM.DLL.
'-------------------------------------------------------------------
' Declare this API and these Constants in a .BAS file:

Declare Function sndPlaySound% Lib "MMSYSTEM.DLL" (ByVal lpszSoundName$,
ByVal wFlags%)

Global Const SND_SYNC = &H0000
Global Const SND_ASYNC = &H0001
Global Const SND_NODEFAULT = &H0002
Global Const SND_LOOP = &H0008
Global Const SND_NOSTOP = &H0010

' Paramaters:

' lpszSoundName$

' Specifies the name of the sound to play. The function first
' searches the [sounds] section of the WIN.INI file for an entry
' with the specified name, and plays the associated waveform sound
' file. If no entry by this name exists, then it assumes the
' specified name is the name of a waveform sound file. If this
' parameter is NULL, any currently playing sound is stopped.
' That is, use a 0& to provide a NULL value.

' wFlags%

' Specifies options for playing the sound using one or more
' of the following flags:
' SND_SYNC: The sound is played synchronously and the function
' does not return until the sound ends.
' SND_ASYNC: The sound is played asynchronously and the function
' returns immediately after beginning the sound.
' SND_NODEFAULT: If the sound cannot be found, the function returns
' silently without playing the default sound.
' SND_LOOP: The sound will continue to play repeatedly until
' sndPlaySound is called again with the lpszSoundName$ parameter
' set to null.
' You must also specify the SND_ASYNC flag to loop sounds.
' SND_NOSTOP: If a sound is currently playing, the function will
' immediately return False without playing the requested sound.

' Add the following code to the appropriate routine:

Dim SoundName$
Dim wFlags%
Dim x%

SoundName$ = "c:\windows\tada.wav" ' The file to play
wFlags% = SND_ASYNC Or SND_NODEFAULT
x% = sndPlaySound(SoundName$,wFlags%)
返回


怎样检查声卡的存在
'-------------------------------------------------------------------
'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
返回


如何用API及MMSYSTEM.DLL播放AVI文件

'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"
返回


------------------------------------------------------------------------
如何从"SOUND.DRV"中提取声音
'-------------------------------------------------------------------
'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
返回


如何用API播放CD

'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