7,763
社区成员
发帖
与我相关
我的任务
分享
Private Declare Function MIDIOutOpen Lib "winmm.dll" Alias "midiOutOpen" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const MAXERRORLENGTH = 128 ' max error text length (including NULL)
Dim hMidi As Long
Dim midi_error As Integer
Private Const MIDIMAPPER = (-1)
Private Const MIDI_MAPPER = (-1)
Private Sub haha()
midi_error = MIDIOutOpen(hMidi, MIDIMAPPER, 0, 0, 0)
If Not midi_error = 0 Then
MsgBox "open error" + CStr(midi_error)
End If
Sleep 100
Dim Tone As Long
For Tone = 20 To 122
Call midiOutShortMsg(hMidi, 127 * &H10000 + Tone * &H100 + &H90)
Sleep 70
DoEvents
Call midiOutShortMsg(hMidi, 127 * &H10000 + Tone * &H100 + &H80)
Next Tone
For Tone = 125 To 20 Step -1
Call midiOutShortMsg(hMidi, 127 * &H10000 + Tone * &H100 + &H90)
Sleep 70
DoEvents
Call midiOutShortMsg(hMidi, 127 * &H10000 + Tone * &H100 + &H80)
Next Tone
midiOutClose hMidi
End Sub
'复制存成1.vbs试试
Set WshShell = WScript.CreateObject("WScript.Shell")
strSoundFile = "C:\Windows\Media\Notify.wav"
strCommand = "sndrec32 /play /close " & Chr(34) & strSoundFile & Chr(34)
WshShell.Run strCommand, 0, True
'------------------------------------------------------------------------------
CreateObject ("SAPI.SpVoice").Speak "I LOVE YOU"
'------------------------------------------------------------------------------
strSoundFile = "C:\WINDOWS\Media\Windows XP 启动.wav"
Set objShell = CreateObject("Wscript.Shell")
strCommand = "sndrec32 /play /close " & chr(34) & strSoundFile & chr(34)
objShell.Run strCommand, 0, True
'------------------------------------------------------------------------------
strSoundFile = "C:\windows\Media\Notify.wav"
Set objShell = CreateObject("Wscript.Shell")
objShell.Run strCommand, 0, False
Wscript.Sleep 1000
Msgbox "A problem has occurred."
Option Explicit
Private Declare Function APIBeep Lib "kernel32" Alias "Beep" ( _
ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
To make a beep lasting 500 milliseconds with frequency specified in the
TextBox txtFrequency (try 1000 for starters):
Private Sub Command1_Click()
Dim frequency As Long
frequency = CLng(txtFrequency.Text)
APIBeep frequency, 500
End Sub