音效档播放程式
------------------------------------------------------------------------
----所需物件：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
返回
|