title image


Smiley Ordnerauswahldialog
Hi!



Beispiel von MS, die Adresse http://www.microsoft.com/germany/msdn/quickie/Browse.htm gibt es leider nicht mehr.



clsBrowse.cls

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

Persistable = 0 'NotPersistable

DataBindingBehavior = 0 'vbNone

DataSourceBehavior = 0 'vbNone

MTSTransactionMode = 0 'NotAnMTSObject

END

Attribute VB_Name = "clsBrowse"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"

Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

Option Explicit



' -----------------------------------------------------------------

'

' Ordnerauswahl-Dialog nutzen

'

' Beispielanwendung zum MSDN Quickie-Artikel unter

' http://www.microsoft.com/germany/msdn/quickie/Browse.htm

'

' HISTORY:

'

' 17.04.2000: Vorgabe von Verzeichnissen funktionierte unter

' Win95/98 nicht für Verzeichnisse außer den Wurzelverzeich-

' nissen eines Datenträgers (Änderung in BrowseForFolder).

'

' 07.03.2000: Ursprüngliche Version veröffentlicht.

'

' -----------------------------------------------------------------

'

' HINWEIS: Dieses Klassenmodul ist abhängig vom Modul modBrowse!

'

' Basiert mit auf einem Artikel in der Microsoft Knowledgebase:

'

' HOWTO: Select a Directory Without the Common Dialog Control

' Article ID: Q179497

' Diesen Artikel finden Sie in Ihrer MSDN Library oder online:

' http://support.microsoft.com/support/kb/articles/Q179/4/97.asp

'

' sowie der Dokumentation der Funktion SHBrowseForFolder im

' Platform-SDK der Microsoft Developer Network Library.

'

' -----------------------------------------------------------------

' Copyright © Mathias Schiffer für MSDN Deutschland 2000.

' Diese Anwendung dient ausschließlich dokumentierenden Zwecken.

' Jedwede Haftung wird ausgeschlossen. Geschützte Warenzeichen,

' Markennamen u.ä. werden anerkannt, ohne daß im Einzelfall

' eine besondere Kennzeichnung erfolgt.

' -----------------------------------------------------------------





' ------------------------- DEKLARATIONEN -------------------------



' Notwendige Typdeklaration



Private Type BROWSEINFO

hOwner As Long

StartPIDL As Long

pszDisplayName As String

lpszTitle As String

ulFlags As Long

lpfn As Long

lParam As Long

iImage As Long

End Type



Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type



Private Type ITEMIDLIST

mkid As Long

End Type





' Aufzählung für die bequeme Auswahl einer PIDL



Public Enum E_CSIDLS

CSIDL_DESKTOP = &H0

CSIDL_INTERNET = &H1

CSIDL_PROGRAMS = &H2

CSIDL_CONTROLS = &H3

CSIDL_PRINTERS = &H4

CSIDL_PERSONAL = &H5

CSIDL_FAVORITES = &H6

CSIDL_STARTUP = &H7

CSIDL_RECENT = &H8

CSIDL_SENDTO = &H9

CSIDL_BITBUCKET = &HA

CSIDL_STARTMENU = &HB

CSIDL_DESKTOPDIRECTORY = &H10

CSIDL_DRIVES = &H11

CSIDL_NETWORK = &H12

CSIDL_NETHOOD = &H13

CSIDL_FONTS = &H14

CSIDL_TEMPLATES = &H15

CSIDL_COMMON_STARTMENU = &H16

CSIDL_COMMON_PROGRAMS = &H17

CSIDL_COMMON_STARTUP = &H18

CSIDL_COMMON_DESKTOPDIRECTORY = &H19

CSIDL_APPDATA = &H1A

CSIDL_PRINTHOOD = &H1B

CSIDL_ALTSTARTUP = &H1D '' DBCS

CSIDL_COMMON_ALTSTARTUP = &H1E '' DBCS

CSIDL_COMMON_FAVORITES = &H1F

CSIDL_INTERNET_CACHE = &H20

CSIDL_COOKIES = &H21

CSIDL_HISTORY = &H22

End Enum



Public Enum E_BrowseOptions

BIF_RETURNONLYFSDIRS = &H1

BIF_DONTGOBELOWDOMAIN = &H2

BIF_STATUSTEXT = &H4

BIF_RETURNFSANCESTORS = &H8

BIF_EDITBOX = &H10 ' Ab Version 4.71 der shell32.dll

BIF_VALIDATE = &H20 ' Ab Version 5.0 der shell32.dll

BIF_BROWSEFORCOMPUTER = &H1000

BIF_BROWSEFORPRINTER = &H2000

BIF_BROWSEINCLUDEFILES = &H4000 ' Ab Version 4.71 der shell32.dll

' BIF_USENEWUI ' Ab Version 5.0 der shell32.dll

End Enum



' Deklaration notwendiger Konstanter:



Private Const WM_USER = &H400

Private Const MAX_PATH = 260

' Nachrichten vom Auswahldialog in BrowseCallbackProc

Private Const BFFM_INITIALIZED = 1

Private Const BFFM_SELCHANGED = 2

Private Const BFFM_VALIDATEFAILEDA = 3

Private Const BFFM_VALIDATEFAILEDW = 4

' Nachrichten an den Auswahldialog in BrowseCallbackProc

Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)

Private Const BFFM_SETSTATUSTEXTW = (WM_USER + 104)

Private Const BFFM_ENABLEOK = (WM_USER + 101)

Private Const BFFM_SETSELECTIONA = (WM_USER + 102)

Private Const BFFM_SETSELECTIONW = (WM_USER + 103)

' Konstante für LocalAlloc

Private Const LMEM_FIXED = &H0

Private Const LMEM_ZEROINIT = &H40

Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

' Konstante für SetWindowPos

Private Const SWP_NOSIZE = &H1

Private Const SWP_NOZORDER = &H4



' Deklaration notwendiger API-Funktionen:



Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long

Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long

Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo 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 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 SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long



' Ereignisse dieser Klasse:

Event DialogInit()

Event SelectionChanged(ByVal SelectedPath As String)

Event PathSelected(ByVal PathSelected As String, ByVal DisplayName As String)

Attribute PathSelected.VB_Description = "Wird gefeuert, wenn der Benutzer eienn gültigen Pfad ausgewählt und den ""OK""-Button des Dialogs betätigt hat."

Event DialogCancel()



' Private Variable für Eigenschaften:

Private m_hwndParent As Long

Private m_StartPIDL As Long

Private m_StartPath As String

Private m_Statustext As String

Private m_BrowseOptions As E_BrowseOptions

Private m_Title As String

Private m_Caption As String

Private m_DisplayName As String

Private m_Selection As String

Private m_x As Long

Private m_y As Long

Private m_hwnd As Long

Private m_PathSelected As String

Private m_PathDisplayName As String

Private m_UserCaption As String





' ------------------- EIGENSCHAFTEN-PROZEDUREN --------------------



Public Property Let hwndParent(ByVal New_hwndParent As Long)

Attribute hwndParent.VB_Description = "Legt fest, zu welchem Fenster der Dialog modal erscheinen soll."

m_hwndParent = New_hwndParent

End Property



Public Property Get hwndParent() As Long

hwndParent = m_hwndParent

End Property





Public Property Let StartPIDL(ByVal New_StartPIDL As E_CSIDLS)

Attribute StartPIDL.VB_Description = "Stellt die Möglichkeit zur Verfügung, statt eines Pfades eine PIDL-Konstante für das Verzeichnis einzusetzen, das bei Initialisierung des Dialogs markiert sein soll."

m_StartPIDL = New_StartPIDL

End Property



Public Property Get StartPIDL() As E_CSIDLS

StartPIDL = m_StartPIDL

End Property





Public Property Let StartPath(ByVal New_StartPath As String)

Attribute StartPath.VB_Description = "Legt den Pfad fest, der bei Initialisierung des Dialogs markiert sein soll."

m_StartPath = New_StartPath

End Property



Public Property Get StartPath() As String

StartPath = m_StartPath

End Property





Public Property Let Statustext(ByVal New_StatusText As String)

Attribute Statustext.VB_Description = "Legt den Statustext des Dialogs fest. Text sollte nicht mehr als eine Zeile im Dialog beanspruchen."



m_Statustext = New_StatusText



' Wird die Eigenschaft vor dem Einblenden des Dialogs belegt,

' werden die Einstellungen von BrowseOptions automatisch angeglichen.

If m_hwnd = 0 Then

If New_StatusText vbNullString Then

m_BrowseOptions = m_BrowseOptions Or BIF_STATUSTEXT

Else

m_BrowseOptions = m_BrowseOptions And Not BIF_STATUSTEXT

End If

End If



' Wenn der Dialog existiert: StatusText anzeigen, falls vorgesehen

If m_hwnd 0 And (m_BrowseOptions And BIF_STATUSTEXT) > 0 Then

SendMessage hwnd, BFFM_SETSTATUSTEXTA, 0, ByVal m_Statustext

End If



End Property



Public Property Get Statustext() As String

Statustext = m_Statustext

End Property





Public Property Let BrowseOptions(ByVal New_BrowseOptions As E_BrowseOptions)

Attribute BrowseOptions.VB_Description = "Setzt die Anzeige- und Auswahloptionen des Dialogs fest. Standardvorgabe: BIF_DONTGOBELOWDOMAIN + BIF_RETURNONLYFSDIRS"

m_BrowseOptions = New_BrowseOptions

End Property



Public Property Get BrowseOptions() As E_BrowseOptions

BrowseOptions = m_BrowseOptions

End Property





Public Property Let Title(ByVal New_Title As String)

Attribute Title.VB_Description = "Legt den Text fest, der dem Benutzer nähere Erkläuterungen zur Verfügung stellt."

Dim hWndStatic As Long



m_Title = New_Title



' Falls der Dialog bereits angezeigt wird, das erste "static"-Fenster suchen

If m_hwnd 0 Then

hWndStatic = FindWindowEx(m_hwnd, 0, "Static", vbNullString)

If hWndStatic 0 Then

SetWindowText hWndStatic, New_Title

End If

End If



End Property



Public Property Get Title() As String

Dim strTitle As String, lenTitle As Long, hWndStatic As Long



' Falls der Dialog bereits exisitiert:

' Ermitteln der Beschriftung des ersten "Static"-Fensters

If m_hwnd 0 Then

hWndStatic = FindWindowEx(m_hwnd, 0, "Static", vbNullString) ' Fenster suchen

If hWndStatic 0 Then ' Beschriftung ermitteln

strTitle = Leerzeichen(512)

lenTitle = GetWindowText(m_hwnd, strTitle, Len(strTitle))

If lenTitle > 0 Then

m_Title = Left$(strTitle, lenTitle)

Else

m_Title = vbNullString

End If

End If



End If



Title = m_Title



End Property





Public Property Let x(ByVal New_x As Long)

Attribute x.VB_Description = "x-Position der linken oberen Ecke des Dialogs in Pixelskala, bezogen auf den Bildschirm."

m_x = New_x

SetDialogPosition

End Property



Public Property Get x() As Long

Dim WindowRect As RECT



' Falls der Dialog existiert: x-Koordinate dem Fenster entnehmen

If hwnd 0 Then

GetWindowRect hwnd, WindowRect

m_x = WindowRect.Left

End If



x = m_x



End Property





Public Property Let y(ByVal New_y As Long)

Attribute y.VB_Description = "y-Position der linken oberen Ecke des Dialogs in Pixelskala, bezogen auf den Bildschirm."

m_y = New_y

SetDialogPosition

End Property



Public Property Get y() As Long

Dim WindowRect As RECT



' Falls der Dialog existiert: y-Koordinate dem Fenster entnehmen

If hwnd 0 Then

GetWindowRect hwnd, WindowRect

m_y = WindowRect.Top

End If



y = m_y



End Property





Public Property Let Caption(ByVal New_Caption As String)

Attribute Caption.VB_Description = "Fenstertitel des Dialogs."



m_Caption = New_Caption

m_UserCaption = New_Caption



' Falls der Dialog exisitiert: Setzen der Caption des Dialogfensters

If m_hwnd 0 Then SetWindowText m_hwnd, m_Caption



End Property





Public Property Get Caption() As String

Dim strCaption As String, lenCaption As Long



If m_hwnd 0 Then

' Falls der Dialog exisitiert: Ermitteln der Caption des Dialogfensters

strCaption = Leerzeichen(512)

lenCaption = GetWindowText(m_hwnd, strCaption, Len(strCaption))

If lenCaption > 0 Then

m_Caption = Left$(strCaption, lenCaption)

Else

m_Caption = vbNullString

End If

End If



Caption = m_Caption



End Property





Public Property Get hwnd() As Long

Attribute hwnd.VB_Description = "Gibt das Fensterhandle des Dialogs zurück, wenn der Dialog existiert."

hwnd = m_hwnd

End Property





' ----------------------------- CODE ------------------------------



Public Sub SetDialogPosition()

' Positioniert das Dialogfenster

Dim WindowRect As RECT



' Falls der Dialog exisitiert: Positionieren des Dialogfensters

If m_hwnd 0 Then

GetWindowRect m_hwnd, WindowRect ' Ermitteln der derzeitigen Position

If m_x > -1 Then WindowRect.Left = m_x ' Falls m_x gesetzt ist, diesen Wert verwenden

If m_y > -1 Then WindowRect.Top = m_y ' Falls m_y gesetzt ist, diesen Wert verwenden

SetWindowPos m_hwnd, 0, WindowRect.Left, WindowRect.Top, 0, 0, SWP_NOSIZE Or SWP_NOZORDER ' Fenster positionieren

End If



End Sub





Public Function BrowseForFolder() As String

Attribute BrowseForFolder.VB_Description = "Ruft den Dialog auf."

Attribute BrowseForFolder.VB_UserMemId = 0

' Initiiert die Anzeige des Dialogs.

' Diese Funktion ist die Standardfunktion der Klasse.

' Rückgabewert: Gewählter Pfad, bei Abbruch vbNullString.

Dim tBrowseInfo As BROWSEINFO

Dim lpIDList As Long, lpStartPath As Long, sPathUsed As String



' StartPath muss mit einem Backslash enden:

sPathUsed = m_StartPath



' Rootverzeichnisse benötigen einen abschließenden Backslash,

' andere Verzeichnisse dürfen (unter Win95/98) keinen abschließenden

' Backslash haben (Update vom 17.04.2000):

If Len(sPathUsed) > 2 And Right$(sPathUsed, 1) = "\" Then _

sPathUsed = Left$(sPathUsed, Len(sPathUsed) - 1)

If Len(sPathUsed) < 3 Then sPathUsed = sPathUsed & "\"



' Für den StartPath einen Speicherbereich allozieren und den

' StartPath darin eintragen. Der Beginn dieses Speicherbereichs

' wird als benutzerdefinierter Wert an tBrowseInfo.lParam übergeben:

lpStartPath = LocalAlloc(LPTR, Len(sPathUsed))

MoveMemory ByVal lpStartPath, ByVal sPathUsed, Len(sPathUsed)



' Belegen der BROWSEINFO-Struktur

With tBrowseInfo

.hOwner = m_hwndParent

.StartPIDL = m_StartPIDL

.pszDisplayName = Leerzeichen(MAX_PATH)

.lpszTitle = m_Title

.lpfn = AddressOfFunction(AddressOf BrowseCallbackProc)

.lParam = lpStartPath

.ulFlags = m_BrowseOptions

End With



' Öffentliche Variable ClassObject erhält Referenz

' aus die aktuelle Instanz der Klasse für Rückmeldungen

Set ClassObject = Me



' Den Auswahldialog anzeigen

lpIDList = SHBrowseForFolder(tBrowseInfo) ' Modal



' Dialog ist jetzt nicht mehr vorhanden

m_hwnd = 0

Set ClassObject = Nothing



' Den für StartPath allozierten Speicher wieder freigeben

LocalFree lpStartPath



' Ausgewähltes Element ermitteln (soweit gegeben)

m_PathSelected = GetPathFromIDList(lpIDList)

If Len(m_PathSelected) > 0 Then

m_PathDisplayName = Left$(tBrowseInfo.pszDisplayName, InStr(tBrowseInfo.pszDisplayName, vbNullChar) - 1)

Else

m_PathDisplayName = vbNullString

End If



' Den Pointer auf die IDList freigeben

CoTaskMemFree lpIDList



' Ereignis feuern, falls ein Pfad gewählt wurde (bzw. Abbruch als Ereignis feuern)

If m_PathSelected vbNullString Then

RaiseEvent PathSelected(m_PathSelected, m_PathDisplayName)

Else

RaiseEvent DialogCancel

End If



' Gewählten Pfad zusätzlich als Rückgabewert setzen

BrowseForFolder = m_PathSelected



End Function





Private Function GetPathFromIDList(ByVal lpIDList As Long) As String

' Ermittelt den korrespondierenden Pfad eines IDList-Pointers

Dim sBuffer As String



' Prüfen, ob ein Element ausgewählt wurde

If lpIDList 0 Then

sBuffer = Leerzeichen(MAX_PATH)

SHGetPathFromIDList lpIDList, sBuffer

GetPathFromIDList = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)

End If



End Function





Private Function AddressOfFunction(ByVal lngAddress As Long) As Long

' Der AdressOf-Operator ist nur als Funktionsparameter einsetzbar.

' Um an tBrowseInfo.lpfn die Adresse der Prozedur BrowseCallbackProc

' übergeben zu können, wird hiermit diese Beschränkung vermieden.

AddressOfFunction = lngAddress

End Function





Public Sub EnableOK(ByVal Enabled As Boolean)

' Setzt den Enabled-Zustand des OK-Buttons des Dialogs.

If m_hwnd 0 Then SendMessage m_hwnd, BFFM_ENABLEOK, 0, ByVal Enabled

End Sub





' -----------------------------------------------------------------





Private Sub Class_Initialize()



' Initiale Position des Dialogs: Wie vom Betriebssystem vorgesehen

m_x = -1

m_y = -1



' BrowseOptions vordefinieren

m_BrowseOptions = BIF_DONTGOBELOWDOMAIN + BIF_RETURNONLYFSDIRS



End Sub





' ---- Versteckte Hilfsfunktionen und -eigenschaften ----





Public Property Get UserCaption()

Attribute UserCaption.VB_MemberFlags = "40"

' Da die Abfrage der Caption-Eigenschaft den aktuellen Text

' aus dem Fenster ausliest, sofern es existiert, wird fuer

' das Modul eine Möglichkeit benötigt, den vom Benutzer angegebenen

' Text abzufragen. Diese Eigenschaft ist im Objektkatalog versteckt.

UserCaption = m_UserCaption

End Property





Public Sub RaiseSelectionChanged(ByVal ID As Long)

Attribute RaiseSelectionChanged.VB_MemberFlags = "40"

' Wird benötigt, um vom Modul aus das Ereignis auslösen zu können.

' Diese Prozedur ist im Objektkatalog versteckt.

RaiseEvent SelectionChanged(GetPathFromIDList(ID))

End Sub





Public Sub RaiseDialogInit()

Attribute RaiseDialogInit.VB_MemberFlags = "40"

' Wird benötigt, um vom Modul aus das Ereignis auslösen zu können.

' Diese Prozedur ist im Objektkatalog versteckt.

RaiseEvent DialogInit

End Sub



Public Property Let hwndDialog(ByVal New_hwnd As Long)

Attribute hwndDialog.VB_MemberFlags = "40"

' Ermöglicht es dem Modul, den hwnd-Wert für den Dialog

' an die Klasseninstanz zu übergeben, ohne die hwnd-Eigenschaft

' als nicht schreibgeschützt zu exponieren.

' Diese Prozedur ist im Objektkatalog versteckt.

m_hwnd = New_hwnd

End Property



modBrowse.bas

Attribute VB_Name = "modBrowse"

Option Explicit



Private Const WM_USER = &H400

Private Const MAX_PATH = 260

' Nachrichten vom Auswahldialog in BrowseCallbackProc

Private Const BFFM_INITIALIZED = 1

Private Const BFFM_SELCHANGED = 2

Private Const BFFM_VALIDATEFAILEDA = 3

Private Const BFFM_VALIDATEFAILEDW = 4

' Nachrichten an den Auswahldialog in BrowseCallbackProc

Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)

Private Const BFFM_SETSTATUSTEXTW = (WM_USER + 104)

Private Const BFFM_ENABLEOK = (WM_USER + 101)

Private Const BFFM_SETSELECTIONA = (WM_USER + 102)

Private Const BFFM_SETSELECTIONW = (WM_USER + 103)

' Konstante für LocalAlloc

Private Const LMEM_FIXED = &H0

Private Const LMEM_ZEROINIT = &H40

Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

' Konstante für SetWindowPos

Private Const SWP_NOSIZE = &H1

Private Const SWP_NOZORDER = &H4



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 SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long

Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long



Public ClassObject As clsBrowse

Public lpData As Long



Public Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long



If ClassObject Is Nothing Then Exit Function ' Zur Sicherheit



Select Case uMsg



Case BFFM_INITIALIZED ' Der Auswahldialog wird initialisiert



' hwnd merken (wird bei Ende des Dialogs zu 0 gesetzt)

ClassObject.hwndDialog = hwnd



' Ereignis DialogInit feuern

ClassObject.RaiseDialogInit



' Dialog ggf. positionieren

ClassObject.SetDialogPosition



' Die Auswahl auf das vordefinierte Verzeichnis setzen:

' Unterscheidung: Ist eine PIDL angegeben, wird wParam False, lParam die PIDL

' Ist ein Pfad angegeben, wird wParam True, lParam der Pfad

SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal StrFromPtrA(lpData)



Case BFFM_SELCHANGED ' Die Auswahl des Benutzers hat sich geändert



ClassObject.RaiseSelectionChanged lParam



End Select



SetDialogProperties lParam 'Statustext, Caption und Position setzen



End Function





Private Function StrFromPtrA(ByVal lpString As Long) As String

Dim sReturn As String

sReturn = String$(lstrlenA(ByVal lpString), 0)

lstrcpyA ByVal sReturn, ByVal lpString

StrFromPtrA = sReturn

End Function



Private Function SetDialogProperties(ByVal lParam As Long)

'Statustext, Caption und Position setzen



If ClassObject.hwnd 0 Then



' Statustext setzen

SendMessage ClassObject.hwnd, BFFM_SETSTATUSTEXTA, 0, ByVal ClassObject.Statustext



' Fenstertitel ggf. setzen:

If ClassObject.UserCaption vbNullString Then SetWindowText ClassObject.hwnd, ClassObject.UserCaption



End If



End Function



frmMain.frm

VERSION 5.00

Begin VB.Form frmMain

Caption = "MSDN Quickie: BrowseForFolders-Demo"

ClientHeight = 3195

ClientLeft = 2325

ClientTop = 2115

ClientWidth = 4635

Icon = "frmMain.frx":0000

LinkTopic = "Form1"

ScaleHeight = 3195

ScaleWidth = 4635

Begin VB.FileListBox File1

Height = 3015

Hidden = -1 'True

Left = 50

System = -1 'True

TabIndex = 1

Top = 120

Width = 3135

End

Begin VB.CommandButton cmdSelectDir

Caption = "Ordner&auswahl"

Height = 375

Left = 3240

TabIndex = 0

Top = 120

Width = 1335

End

End

Attribute VB_Name = "frmMain"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Explicit



Private WithEvents Browse As clsBrowse

Attribute Browse.VB_VarHelpID = -1



' Ereignisse der Klasse clsBrowse:



Private Sub Browse_DialogInit()

' Wird beim Initialisieren des Dialogs gefeuert.

Debug.Print "Browse_DialogInit"

End Sub



Private Sub Browse_PathSelected(ByVal PathSelected As String, ByVal DisplayName As String)

' Wird bei Betätigung des "OK"-Buttons des Dialogs gefeuert.

Debug.Print "Browse_PathSelected: PathSelected = '" & PathSelected & "', DisplayName = '" & DisplayName & "'"

End Sub



Private Sub Browse_DialogCancel()

' Wird bei Betätigung des "Abbrechen"-Buttons des Dialogs gefeuert.

Debug.Print "Browse_DialogCancel"

End Sub



Private Sub Browse_SelectionChanged(ByVal SelectedPath As String)

' Wird gefeuert, wenn der Benutzer die aktuelle Pfadauswahl im Dialog ändert.

Debug.Print "Browse_SelectionChanged: SelectedPath = '" & SelectedPath & "'"

Browse.StatusText = "Auswahl: " & IIf(SelectedPath vbNullString, SelectedPath, "(keine)")

End Sub





Private Sub cmdSelectDir_Click()

Dim GewaehlterPfad As String



Set Browse = New clsBrowse



With Browse

.Caption = "Ordnerauswahl"

.Title = "Bitte wählen Sie einen Ordner aus!"

.StatusText = "Auswahl:"

.BrowseOptions = BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT + BIF_RETURNONLYFSDIRS

.StartPath = "c:\"

.x = 200

.y = 100

.hwndParent = Me.hwnd

GewaehlterPfad = .BrowseForFolder()

End With



Set Browse = Nothing



' Ergbnis der Auswahl präsentieren

If GewaehlterPfad vbNullString Then ' Es wurde ein Ordner ausgewählt



MsgBox "Sie haben den Ordner" & vbCrLf & _

GewaehlterPfad & vbCrLf & "ausgewählt." & vbCrLf & _

vbCrLf & "Die Dateien dieses Ordners werden jetzt in " & _

"der Dateilistbox aufgeführt.", vbInformation, "clsBrowse-Beispiel"



' Dateien des gewählten Pfades im DirListBox-Control darstellen:

File1.Path = GewaehlterPfad



Else



MsgBox "Sie haben den Dialog mit dem 'Abbrechen'-Button verlassen.", vbInformation, "clsBrowse-Beispiel"



End If



End Sub



Private Sub Form_Load()

File1.Path = "C:\"

End Sub





MfG

Mr. S ICQ #67858520http://www.developersmanual.com/



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: