Deklaration: Declare Function SendMessage Lib "user32.dll" _ Alias "SendMessageA" ( _ ByVal hWnd As Long, _ ByVal Msg As Long, _ wParam As Any, _ lParam As Any) As Long Beschreibung: Parameter:
hWnd Konstanten: ' Nachricht an alle TopLevel-Fenster verschicken Const HWND_BROADCAST = &HFFFF Rückgabewert: Beispiel: ' Fügen Sie nachfolgenden Code in ein Formular ' mit einem CommandButton (Command1) ein: Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" ( _ lpbi As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" ( _ ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Private Type BROWSEINFO hwndOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Type SHITEMID cbSize As Integer abID As String * 256 End Type Private Type ITEMIDLIST mkid As SHITEMID End Type ' Nur Computer als Auswahl erlaubt. Wenn der Anwender andere ' Ordner markiert, kann der OK-Schalter nicht ausgewählt ' werden. Private Const BIF_BROWSEFORCOMPUTER = &H1000 ' Nur Drucker als Auswahl erlaubt. Wenn der Anwender andere ' Ordner markiert, kann der OK-Schalter nicht ausgewählt ' werden. Private Const BIF_BROWSEFORPRINTER = &H2000 ' Der Dialog zeigt neben den Ordnern auch Dateien. Private Const BIF_BROWSEINCLUDEFILES = &H4000 ' Der Dialog zeigt keine Netzwerkordner unterhalb der ' aktuellen Domain. Private Const BIF_DONTGOBELOWDOMAIN = &H2 ' Nur Dateisystemobjekte als Auswahl erlaubt. Wenn der ' Anwender andere Ordner markiert, kann der OK-Schalter ' nicht ausgewählt werden. Private Const BIF_RETURNFSANCESTORS = &H8 ' Nur Dateisystemordner als Auswahl erlaubt. Wenn der ' Anwender andere Ordner markiert, kann der OK-Schalter ' nicht ausgewählt werden. Private Const BIF_RETURNONLYFSDIRS = &H1 ' Der Dialog enthält eine Statuszeile. Die Rückruffunktion ' kann die Statuszeile ausfüllen Private Const BIF_STATUSTEXT = &H4 ' (Win 2000) Zeigt ein neuen Dialog an mit mehr ' benutzerfreundlichen Änderungen Const BIF_USENEWUI = &H40 ' (ab IE 4.0) Sendet an die Callback Funktion eine ' BFFM_VALIDATEFAILED Message, wenn in der Textbox eine falsche ' Eingabe gemacht wurde Const BIF_VALIDATE = &H20 Private Sub Command1_Click() Dim BI As BROWSEINFO Dim Item As ITEMIDLIST Dim Retval As Long Dim RetStr As String * 256 ' Dialog-Eigenschaften und Vorgabewerte setzen With BI .hwndOwner = Me.hwnd .pszDisplayName = Space(260) .lpszTitle = "Ordner, in dem die Datei gespeichert werden soll:" .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_VALIDATE Or _ BIF_STATUSTEXT Or BIF_EDITBOX .lpfn = GetAddress(AddressOf BCallbackProc) End With ' Dialog aufrufen Retval = SHBrowseForFolder(BI) If Retval = 0 Then MsgBox "Es ist ein Fehler aufgetreten oder Sie haben " & _ " auf 'Abbrechen' geklickt." Exit Sub End If ' Ausgewählten Pfad ermitteln Retval = SHGetPathFromIDList(Retval, RetStr) If Retval = 0 Then MsgBox "Fehler beim Extrahieren des ausgewählten Pfades" Exit Sub End If MsgBox "Sie haben " & Left$(RetStr, InStr(1, RetStr, vbNullChar) - 1) & _ " ausgewählt.", , "Ordner..." ' Ressourcen wieder freigeben CoTaskMemFree Retval End Sub ' Den folgenden in ein Modul einfügen Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" ( _ ByVal pidl As Long, _ ByVal pszPath As String) As Long ' SendMessage SHBrowseForFolder-Messages ' -------------------------------------- ' Enabled den OK-Button, wenn lParam ungleich 0 ist, ' andernfalls wird der Button Disabled Private Const BFFM_ENABLEOK = &H465 ' Setzt die Selektierung auf einen Verzeichnisbaumeintrag ' lParam gibt hierbei den Pfad an und wParam muss ungleich 0 sein Private Const BFFM_SETSELECTION = &H466 ' Setzt den Staustext des Dialogs. ' lParam gibt den auszugebenden Text an Private Const BFFM_SETSTATUSTEXT = &H464 ' Callback Ereignis-Messages ' -------------------------- ' Dialog wurde initialisiert, lParam ist 0 Private Const BFFM_INITIALIZED = 1 ' Benutzer hat ein anderen Verzeichnisbaumeintrag gewählt Private Const BFFM_SELCHANGED = 2 ' (ab IE 4.0) Benutzer hat eine falsche Angabe ' in der Textbox des Dialogs gemacht Private Const BFFM_VALIDATEFAILED = 3 ' Dient der Ermittlung der AddressOf-Funktionsadresse ' von BrowsCallBack Public Function GetAddress(ByVal FuncAddress As Long) As Long GetAddress = FuncAddress End Function ' Hier treffen die Ereignisse des Dialogs ein Public Function BCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, _ ByVal lParam As Long, ByVal lpData As Long) As Long Dim Retval As Long Dim TmpSelected As String * 260 Static LastPath As String ' Ereignisse des Dialoges Select Case uMsg ' Dialog wird angezeigt Case BFFM_INITIALIZED ' Startordner festlegen SendMessage hwnd, BFFM_SETSELECTION, ByVal 1&, ByVal App.Path ' Benutzer wählt einen andern Ordner Case BFFM_SELCHANGED ' Ausgewählten Eintrag ermitteln SHGetPathFromIDList lParam, TmpSelected LastPath = Left$(TmpSelected, InStr(1, TmpSelected, vbNullChar) - 1) ' Ausgewählten Ordner in der Statuszeile anzeigen SendMessage hwnd, BFFM_SETSTATUSTEXT, ByVal 0&, ByVal _ "Sie haben " & LastPath & " gewählt." ' ungültige Eingabe in der Textbox des Dialogs Case BFFM_VALIDATEFAILED ' Letzten ausgewählten Ordner selektieren SendMessage hwnd, BFFM_SETSELECTION, ByVal 1&, ByVal LastPath End Select End Function Diese Seite wurde bereits 54.820 mal aufgerufen. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Buchempfehlung Tipp des Monats September 2024 Dieter Otter Übergabeparameter: String oder Array? Mit der IsArray-Funktion lässt sich prüfen, ob es sich bei einem Übergabeparameter an eine Prozedur um ein Array oder einer "einfachen" Variable handelt. sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||||
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. |