mci.frm

VB源码,是初学者的福因.让你很快掌握VB编程

End Type

Const SM_CXBORDER = 5
Const SM_CYBORDER = 6
Const VK_SNAPSHOT As Byte = &H2C
Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Const MCI_SET = &H80D
Const MCI_SET_DOOR_OPEN = &H100&

Private Sub Command1_Click()        ' PLAY WAV
    Command5_Click
    Dim i As Long, RS As String, cb As Long, W$
    RS = Space$(128)
    W$ = "c:\windows\media\robot~17.wav"
    i = mciSendString("open waveaudio!" & W$ & " alias sound", RS, 128, cb)
    If i Then MsgBox "Error! Probably file not found. Modify the code to point to a .WAV file on your system."
    i = mciSendString("play sound", RS, 128, cb)
End Sub

Private Sub Command16_Click()       ' Prev CD Track
    Dim i As Long, RS As String, cb As Long, W$, s As Long
    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.Line (0, 0)-(ProgressBar4.Width, ProgressBar4.Height), ProgressBar4.BackColor, BF
        End If
    End If
End Sub

Private Sub Command17_Click()       ' Next CD Track
    Dim i As Long, RS As String, cb As Long, W$, s As Long
    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()       ' EJECT CD
    Command8_Click
    Dim i As Long, RS As String, cb As Long, id As Long
    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
End Sub

Private Sub Command5_Click()        ' STOP WAV
    Dim i As Long, RS As String, cb As Long
    RS = Space$(128)
    i = mciSendString("stop sound", RS, 128, cb)
    i = mciSendString("close sound", RS, 128, cb)
End Sub

Private Sub Command3_Click()        ' PLAY AVI
    Command7_Click
    Dim i As Long, RS As String, cb As Long, A$, x As Long, y As Long
    RS = Space$(128)
    A$ = "d:\winvideo\matts\ktkd.avi"
    i = mciSendString("open AVIvideo!" & A$ & " alias movie parent " & Frame1.hWnd & " style child", RS, 128, cb)
'    i = mciSendString("put movie window client at 200 0 0 0", RS, 128, cb)
    If i Then MsgBox "Error! Probably file not found. Modify the code to point to an .AVI file on your system."
    i = mciSendString("play movie", RS, 128, cb)
End Sub

Private Sub Command7_Click()        ' STOP AVI
    Dim i As Long, RS As String, cb As Long
    RS = Space$(128)
    i = mciSendString("stop movie", RS, 128, cb)
    i = mciSendString("close movie", RS, 128, cb)
End Sub

Private Sub Command15_Click()       ' COPY AVI IMAGE
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    DoEvents
    Picture1.Move 0, 0, Width, Height
    Picture2.Move 0, 0, Frame1.Width, Frame1.Height
    DoEvents
    Picture1.Picture = Clipboard.GetData
    ' The positions must be adjusted for Form caption height and border width for exact frame match!
    ' Also, the Frame size should be adjusted to match the AVI !
    Picture2.PaintPicture Picture1.Picture, 0, 0, Frame1.Width, Frame1.Height, Frame1.Left, Frame1.Top, Frame1.Width, Frame1.Height
    Clipboard.Clear
    Clipboard.SetData Picture2.Image
    MsgBox "Image copied to the clipboard."
End Sub

Private Sub Command10_Click()       ' PLAY RECORDED WAV
    Dim i As Long
    i = sndPlaySound("c:\cdtest.wav", 0)
    If i = 0 Then MsgBox "Error! Probably file not found. Modify the code to record and play a .WAV file on your system."
End Sub

Private Sub Command11_Click()       ' INCREASE WAV VOLUME
    Dim id As Long, v As Long, i As Long, lVol As lVolType, Vol As VolType, lv As Double, rv As Double
    id = -1     ' the ALL DEVICE id - this will change the master WAVE volume!
    i = waveOutGetVolume(id, v)
    lVol.v = v
    LSet Vol = lVol
    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
    LSet lVol = Vol
    v = lVol.v
    i = waveOutSetVolume(id, v)
End Sub

Private Sub Command12_Click()       ' DECREASE WAV VOLUME
    Dim id As Long, v As Long, i As Long, lVol As lVolType, Vol As VolType, lv As Double, rv As Double
    id = -1     ' the ALL DEVICE id - this will change the master WAVE volume!
    i = waveOutGetVolume(id, v)
    lVol.v = v
    LSet Vol = lVol
    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
    LSet lVol = Vol
    v = lVol.v
    i = waveOutSetVolume(id, v)
End Sub

Private Sub Command13_Click()       ' DECREASE MIDI VOLUME
    Dim id As Long, v As Long, i As Long, lVol As lVolType, Vol As VolType, lv As Double, rv As Double
    id = mciGetDeviceID("midi")   ' I don't know the master MIDI id
    i = midiOutGetVolume(id, v)
    lVol.v = v
    LSet Vol = lVol
    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
    LSet lVol = Vol
    v = lVol.v
    i = midiOutSetVolume(id, v)
End Sub

Private Sub Command14_Click()       ' INCREASE MIDI VOLUME
    Dim id As Long, v As Long, i As Long, lVol As lVolType, Vol As VolType, lv As Double, rv As Double
    id = mciGetDeviceID("midi")   ' I don't know the master MIDI id
    i = midiOutGetVolume(id, v)
    lVol.v = v
    LSet Vol = lVol
    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
    LSet lVol = Vol
    v = lVol.v
    i = midiOutSetVolume(id, v)
End Sub

Private Sub Command2_Click()           ' PLAY MIDI FILE
    Command6_Click
    Dim i As Long, RS As String, cb As Long, W$
    RS = Space$(128)
    W$ = "c:\sb16\samples\minuet.mid"
    i = mciSendString("open sequencer!" & W$ & " alias midi", RS, 128, cb)
    If i Then MsgBox "Error! Probably file not found. Modify the code to record and play a .MID file on your system."
    i = mciSendString("play midi", RS, 128, cb)
End Sub

Private Sub Command4_Click()            ' PLAY CD
    Command8_Click
    Dim i As Long, RS As String, cb As Long
    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 Command6_Click()            ' STOP MIDI
    Dim i As Long, RS As String, cb As Long
    RS = Space$(128)
    i = mciSendString("stop midi", RS, 128, cb)
    i = mciSendString("close midi", RS, 128, cb)
End Sub

Private Sub Command8_Click()            ' STOP CD
    Dim i As Long, RS As String, cb As Long
    RS = Space$(128)
    i = mciSendString("stop cdaudio", RS, 128, cb)
    i = mciSendString("close cdaudio", RS, 128, cb)
End Sub

Private Sub Command9_Click()            ' RECORD WAV
    On Local Error Resume Next
    Dim i As Long, RS As String, cb As Long, t#
    RS = Space$(128)
    Kill "c:\cdtest.wav"
    Command4_Click
    i = mciSendString("open new type waveaudio alias capture", RS, 128, cb)
    i = mciSendString("record capture", RS, 128, cb)
    t# = Timer + 1: Do Until Timer > t#: 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
End Sub

Private Sub Form_Load()
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Long, RS As String, cb As Long
    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_Timer()
    ' Uses Picture controls - comment the ProgressBar#.Line lines and uncomment the
    ' .Min .Max .Value ProgressBar# lines to use a real Win 95 Progress Bar
    ' (If you have that control with VB 4 or 5 Pro or Enterprise versions)
    Dim i As Long, RS As String, cb As Long, s As Single
    RS = Space$(128)
    i = mciSendString("status sound length", RS, 128, cb)
    If Val(RS) Then
        'ProgressBar1.Max = Val(RS)
        s = Val(RS)
        i = mciSendString("status sound position", RS, 128, cb)
        s = Val(RS) / s
        ProgressBar1.Line (0, 0)-(ProgressBar1.Width * s, ProgressBar1.Height), QBColor(4), BF
        'ProgressBar1.Value = Val(RS)
    Else
        'ProgressBar1.Value = 0
        ProgressBar1.Line (0, 0)-(ProgressBar1.Width, ProgressBar1.Height), ProgressBar1.BackColor, BF
    End If
    
    i = mciSendString("status movie length", RS, 128, cb)
    If Val(RS) Then
        'ProgressBar2.Max = Val(RS)
        s = Val(RS)
        i = mciSendString("status movie position", RS, 128, cb)
        s = Val(RS) / s
        ProgressBar2.Line (0, 0)-(ProgressBar2.Width * s, ProgressBar2.Height), QBColor(4), BF
        'ProgressBar2.Value = Val(RS)
    Else
        'ProgressBar2.Value = 0
        ProgressBar2.Line (0, 0)-(ProgressBar2.Width, ProgressBar2.Height), ProgressBar2.BackColor, BF
    End If
    
    i = mciSendString("status midi length", RS, 128, cb)
    If Val(RS) Then
        'ProgressBar3.Max = Val(RS)
        s = Val(RS)
        i = mciSendString("status midi position", RS, 128, cb)
        s = Val(RS) / s
        ProgressBar3.Line (0, 0)-(ProgressBar3.Width * s, ProgressBar3.Height), QBColor(4), BF
        'ProgressBar3.Value = Val(RS)
    Else
        'ProgressBar3.Value = 0
        ProgressBar3.Line (0, 0)-(ProgressBar3.Width, ProgressBar3.Height), ProgressBar3.BackColor, BF
    End If
    
    i = mciSendString("status cdaudio length", RS, 128, cb)
    If Val(RS) Then
        'ProgressBar4.Max = Val(RS)
        s = Val(RS)
        i = mciSendString("status cdaudio position", RS, 128, cb)
        s = Val(RS) / s
        ProgressBar4.Line (0, 0)-(ProgressBar4.Width * s, ProgressBar4.Height), QBColor(4), BF
        'ProgressBar4.Value = Val(RS)
    Else
        'ProgressBar4.Value = 0
        ProgressBar4.Line (0, 0)-(ProgressBar4.Width, ProgressBar4.Height), ProgressBar4.BackColor, BF
    End If
End Sub