荔园在线
荔园之美，在春之萌芽，在夏之绽放，在秋之收获，在冬之沉淀
[回到开始]
[上一篇][下一篇]
发信人: guita (干傻), 信区: Multimedia
标 题: Re: 如何从SOUND.DRV中提取声音－多媒体处理Visu
发信站: 荔园晨风BBS站 (Sun May 19 22:13:50 2002), 转信
这个你也贴出来？呵呵，那我也来一个：呵呵~~~~
Visual Basic技巧集
——多媒体处理
内容提要：
一、音效档播放程式
二、如何用API及MMSYSTEM.DLL播放WAV文件
三、怎样检查声卡的存在
四、如何用API及MMSYSTEM.DLL播放AVI文件
五、如何从" SOUND.DRV"中提取声音
六、如何用API播放CD
------------------------------------------------------------------------
--------
一、音效档播放程式
------------------------------------------------------------------------
----所需物件：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
----程式说明：媒体控制物件（MMControl）本身是属於专业版内附的控制物件，
有许多
基本的语法，请自行参考有关的书籍。
------------------------------------------------------------------------
--------
二、如何用API及MMSYSTEM.DLL播放WAV文件
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
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%)
------------------------------------------------------------------------
--------
三、怎样检查声卡的存在
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文件
Declare Function mciSendString& Lib "MMSYSTEM" (ByVal pstrCommand$,
ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal CallBack%)
Dim CmdStr$
Dim ReturnVal&
CmdStr$ = "play G:\VFW_CINE\AK1.AVI"
ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0&)
CmdStr$ = "play G:\VFW_CINE\AK1.AVI fullscreen"
------------------------------------------------------------------------
--------
五、如何从" SOUND.DRV"中提取声音
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%)
Sub Sound (ByVal Freq As Long, ByVal Duration As Integer)
Dim S As Integer
Freq = Freq * 2 ^ 16
S = SetVoiceSound(1, Freq, Duration)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
End Sub
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
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
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
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
Declare Function mciSendString& Lib "MMSYSTEM" (ByVal lpstrCommand$,
ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal hCallBack%)
Sub cmdPlay_Click ()
Dim lRet As Long
Dim nCurrentTrack As Integer
lRet = mciSendString("open cdaudio alias cd wait", 0&, 0, 0)
lRet = mciSendString("set cd time format tmsf", 0&, 0, 0)
lRet = mciSendString("play cd", 0&, 0, 0)
nCurrentTrack = 4
lRet = mciSendString("play cd from" & Str(nCurrentTrack), 0&, 0, 0)
End Sub
Sub cmdStop_Click ()
Dim lRet As Long
lRet = mciSendString("stop cd wait", 0&, 0, 0)
DoEvents
lRet = mciSendString("close cd", 0&, 0, 0)
End Sub
【 在 sephiroth (birds of paradise) 的大作中提到: 】
: '-------------------------------------------------------------------
: '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
--
※ 来源:·荔园晨风BBS站 bbs.szu.edu.cn·[FROM: 192.168.55.226]
[回到开始]
[上一篇][下一篇]
荔园在线首页 友情链接：深圳大学 深大招生 荔园晨风BBS S-Term软件 网络书店