Author Topic: MCI Command 多媒體控制模組  (Read 4197 times)

admin

  • Administrator
  • *****
  • Posts: 0
    • View Profile
MCI Command 多媒體控制模組
« on: September 16, 2010, 12:48:25 AM »
Code: [Select]
Attribute VB_Name = "modMCIFunct"
Option Explicit
Public FullPathName As String

Public gintPlay As Integer
Public gintVolume As Integer
Public gintAudio As Integer

Public Const MM_MCINOTIFY = &H3B9
Public Const MCI_NOTIFY_SUCCESSFUL = 1
Public Const MCI_NOTIFY_SUPERSEDED = 2
Public Const MCI_NOTIFY_ABORTED = 4
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 'MCI Command 宣告

Public Sub MciSetPosition(tmpLeft As Long, tmpTop As Long, tmpWidth As Long, tmpHeight As Long)
    Dim tmpCmd As String
    tmpCmd = "put MCIDevice destination at " & Trim(Str(tmpLeft)) & " " & Trim(Str(tmpTop)) & " " & Trim(Str(tmpWidth)) & " " & Trim(Str(tmpHeight)) 
    mciSendString tmpCmd, vbNullString, 0, 0
End Sub


Public Sub MciClose()
    mciSendString "close MCIDevice", vbNullString, 0, 0
End Sub

Public Sub MciConfig()
    mciSendString "configure MCIDevice", vbNullString, 0, 0
End Sub

Public Sub MciStop()
    mciSendString "stop MCIDevice", vbNullString, 0, 0
End Sub

Public Function MciState() As String
    Dim strState As String
    strState = String(256, Chr(0))
    mciSendString "status MCIDevice mode", strState, Len(strState), 0
    MciState = Left(strState, 7)
End Function

Public Sub MciSetAudioRight()
    mciSendString "setaudio MCIDevice source to right", vbNullString, 0, 0
End Sub

Public Sub MciSetAudioLeft()
    mciSendString "setaudio MCIDevice source to left", vbNullString, 0, 0
End Sub

Public Sub MciSetAudioStereo()
    mciSendString "setaudio MCIDevice source to stereo", vbNullString, 0, 0
End Sub

Public Sub MciSetAudioStream1()
    mciSendString "setaudio MCIDevice stream to 1", vbNullString, 0, 0
End Sub

Public Sub MciSetAudioStream2()
    mciSendString "setaudio MCIDevice stream to 2", vbNullString, 0, 0
End Sub

Public Sub MciPause()
    mciSendString "pause MCIDevice", vbNullString, 0, 0
End Sub

Public Sub MciResume()
    mciSendString "resume MCIDevice", vbNullString, 0, 0
End Sub

Public Function MciStatusAudioStreams() As Integer
    Dim strState As String
    strState = String(256, Chr(0))
    mciSendString "status MCIDevice audio streams", strState, Len(strState), 0
    MciStatusAudioStreams = CInt(strState)
End Function

Public Sub MciRewind() 'Rewind
    Dim strCurr As String
    Dim strLeng As String
    strLeng = String(256, Chr(0))
    strCurr = String(256, Chr(0))
   
    mciSendString "status MCIDevice length", strLeng, Len(strLeng), 0
    mciSendString "status MCIDevice position", strCurr, Len(strCurr), 0
    If Val(strCurr) - 500 > 0 Then
        mciSendString "play MCIDevice from " & Val(strCurr) - 500 & " notify", vbNullString, 0, frmControl.hWnd
    Else
         mciSendString "play MCIDevice from 0 notify", vbNullString, 0, frmControl.hWnd     
    End If
End Sub

Public Sub MciForward() 'Forward
    Dim strCurr As String
    Dim strLeng As String
    strLeng = String(256, Chr(0))
    strCurr = String(256, Chr(0))
   
    mciSendString "status MCIDevice length", strLeng, Len(strLeng), 0
    mciSendString "status MCIDevice position", strCurr, Len(strCurr), 0
    If Val(strLeng) - Val(strCurr) > 500 Then
        mciSendString "play MCIDevice from " & Val(strCurr) + 500 & " notify", vbNullString, 0, frmControl.hWnd
    End If
   
End Sub

Public Sub MciSetVolume(ByVal Inputvalue As Integer)
    mciSendString "setaudio MCIDevice volume to " & Inputvalue, vbNullString, 0, 0
End Sub

Public Sub MciSetAudioOff()
    mciSendString "setaudio MCIDevice off", vbNullString, 0, 0
End Sub

Public Sub MciSetAudioOn()
    mciSendString "setaudio MCIDevice on", vbNullString, 0, 0
End Sub

Public Function MciPlay(tmpHwnd As Long, Optional tmpRepeat As Boolean = False) As Long
    Dim tmpResult As Long
    If tmpRepeat = True Then
        tmpResult = mciSendString("play MCIDevice repeat", vbNullString, 0, tmpHwnd)
    Else
        tmpResult = mciSendString("play MCIDevice notify", vbNullString, 0, tmpHwnd)
    End If
    MciPlay = tmpResult
End Function

Public Sub MciSetWindow(tmpHwnd As Long, Optional tmpStateHide As Boolean = False)
    If tmpStateHide = True Then
        mciSendString "window MCIDevice state hide handle " & Trim(Str(tmpHwnd)), vbNullString, 0, 0
    Else
        mciSendString "window MCIDevice handle " & Trim(Str(tmpHwnd)), vbNullString, 0, 0
    End If
End Sub

Public Function MciOpen(tmpFileName As String) As Long
    Dim tmpResult As Long
    mciSendString "close MCIDevice", vbNullString, 0, 0
    tmpResult = mciSendString("open " & tmpFileName & " type MpegVideo alias MCIDevice", vbNullString, 0, 0)
    MciOpen = tmpResult   
End Function