Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0368: Dateidialoge des CommonDialogs ohne Control nutzen

 von 

Beschreibung 

Der ComDlg kann auch ohne die gängige VB-Komponente, die im übrigen nur eine dünne Kapselung der zugehörigen DLL darstellt, "eingebunden" werden. Nämlich durch direktes Ansprechen der API. Hier am Beispiel der Dateidialoge dargestellt. Dies spart bei der Weitergabe des eigenen Programms Ressourcen und trägt zur Kompaktheit bei.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GetOpenFileNameA (GetOpenFileName), GetSaveFileNameA (GetSaveFileName)

Download:

Download des Beispielprojektes [3,44 KB]

'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 -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label2"

Option Explicit

Private Sub Command1_Click()
    Dim Filter As String, FileName As String
    Dim Flags As Long
  
    Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
            OFN_PATHMUSTEXIST
            
    Filter = "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0) & _
              "Module & Klassen (*.bas , *.cls)" & Chr$(0) & _
              "*.bas;*.cls" & Chr$(0) & Chr$(0)
    
    FileName = ShowOpen(Filter, Flags, Me.hWnd)
    
    Label1.Caption = FileName
End Sub

Private Sub Command2_Click()
    Dim Filter As String, FileName As String
    Dim Flags As Long
    
    Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
            OFN_PATHMUSTEXIST
            
    Filter$ = "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0) & _
              "Module & Klassen (*.bas , *.cls)" & Chr$(0) & _
              "*.bas;*.cls" & Chr$(0) & Chr$(0)
    
    FileName = ShowSave(Filter, Flags, Me.hWnd, "Test.txt")
    
    Label1.Caption = FileName
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) _
        As Long
        
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
        Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) _
        As Long

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

Public Const OFN_ALLOWMULTISELECT As Long = &H200&
Public Const OFN_CREATEPROMPT As Long = &H2000&
Public Const OFN_ENABLEHOOK As Long = &H20&
Public Const OFN_ENABLETEMPLATE As Long = &H40&
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80&
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400&
Public Const OFN_FILEMUSTEXIST As Long = &H1000&
Public Const OFN_HIDEREADONLY As Long = &H4&
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8&
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000&
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100&
Public Const OFN_OVERWRITEPROMPT As Long = &H2&
Public Const OFN_PATHMUSTEXIST As Long = &H800&
Public Const OFN_READONLY As Long = &H1&
Public Const OFN_SHAREAWARE As Long = &H4000&
Public Const OFN_SHAREFALLTHROUGH As Long = 2&
Public Const OFN_SHARENOWARN As Long = 1&
Public Const OFN_SHAREWARN As Long = 0&
Public Const OFN_SHOWHELP As Long = &H10&

Public Function ShowOpen(Filter As String, Flags As Long, hWnd As Long) As String
    Dim Buffer As String
    Dim Result As Long
    Dim ComDlgOpenFileName As OPENFILENAME
    
    Buffer = String$(128, 0)
    
    With ComDlgOpenFileName
        .lStructSize = Len(ComDlgOpenFileName)
        .hwndOwner = hWnd
        .Flags = Flags
        .nFilterIndex = 1&
        .nMaxFile = Len(Buffer)
        .lpstrFile = Buffer
        .lpstrFilter = Filter
    End With
    
    Result = GetOpenFileName(ComDlgOpenFileName)
    
    If Result <> 0 Then
        ShowOpen = Left$(ComDlgOpenFileName.lpstrFile, _
                   InStr(ComDlgOpenFileName.lpstrFile, _
                   Chr$(0)) - 1)
    End If
End Function

Public Function ShowSave(Filter As String, Flags As Long, _
                         hWnd As Long, FileName As String) As String
                           
    Dim Buffer As String
    Dim Result As Long
    Dim ComDlgOpenFileName As OPENFILENAME
    
    Buffer = FileName & String$(128 - Len(FileName), 0)
    
    With ComDlgOpenFileName
        .lStructSize = Len(ComDlgOpenFileName)
        .hwndOwner = hWnd
        .Flags = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST
        .nFilterIndex = 1&
        .nMaxFile = Len(Buffer)
        .lpstrFile = Buffer
        .lpstrFilter = Filter
    End With
    
    Result = GetSaveFileName(ComDlgOpenFileName)
    
    If Result <> 0 Then
        ShowSave = Left$(ComDlgOpenFileName.lpstrFile, _
                   InStr(ComDlgOpenFileName.lpstrFile, _
                   Chr$(0)) - 1)
    End If
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 16 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.

Kommentar von Matze am 12.04.2009 um 18:47

Der Tipp geht bei mir nicht. Es kommt kein Fehler und auch der Dialog erscheint nicht am Bildschirm.
Ich habe alle Verweise zu allen Objekten und zu allen Komponenten angeklickt und mein VB-Setup war schon fast 1 GB
groß und trotzdem ist es nicht gelaufen.

Kommentar von ThomasE am 12.03.2008 um 15:22

Wenn der Parameter OFN_ALLOWMULTISELECT angegeben wird, ändert sich der Stil des Dialogfensters (vom Explorer-Style in einen veralteten Style).
Das führt vor allem zu dem Problem, dass die Dateinamen stark verändert werden, da diese nur noch aus 8 Zeichen bestehen dürfen.

Um sowohl eine Mehrfachauswahl als auch den Explorer-Style verwenden zu können, muss noch zusätzlich der Parameter OFN_EXPLORER hinzugefügt werden.

Gruß,
Thomas

Kommentar von K Michael Hoja am 14.02.2008 um 10:13

Damit kann das OCX Control ersetzt werden. Gibt es diese
auch für den Rest des "CommonDialog" z.B das setzen von Farben.

Kommentar von Joe am 02.06.2006 um 10:50

Wenn ich bei ShowOpen diesen Parameter mit angebe (OFN_ALLOWMULTISELECT) erscheint ein komplett anders aufgebauter Dialog als vorher !?! (WinXP)

Kommentar von Roland Meier am 25.01.2005 um 19:13

Hallo,

wie erreich ich eine Aufforderung zum Ersetzen einer bereits gespeicherten Datei?

gibt es einen vergleichbaren Ersatz für den Wert Me.hWnd unter Excel 2000?

Gruß,

Roland Meier

Kommentar von Forty am 10.07.2003 um 11:35

hups jetzt macht er es auch mit speichern unter... sorry...

Kommentar von Forty am 10.07.2003 um 11:06

Das mit dem Titel hab ich hinbekommen, dass nicht mehr Öffnen sondern speichern unter da steht. Übrigens muss das statt lpszTitle, lpstrTitle heißen :-)
MEine Frag jetzt? wie bekomme ich die Schaltfläche so hin, das da auch speichern steht, statt öffnen?

Kommentar von Wolfgang Wolf am 20.05.2003 um 14:34

In der ShowSave akzeptiert Ihr Flags als Parameter, verwendet jedoch die Konstanten in der Prozedur.
Gruß, W. Wolf

Kommentar von Juergen am 09.01.2003 um 17:24

Hallo,

"FileName" liefert keine Daten, wenn der Pfad+Dateiname länger als 128 Zeichen ist. Kann das sein ?!

Kommentar von Juergen am 09.01.2003 um 17:12

Ging bei mir bisher unter W98. Jetz unter W2k und Wxp nicht mehr. Der "FileName" wird immer leer zurueckgeliefert.

Gruß,
Juergen.

Kommentar von lilagerd am 21.11.2002 um 16:13

Ausgezeichnet! Einfach köstlich...

Kommentar von PhilippVB am 12.12.2001 um 21:59

An 72dpi:
Du änderst einfach die lpszTitle-Eigenschaft der Struktur.
Also im With-Block:
With ComDlgOpenFileName
.lStructSize = Len(ComDlgOpenFileName)
.hwndOwner = hWnd
.Flags = ...
.nFilterIndex = 1
.nMaxFile = Len(Buffer)
.lpstrFile = Buffer
.lpstrFilter = Filter
.lpszTitle="Neuer Titel"
End With

Kommentar von 72dpi am 29.10.2001 um 14:51

Wie kann ich im öffnenden "Offnen", bzw. "Speichern unter" Dialog genau diese Fensterüberschriften verändern?
Anstatt "Öffnen" und "Speichern unter" soll die Form_Caption anders lauten.
Gruß
72dpi

Kommentar von Michael G. am 18.08.2001 um 22:41

wo gibts die die retlichen funktionen? gibs nicht dafür auch einen modul-ersatz?

Kommentar von Günter Frings am 19.05.2001 um 17:53

Nach Löschen eines downloads (zip) fehlen die Dateien deskcp16.dll und comdlg32.dll
Was nun ?

Kommentar von chicolatino am 23.03.2001 um 09:05

Ich möchte mitteilen das dieser Tip auch einwandfrei unter Access 2000 funktioniert, ausser das man statt dem Label ein Textfeld benutzt!