vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Sch?tzen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Windows/System15.03.02
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, WinMEViews:  5.008 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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:

    lpofnErwartet 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

    Diese Seite wurde bereits 5.008 mal aufgerufen.

    nach obenzurück
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel