VB技巧(2)-多媒体处理

1 音效档播放程式
2
如何用API播放CD
3
如何用API及MMSYSTEM.DLL播放AVI文件
4
如何用API及MMSYSTEM.DLL播放WAV文件
5
怎样检查声卡的存在
6
如何从" SOUND.DRV"中提取声音
7
如何播放WAV文件

[1] [2] [3] [4] [5] [6] [7] [8] [9] [10]

第二页(共十页)


音效档播放程式
------------------------------------------------------------------------

 ----所需物件: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
返回


[1] [2] [3] [4] [5] [6] [7] [8] [9] [10]

第二页(共十页)