📄 mci.vb

📁 这是一本用Visual Studio.NET进行多媒体编程的读物
💻 VB
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
	
	Private Sub Command12_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command12.Click ' 减小播放Wav的音量
        Dim v, id, i As Integer
        Dim lVol As lVolType
        Dim Vol As VolType
        Dim lv, rv As Double
        id = -1
        i = waveOutGetVolume(id, v)
        lVol.v = v
        Vol.lv = v : Vol.rv = v
        lv = Vol.lv : rv = Vol.rv
        lv = lv - &HFFF&
        rv = rv - &HFFF&
        If lv < -32767 Then lv = lv + 65536
        If rv < -32767 Then rv = rv + 65536
        Vol.lv = lv
        Vol.rv = rv
        lVol.v = Vol.rv
        v = lVol.v
        i = waveOutSetVolume(id, v)
	End Sub
	
	Private Sub Command9_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command9.Click '录制Wav文件
		On Error Resume Next
		Dim i, cb As Integer
		Dim RS As String
        Dim t As Double

        RS = Space(128)
        Kill("c:\cdtest.wav")
		Command4_Click(Command4, New System.EventArgs())
		i = mciSendString("open new type waveaudio alias capture", RS, 128, cb)
        i = mciSendString("record capture", RS, 128, cb)
        Timer2Counter = 0
        Timer2.Enabled = True
        Do Until Timer2Counter > 10 : System.Windows.Forms.Application.DoEvents() : Loop
        i = mciSendString("stop capture", RS, 128, cb)
        i = mciSendString("save capture c:\cdtest.wav", RS, 128, cb)
        i = mciSendString("close capture", RS, 128, cb)
        Command8_Click(Command8, New System.EventArgs())
	End Sub
	
	Private Sub Command10_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command10.Click ' 播放录制的Wav声音
		Dim i As Integer
		i = sndPlaySound("c:\cdtest.wav", 0)
		If i = 0 Then MsgBox("出错信息：MIDI文件可能不存在。请给出正确的文件名称。")
	End Sub
	
	Private Sub Command16_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command16.Click ' 播放CD音频
		Dim cb, i, s As Integer
		Dim RS, W As String
		RS = Space(128)
		i = mciSendString("status cdaudio current track", RS, 128, cb)
		If Val(RS) Then
			s = Val(RS) - 1
			i = mciSendString("status cdaudio position track " & s, RS, 128, cb)
			s = Val(RS)
			If s Then
				i = mciSendString("play cdaudio from " & s, RS, 128, cb)
				ProgressBar4.Value = ProgressBar4.Maximum
            End If
        End If
	End Sub
	
	Private Sub Command17_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command17.Click ' 选择下一首CD曲目
		Dim cb, i, s As Integer
		Dim RS, W As String
		RS = Space(128)
		i = mciSendString("status cdaudio current track", RS, 128, cb)
		If Val(RS) Then
			s = Val(RS) + 1
			i = mciSendString("status cdaudio position track " & s, RS, 128, cb)
			s = Val(RS)
			If s Then
				i = mciSendString("play cdaudio from " & s, RS, 128, cb)
			End If
		End If
	End Sub
	
	Private Sub Command18_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command18.Click ' 弹出CD
		Command8_Click(Command8, New System.EventArgs())
		Dim cb, i, id As Integer
		Dim RS As String
		RS = Space(128)
		i = mciSendString("open cdaudio", RS, 128, cb)
		id = mciGetDeviceID("cdaudio")
		i = mciSendCommand(id, MCI_SET, MCI_SET_DOOR_OPEN, 0)
		Command8_Click(Command8, New System.EventArgs())
	End Sub
	
	
	Private Sub Command3_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command3.Click ' 播放AVI文件
		Command7_Click(Command7, New System.EventArgs())
		Dim x, i, cb, y As Integer
		Dim RS, A As String
		RS = Space(128)
        A = "e:\sound\example1.avi"
		i = mciSendString("open AVIvideo!" & A & " alias movie parent " & Frame1.Handle.ToInt32 & " style child", RS, 128, cb)
		'    i = mciSendString("put movie window client at 200 0 0 0", RS, 128, cb)
		If i Then MsgBox("出错信息：MIDI文件可能不存在。请给出正确的文件名称。")
		i = mciSendString("play movie", RS, 128, cb)
	End Sub
	
	Private Sub Command7_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command7.Click ' 停止播放AVI文件
		Dim i, cb As Integer
		Dim RS As String
		RS = Space(128)
		i = mciSendString("stop movie", RS, 128, cb)
		i = mciSendString("close movie", RS, 128, cb)
	End Sub

    Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click '播放MIDI文件
        Command6_Click(Command6, New System.EventArgs())
        Dim i, cb As Integer
        Dim RS, W As String
        RS = Space(128)
        W = "e:\sound\gczg.mid"
        i = mciSendString("open sequencer!" & W & " alias midi", RS, 128, cb)
        If i Then MsgBox("出错信息：MIDI文件可能不存在。请给出正确的文件名称。")
        i = mciSendString("play midi", RS, 128, cb)
    End Sub

    Private Sub Command4_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command4.Click ' 播放CD
        Command8_Click(Command8, New System.EventArgs())
        Dim i, cb As Integer
        Dim RS As String
        RS = Space(128)
        i = mciSendString("open cdaudio", RS, 128, cb)
        i = mciSendString("set cdaudio time format milliseconds", RS, 128, cb)
        i = mciSendString("play cdaudio", RS, 128, cb)
    End Sub

    Private Sub Command8_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command8.Click ' 停止播放CD
        Dim i, cb As Integer
        Dim RS As String
        RS = Space(128)
        i = mciSendString("stop cdaudio", RS, 128, cb)
        i = mciSendString("close cdaudio", RS, 128, cb)
    End Sub

    Private Sub Command6_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command6.Click ' 停止播放MIDI文件
        Dim i, cb As Integer
        Dim RS As String
        RS = Space(128)
        i = mciSendString("stop midi", RS, 128, cb)
        i = mciSendString("close midi", RS, 128, cb)
    End Sub
    Private Sub Command13_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command13.Click ' 增大播放MIDI的音量
        Dim v, id, i As Integer
        Dim lVol As lVolType
        Dim Vol As VolType
        Dim lv, rv As Double
        id = mciGetDeviceID("midi") ' I don't know the master MIDI id
        i = midiOutGetVolume(id, v)
        lVol.v = v
        Vol.lv = v : Vol.rv = v
        lv = Vol.lv : rv = Vol.rv
        lv = lv - &HFFF&
        rv = rv - &HFFF&
        If lv < -32768 Then lv = 65535 + lv
        If rv < -32768 Then rv = 65535 + rv
        Vol.lv = lv
        Vol.rv = rv
        lVol.v = Vol.lv
        v = lVol.v
        i = midiOutSetVolume(id, v)
    End Sub

    Private Sub Command14_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command14.Click ' 减小播放MIDI的音量
        Dim v, id, i As Integer
        Dim lVol As lVolType
        Dim Vol As VolType
        Dim lv, rv As Double
        id = mciGetDeviceID("midi")
        i = midiOutGetVolume(id, v)
        lVol.v = v
        Vol.lv = v : Vol.rv = v
        lv = Vol.lv : rv = Vol.rv
        lv = lv + &HFFF&
        rv = rv + &HFFF&
        If lv > 32767 Then lv = lv - 65536
        If rv > 32767 Then rv = rv - 65536
        Vol.lv = lv
        Vol.rv = rv
        lVol.v = Vol.lv
        v = lVol.v
        i = midiOutSetVolume(id, v)
    End Sub

    Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        SetBounds(VB6.TwipsToPixelsX((VB6.PixelsToTwipsX(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width) - VB6.PixelsToTwipsX(Width)) \ 2), VB6.TwipsToPixelsY((VB6.PixelsToTwipsY(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height) - VB6.PixelsToTwipsY(Height)) \ 2), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
    End Sub

    Private Sub Form1_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
        Dim i, cb As Integer
        Dim RS As String
        RS = Space(128)

        i = mciSendString("stop sound", RS, 128, cb)
        i = mciSendString("stop midi", RS, 128, cb)
        i = mciSendString("stop movie", RS, 128, cb)
        i = mciSendString("stop cdaudio", RS, 128, cb)
        i = mciSendString("stop capture", RS, 128, cb)

        i = mciSendString("close sound", RS, 128, cb)
        i = mciSendString("close midi", RS, 128, cb)
        i = mciSendString("close movie", RS, 128, cb)
        i = mciSendString("close cdaudio", RS, 128, cb)
        i = mciSendString("close capture", RS, 128, cb)
    End Sub

    Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Timer1.Tick
        Dim i, cb As Integer
        Dim RS As String
        Dim s As Single
        RS = Space(128)
        i = mciSendString("status sound length", RS, 128, cb)
        If Val(RS) <> 0 Then
            s = Val(RS)
            ProgressBar1.Minimum = 0
            ProgressBar1.Maximum = s
            i = mciSendString("status sound position", RS, 128, cb)
            s = Val(RS)
            ProgressBar1.Value = s
        Else
            ProgressBar1.Value = ProgressBar1.Minimum
        End If

        i = mciSendString("status movie length", RS, 128, cb)
        If Val(RS) <> 0 Then
            s = Val(RS)
            ProgressBar2.Minimum = 0
            ProgressBar2.Maximum = s
            i = mciSendString("status movie position", RS, 128, cb)
            s = Val(RS)
            ProgressBar2.Value = s
        Else
            ProgressBar2.Value = ProgressBar2.Minimum
        End If

        i = mciSendString("status midi length", RS, 128, cb)
        If Val(RS) <> 0 Then
            s = Val(RS)
            ProgressBar3.Minimum = 0
            ProgressBar3.Maximum = s
            i = mciSendString("status midi position", RS, 128, cb)
            s = Val(RS)
            ProgressBar3.Value = s
        Else
            ProgressBar3.Value = ProgressBar3.Minimum
        End If

        i = mciSendString("status cdaudio length", RS, 128, cb)
        If Val(RS) <> 0 Then
            s = Val(RS)
            ProgressBar4.Minimum = 0
            ProgressBar4.Maximum = s
            i = mciSendString("status cdaudio position", RS, 128, cb)
            s = Val(RS)
            ProgressBar4.Value = s
        Else
            ProgressBar4.Value = ProgressBar4.Minimum
        End If
    End Sub


    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        Timer2Counter = Timer2Counter + 1
    End Sub
End Class
上一页 1 23
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -