| 0,0 → 1,165 |
|---|
| unit BrowseFolder platform; |
| |
| {.$DEFINE USE_FILECTRL_FUNCTIONS} // not recommended! |
| |
| {$DEFINE USE_FORMS} // important |
| |
| interface |
| |
| uses |
| Windows, SysUtils, ShlObj, ActiveX |
| {$IFDEF USE_FILECTRL_FUNCTIONS}, FileCtrl{$ENDIF} |
| {$IFDEF USE_FORMS}, Forms{$ENDIF}; |
| |
| function MySelectDirectory(AMsg: string): string; |
| |
| implementation |
| |
| {$IFNDEF USE_FILECTRL_FUNCTIONS} |
| |
| { |
| This code shows the SelectDirectory dialog with additional expansions: |
| - an edit box, where the user can type the path name, |
| - also files can appear in the list, |
| - a button to create new directories. |
| |
| |
| Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen: |
| - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann, |
| - auch Dateien können in der Liste angezeigt werden, |
| - eine Schaltfläche zum Erstellen neuer Verzeichnisse. |
| |
| |
| Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=1802 |
| MODIFIED for AutoSFX! |
| } |
| |
| function AdvSelectDirectory(const Caption: string; const Root: WideString; |
| var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False; |
| AllowCreateDirs: Boolean = True): Boolean; |
| // callback function that is called when the dialog has been initialized |
| //or a new directory has been selected |
| |
| // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder |
| //ein neues Verzeichnis selektiert wurde |
| function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; |
| stdcall; |
| var |
| PathName: array[0..MAX_PATH] of Char; |
| begin |
| case uMsg of |
| // BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData)); |
| // include the following comment into your code if you want to react on the |
| //event that is called when a new directory has been selected |
| // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis |
| //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde |
| BFFM_SELCHANGED: |
| begin |
| SHGetPathFromIDList(PItemIDList(lParam), @PathName); |
| |
| if PathName = '' then |
| begin |
| SendMessage(Wnd, BFFM_ENABLEOK, 0, 0); |
| end; |
| |
| // the directory "PathName" has been selected |
| // das Verzeichnis "PathName" wurde selektiert |
| end; |
| end; |
| Result := 0; |
| end; |
| var |
| {$IFDEF USE_FORMS} |
| WindowList: Pointer; |
| {$ENDIF} |
| BrowseInfo: TBrowseInfo; |
| Buffer: PChar; |
| RootItemIDList, ItemIDList: PItemIDList; |
| ShellMalloc: IMalloc; |
| IDesktopFolder: IShellFolder; |
| Eaten, Flags: LongWord; |
| const |
| // necessary for some of the additional expansions |
| // notwendig für einige der zusätzlichen Erweiterungen |
| BIF_USENEWUI = $0040; |
| BIF_NOCREATEDIRS = $0200; |
| begin |
| Result := False; |
| if not DirectoryExists(Directory) then |
| Directory := ''; |
| FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); |
| if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then |
| begin |
| Buffer := ShellMalloc.Alloc(MAX_PATH); |
| try |
| RootItemIDList := nil; |
| if Root <> '' then |
| begin |
| SHGetDesktopFolder(IDesktopFolder); |
| IDesktopFolder.ParseDisplayName({$IFDEF USE_FORMS}Application.Handle{$ELSE}0{$ENDIF}, nil, |
| POleStr(Root), Eaten, RootItemIDList, Flags); |
| end; |
| OleInitialize(nil); |
| with BrowseInfo do |
| begin |
| hwndOwner := {$IFDEF USE_FORMS}Application.Handle{$ELSE}0{$ENDIF}; |
| pidlRoot := RootItemIDList; |
| pszDisplayName := Buffer; |
| lpszTitle := PChar(Caption); |
| // defines how the dialog will appear: |
| // legt fest, wie der Dialog erscheint: |
| ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or |
| BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or |
| BIF_NOCREATEDIRS * Ord(not AllowCreateDirs); |
| lpfn := @SelectDirCB; |
| if Directory <> '' then |
| lParam := Integer(PChar(Directory)); |
| end; |
| {$IFDEF USE_FORMS} |
| WindowList := DisableTaskWindows(0); |
| {$ENDIF} |
| try |
| ItemIDList := ShBrowseForFolder(BrowseInfo); |
| finally |
| {$IFDEF USE_FORMS} |
| EnableTaskWindows(WindowList); |
| {$ENDIF} |
| end; |
| Result := ItemIDList <> nil; |
| if Result then |
| begin |
| ShGetPathFromIDList(ItemIDList, Buffer); |
| ShellMalloc.Free(ItemIDList); |
| Directory := Buffer; |
| end; |
| finally |
| ShellMalloc.Free(Buffer); |
| end; |
| end; |
| end; |
| |
| {$ENDIF} |
| |
| function MySelectDirectory(AMsg: string): string; |
| begin |
| {$IFNDEF USE_FILECTRL_FUNCTIONS} |
| if not AdvSelectDirectory(AMsg, '', result, False, False, True) then |
| begin |
| result := ''; |
| Exit; |
| end; |
| {$ELSE} |
| // Nicht so gut: "Arbeitsplatz" etc nicht ausgegraut |
| if not SelectDirectory(AMsg, '', result, [sdNewUi, sdNewFolder]) then |
| begin |
| result := ''; |
| Exit; |
| end; |
| {$ENDIF} |
| |
| // Optional |
| result := IncludeTrailingPathDelimiter(result); |
| result := ExpandUNCFileName(result); |
| end; |
| |
| end. |