Startseite / Tipps / VB 5/6-Tipp 0087: AVIs mit dem MMP abspielen

VB 5/6-Tipp 0087: AVIs mit dem MMP abspielen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente ' (mci32.ocx)' wird benötigt.
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Multimediacontrol "MMControl1"
' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command4"
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Optionsfeld-Steuerelement "Option3" auf Frame1
' Steuerelement: Kontrollkästchen-Steuerelement "Check1" auf Frame1
' Steuerelement: Optionsfeld-Steuerelement "Option2" auf Frame1
' Steuerelement: Optionsfeld-Steuerelement "Option1" auf Frame1
' Steuerelement: Kontrollkästchen-Steuerelement "Check2" auf Frame1
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label6"
' Steuerelement: Beschriftungsfeld "Label5"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" _
        Alias "mciSendStringA" (ByVal lpstrCommand As _
        String, ByVal lpstrReturnString As Any, ByVal _
        uReturnLength As Long, ByVal hwndCallback As _
        Long) As Long

Private Declare Function mciSendCommand Lib "winmm.dll" _
        Alias "mciSendCommandA" (ByVal wDeviceID As Long, _
        ByVal uMessage As Long, ByVal dwParam1 As Long, _
        dwParam2 As MCI_OVLY_RECT_PARMS) As Long

Private Declare Function GetShortPathName Lib "kernel32" _
        Alias "GetShortPathNameA" (ByVal lpszLongPath As _
        String, ByVal lpszShortPath As String, ByVal _
        cchBuffer As Long) As Long
        
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type MCI_OVLY_RECT_PARMS
  dwCallback As Long
  rc As RECT
End Type

Const MCI_OVLY_WHERE_SOURCE = &H20000
Const MCI_OVLY_WHERE_DESTINATION = &H40000
Const MCI_WHERE = &H843

Dim Play As Boolean

Private Sub Form_Load()
  MMControl1.Wait = True
  MMControl1.UpdateInterval = 50
  MMControl1.hWndDisplay = Picture1.hWnd
  Picture1.ScaleMode = 3
  Timer1.Interval = 50
End Sub

Private Sub Form_Unload(Cancel As Integer)
  MMControl1.Command = "stop"
  MMControl1.Command = "close"
End Sub

Private Sub Command1_Click()
  MMControl1.Command = "stop"
  MMControl1.Command = "close"
  Play = False
  
  CommonDialog1.Filter = ("VB-Dateien (*.avi)|*.avi;")
  CommonDialog1.InitDir = App.Path
  CommonDialog1.ShowOpen
  
  If CommonDialog1.filename <> "" Then
    MMControl1.DeviceType = "avivideo"
    MMControl1.filename = CommonDialog1.filename
    MMControl1.Command = "open"
    MMControl1.Notify = True
    Label4.Caption = MMControl1.Length

    If Check2.Value = vbChecked And Option2 Then
      Call AdaptPicture
    End If
    
    If Option3.Value Then Call Option3_Click
    Me.Caption = CommonDialog1.filename
  End If
End Sub

Private Sub Command2_Click()
  If Not Option3.Value Then
    If Play = False And MMControl1.filename <> "" Then
      MMControl1.Command = "play"
      Play = True
    End If
  Else
    Call Option3_Click
  End If
End Sub

Private Sub Command3_Click()
  Play = False
  MMControl1.Command = "stop"
End Sub

Private Sub Command4_Click()
  MMControl1.Command = "pause"
End Sub

Private Sub MMControl1_Done(NotifyCode As Integer)
  If Play And Check1.Value = vbChecked Then
    Play = False
    MMControl1.Command = "stop"
    MMControl1.Command = "prev"
    MMControl1.Command = "play"
    Play = True
  End If
End Sub

Private Sub MMControl1_StatusUpdate()
  Label2.Caption = MMControl1.Position
End Sub

Private Sub Option1_Click()
  Check1.Enabled = True
  Check2.Enabled = False
  MMControl1.hWndDisplay = 0
End Sub

Private Sub Option2_Click()
  Check1.Enabled = True
  Check2.Enabled = True
  MMControl1.hWndDisplay = Picture1.hWnd
End Sub

Private Sub Option3_Click()
  Dim R&, AA$
    Check1.Enabled = False
    Check2.Enabled = False
    MMControl1.Command = "stop"
    Play = False
    
    AA = Space$(255)
    R = GetShortPathName(CommonDialog1.filename, AA, Len(AA))
    AA = Mid$(AA, 1, R)
    R = mciSendString("play " & AA & " fullscreen ", 0&, 0, 0&)
End Sub

Private Sub Check2_Click()
  If Check2.Value = vbChecked And MMControl1.filename <> "" Then
    Call AdaptPicture
  End If
End Sub

Private Sub Timer1_Timer()
  Dim x%, AA$
    x = MMControl1.Mode
    Select Case x
      Case 524: AA = "NotOpen"
      Case 525: AA = "Stop"
      Case 526: AA = "Play"
      Case 527: AA = "Record"
      Case 528: AA = "Seek"
      Case 529: AA = "Pause"
      Case 530: AA = "Ready"
    End Select
    Label6.Caption = AA
End Sub

Private Sub AdaptPicture()
  Dim Result&, Par As MCI_OVLY_RECT_PARMS
    
    Par.dwCallback = MMControl1.hWnd
    Result = mciSendCommand(MMControl1.DeviceID, _
             MCI_WHERE, MCI_OVLY_WHERE_SOURCE, Par)
    If Result <> 0 Then
      MsgBox ("Fehler")
    Else
      Picture1.Width = (Par.rc.Right - Par.rc.Left) * 15 + 4 * 15
      Picture1.Height = (Par.rc.Bottom - Par.rc.Top) * 15 + 4 * 15
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 13 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.