GetOpenFileNamePreview-Funktion Diese Funktion ruft den Standarddialog zum Öffnen einer Datei auf und bietet zusätzlich eine Vorschau für AVI-Videos.
Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinME	Views:  9.302

Deklaration:

Private Declare Function GetOpenFileNamePreview Lib "msvfw32.dll" ( _
  ByRef lpofn As OPENFILENAME) As Long

Beschreibung:
Diese Funktion ruft den Standarddialog zum Öffnen einer Datei auf und bietet zusätzlich eine Vorschau für AVI-Videos.

Parameter:

lpofn

Erwartet eine OPENFILE-Struktur, die gefüllt ist mit Initialisierungsdaten.

Rückgabewert:
Ist die Funktion erfolgreich, so ist die Rückgabe "ungleich 0", andernfalls wird "0" zurückgegeben.

Beispiel:

' schreiben Sie den folgenden Code in ein öffentliches Modul
Private Declare Function GetProfileString Lib "kernel32" _
  Alias "GetProfileStringA" ( _
  ByVal lpAppName As String, _
  ByVal lpKeyName As String, _
  ByVal lpDefault As String, _
  ByVal lpReturnedString As String, _
  ByVal nSize As Long) As Long
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
Private Declare Function mciGetErrorString Lib "winmm.dll" _
  Alias "mciGetErrorStringA" ( _
  ByVal dwError As Long, _
  ByVal lpstrBuffer As String, _
  ByVal uLength As Long) As Long
Private Declare Function GetShortPathNameA Lib "kernel32" ( _
  ByVal lpszLongPath As String, _
  ByVal lpszShortPath As String, _
  ByVal cchBuffer As Long) As Long
 
' die MCISendString Callback Konstanten
Private Const MM_MCINOTIFY = &H3B9 ' wird an die Standard-Fensterprozedur geschickt  
' Benachrichtigungs-Ereignisse
Private Const MCI_NOTIFY_ABORTED = &H4 ' Wiedergabe wurde abgebrochen
Private Const MCI_NOTIFY_FAILURE = &H8 ' ein Fehler ist bei dem Aufruf aufgetreten
Private Const MCI_NOTIFY_SUCCESSFUL = &H1 ' der Befehl wurde erfolgreich ausgeführt
Private Const MCI_NOTIFY_SUPERSEDED = &H2 ' ein anderes Gerät bekommt die  
' Nachrichten, das eigene Programm wird nicht mehr benachrichtigt
 
 
Private OpenAlias As Boolean
Private Const StdAlias = "TmpAlias"

' ermitteln aller Dateitypen, die mit den MCI-Treibern abgespielt werden sollen
Public Function GetMciFileTypes() As String
  Dim Retval As String, Buffer As String * 255, FileTypes As Variant
 
  ' erst einmal alle Dateitypen ermitteln
  Retval = GetProfileString("mci extensions", vbNullString, "*.*" & vbNullChar,  _
  Buffer, Len(Buffer))
  FileTypes = Split(Left$(Buffer, Retval), vbNullChar)
 
  ' jetzt die dazugehörigen Treiber identifizieren
  GetMciFileTypes = GetMciFileTypes & "*.* - Alle Dateien" & vbNullChar & "*.*"  _
  & vbNullChar
  For i = 0 To UBound(FileTypes) - 1
    Buffer = Space(256)
    Retval = GetProfileString("mci extensions", FileTypes(i), "" &  _
    vbNullChar, Buffer, Len(Buffer))
    GetMciFileTypes = GetMciFileTypes & "*." & FileTypes(i) & " - " &  _
    Left$(Buffer, Retval) & vbNullChar & "*." & FileTypes(i) & vbNullChar
  Next i
 
  ' und als String zurückgeben, so dass der CommonDialog diesen gleich verwenden kann 
  GetMciFileTypes = GetMciFileTypes & vbNullChar
End Function

' ermitteln eines Treibers für einen entsprechenden Dateityp
Private Function GetSingleType(ByVal Extension As String) As String
  Dim Retval As String, Buffer As String * 255
 
  Retval = GetProfileString("mci extensions", Right$(Extension, 3), "NotFound" &  _
  vbNullChar, Buffer, Len(Buffer))
  GetSingleType = Left$(Buffer, Retval)
End Function

' Fehlercode für einen erfolglosen Aufruf ermitteln
Private Function ErrMsg(ByVal Errorcode As Long)
  Dim Retval As String, Buffer As String * 256
 
  ' kein Fehler
  If Errorcode = 0 Then Exit Function
 
  ' Fehler in einer Messagebox ausgeben
  Retval = mciGetErrorString(Errorcode, Buffer, Len(Buffer))
  MsgBox Left$(Buffer, InStr(1, Buffer, vbNullChar) - 1), vbCritical +  _
  vbInformation, "Fehler " & CStr(Errorcode)
End Function

' öffnet eine Datei, falls nicht eine andere noch geöffnet ist
Public Function Mci_Open(ByVal FileName As String)
  Dim Buffer As String * 256
 
  If OpenAlias Then
    Mci_Close
  End If
  OpenAlias = True
 
  ' ermittelt den Dos-Pfadnamen; ist erforderlich weil MCI-Treiber Leerstellen  
  ' als Separator interpretieren
  Retval = GetShortPathNameA(FileName, Buffer, Len(Buffer))
  FileName = Left$(Buffer, Retval)
 
  ' öffnet ein Gerät und eine Multimedia-Datei
  ErrMsg mciSendString("open " & FileName & " type " & GetSingleType(FileName) &  _
  " alias " & StdAlias, 0, 0, 0)
 
  ' falls das Medium ein Video ist, die PictureBox als Anzeige verwenden
  mciSendString "window " & StdAlias & " handle " &  _
  CStr(Player_frm.Picture1.hWnd), 0, 0, 0
 
  ' Zeitformat wählen, das wir abfragen wollen
  mciSendString "Set " & StdAlias & " Time Format Milliseconds", 0, 0, 0
End Function

' schließen eines MCI-Treibers
Public Function Mci_Close()
  If Not OpenAlias Then Exit Function
  mciSendString "close " & StdAlias, 0, 0, 0
  OpenAlias = False
End Function

' starten der Wiedergabe von Position 0 aus
Public Function Mci_Play()
  If Not OpenAlias Then Exit Function
  ErrMsg mciSendString("play " & StdAlias & " from 0", 0, 0, 0)
End Function

' stoppen der Wiedergabe
Public Function Mci_Stop()
  If Not OpenAlias Then Exit Function
  mciSendString "stop " & StdAlias, 0, 0, 0
End Function

' ermitteln der aktuellen Abspielposition
Public Function Mci_GetPos() As Long
  Dim Pos As String * 256
  If Not OpenAlias Then Exit Function
 
  mciSendString "status " & StdAlias & " position", Pos, Len(Pos), 0&
  On Error Resume Next
  Mci_GetPos = Left$(Pos, InStr(1, Pos, vbNullChar) - 1)
End Function
 
 
 
' schreiben Sie diesen Code bitte in ein Formular und fügen sie ein Bildfeld, einen  Timer,
' 2 Commandbuttons und 3 Menüs in das Fenstermenü (Mnu_Open, Mnu_Close, Mnu_End) ein
Private Declare Function GetOpenFileNamePreview Lib "msvfw32.dll" ( _
  ByRef lpofn As OPENFILENAME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Const OFN_ALLOWMULTISELECT = &H200  ' Mehrfachauswahl wird unterstützt
Const OFN_CREATEPROMPT = &H2000  ' Dialog zum Erstellen einer Datei wird  
' eingeblendet, wenn die gewählte nicht existiert
Const OFN_ENABLEHOOK = &H20  ' aktiviert die Callback-Funktion Hook
Const OFN_ENABLESIZING = &H800000  ' (Win 2000) die Dialoggröße kann geändert werden
Const OFN_ENABLETEMPLATE = &H40  ' aktiviert Templates
Const OFN_ENABLETEMPLATEHANDLE = &H80  ' benutzt den vorgeladenen Dialog
Const OFN_EXPLORER = &H80000  ' der Diaolg hat den Explorer-Stil
Const OFN_EXTENSIONDIFFERENT = &H400  ' die Funktion setzt diese Konstante wenn eine  
' andre Dateiendung ausgewählt wurde als angegeben
Const OFN_FILEMUSTEXIST = &H1000  ' die Datei muss existieren
Const OFN_HIDEREADONLY = &H4  ' versteckt schreibgeschützte Dateien
Const OFN_LONGNAMES = &H200000  ' erlaubt lange Dateinamen
Const OFN_NOCHANGEDIR = &H8  ' wechselt nicht das Windowsverzeichnis
Const OFN_NODEREFERENCELINKS = &H100000  ' wenn eine Verknüpfung gewählt wird gibt  
' die Funktion die verknüpfte Datei zurück
Const OFN_NOLONGNAMES = &H40000  ' erlaubt nur Dos-Dateinamen
Const OFN_NONETWORKBUTTON = &H20000  ' versteckt den Netzwerk Button
Const OFN_NOREADONLYRETURN = &H8000  ' die Funktion setzt dieses Flag, wenn die Datei  
' nicht schreibgeschützt ist.
Const OFN_NOTESTFILECREATE = &H10000  ' um ein Laufwerk auf seine Schreibfähigkeit  
' zu prüfen, wird eine Testdatei geschrieben, dieses wird damit verhindert
Const OFN_NOVALIDATE = &H100  ' überprüft den Dateinamen nicht auf gültige Zeichen
Const OFN_OVERWRITEPROMPT = &H2  ' blendet einen Dialog zum Überschreiben einer  
' Datei ein
Const OFN_PATHMUSTEXIST = &H800  ' Der Pfad muss existieren
Const OFN_READONLY = &H1  ' aktiviert das Häkchen in der Checkbox "mit  
' Schreibschutz öffnen"
Const OFN_SHAREAWARE = &H4000  ' ignoriert ob Shared-Dateien ausgewählt werden
Const OFN_SHOWHELP = &H10 ' zeigt den Hilfe-Button an, bei einem Klick auf diesen  
' empfängt die Hook-Funktion die WM_HELP Message
 
Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

' starten der Wiedergabe
Private Sub Command1_Click()
  Mci_Play
End Sub

' stoppen der Wiedergabe
Private Sub Command2_Click()
  Mci_Stop
End Sub

' Treiber schließen und Datei entladen
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Mci_Close
End Sub

' schließen einer Multimedia Datei (Menü - Schließen)
Private Sub Mnu_Close_Click()
  Mci_Close
End Sub

' beenden des Programms (Menü - Beenden)
Private Sub Mnu_End_Click()
  Unload Me
End Sub

' öffnen und laden einer Multimedia-Datei (Menü - Öffnen)
Private Sub Mnu_Open_Click()
  Dim OF As OPENFILENAME, Retval As Long
 
  With OF
    .lStructSize = Len(OF)
    .hInstance = App.hInstance
     .hwndOwner = Me.hWnd
    .lpstrTitle = "Multimediadatei Öffnen"
    .lpstrFilter = GetMciFileTypes
    .lpstrFile = Space(512)
    .nMaxFile = 512
    .flags = OFN_EXPLORER
  End With
 
    ' Preview-Dialog anzeigen
  Retval = GetOpenFileNamePreview(OF)
  CloseHandle Retval
 
    ' falls Datei gewählt, dann die Datei mit dem Treiber öffnen
  If Retval << 0 Then
    Picture1.Cls
    Mci_Open Left$(OF.lpstrFile, InStr(1, OF.lpstrFile, vbNullChar) - 1)
  End If
End Sub

' abfragen der aktuellen Abspielposition
Private Sub Timer1_Timer()
  Dim Seconds As Long, Minutes As Long, Hours As Long
 
  ' Millisekunden in ein Stunden:Minuten:Sekunden-Format umrechnen
  Seconds = Fix(Mci_GetPos / 1000)
  Hours = (Seconds - (Seconds Mod 60)) / 60 / 60
  Minutes = (Seconds - (Hours * 60) - (Seconds Mod 60)) / 60
  Seconds = Seconds - (Hours * 60 * 60) - (Minutes * 60)
 
  ' Zeitformat im Labelfeld ausgeben
  Label1.Caption = Format(Hours, "00:") & Format(Minutes, "00:") &  _
  Format(Seconds, "00")
End Sub