Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit BrowseFolder platform;
  2.  
  3. {.$DEFINE USE_FILECTRL_FUNCTIONS} // not recommended!
  4.  
  5. {$DEFINE USE_FORMS} // important
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, SysUtils, ShlObj, ActiveX
  11.   {$IFDEF USE_FILECTRL_FUNCTIONS}, FileCtrl{$ENDIF}
  12.   {$IFDEF USE_FORMS}, Forms{$ENDIF};
  13.  
  14. function MySelectDirectory(AMsg: string): string;
  15.  
  16. implementation
  17.  
  18. {$IFNDEF USE_FILECTRL_FUNCTIONS}
  19.  
  20. {
  21.   This code shows the SelectDirectory dialog with additional expansions:
  22.   - an edit box, where the user can type the path name,
  23.   - also files can appear in the list,
  24.   - a button to create new directories.
  25.  
  26.  
  27.   Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen:
  28.   - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann,
  29.   - auch Dateien können in der Liste angezeigt werden,
  30.   - eine Schaltfläche zum Erstellen neuer Verzeichnisse.
  31.  
  32.  
  33.   Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=1802
  34.   MODIFIED for AutoSFX!
  35. }
  36.  
  37. function AdvSelectDirectory(const Caption: string; const Root: WideString;
  38.   var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
  39.   AllowCreateDirs: Boolean = True): Boolean;
  40.   // callback function that is called when the dialog has been initialized
  41.   //or a new directory has been selected
  42.  
  43.   // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
  44.   //ein neues Verzeichnis selektiert wurde
  45.   function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
  46.     stdcall;
  47.   var
  48.     PathName: array[0..MAX_PATH] of Char;
  49.   begin
  50.     case uMsg of
  51. //      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
  52.       // include the following comment into your code if you want to react on the
  53.       //event that is called when a new directory has been selected
  54.       // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis
  55.       //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde
  56.       BFFM_SELCHANGED:
  57.       begin
  58.         SHGetPathFromIDList(PItemIDList(lParam), @PathName);
  59.  
  60.         if PathName = '' then
  61.         begin
  62.           SendMessage(Wnd, BFFM_ENABLEOK, 0, 0);
  63.         end;
  64.  
  65.         // the directory "PathName" has been selected
  66.         // das Verzeichnis "PathName" wurde selektiert
  67.       end;
  68.     end;
  69.     Result := 0;
  70.   end;
  71. var
  72.   {$IFDEF USE_FORMS}
  73.   WindowList: Pointer;
  74.   {$ENDIF}
  75.   BrowseInfo: TBrowseInfo;
  76.   Buffer: PChar;
  77.   RootItemIDList, ItemIDList: PItemIDList;
  78.   ShellMalloc: IMalloc;
  79.   IDesktopFolder: IShellFolder;
  80.   Eaten, Flags: LongWord;
  81. const
  82.   // necessary for some of the additional expansions
  83.   // notwendig für einige der zusätzlichen Erweiterungen
  84.   BIF_USENEWUI = $0040;
  85.   BIF_NOCREATEDIRS = $0200;
  86. begin
  87.   Result := False;
  88.   if not DirectoryExists(Directory) then
  89.     Directory := '';
  90.   FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  91.   if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  92.   begin
  93.     Buffer := ShellMalloc.Alloc(MAX_PATH);
  94.     try
  95.       RootItemIDList := nil;
  96.       if Root <> '' then
  97.       begin
  98.         SHGetDesktopFolder(IDesktopFolder);
  99.         IDesktopFolder.ParseDisplayName({$IFDEF USE_FORMS}Application.Handle{$ELSE}0{$ENDIF}, nil,
  100.           POleStr(Root), Eaten, RootItemIDList, Flags);
  101.       end;
  102.       OleInitialize(nil);
  103.       with BrowseInfo do
  104.       begin
  105.         hwndOwner := {$IFDEF USE_FORMS}Application.Handle{$ELSE}0{$ENDIF};
  106.         pidlRoot := RootItemIDList;
  107.         pszDisplayName := Buffer;
  108.         lpszTitle := PChar(Caption);
  109.         // defines how the dialog will appear:
  110.         // legt fest, wie der Dialog erscheint:
  111.         ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
  112.           BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
  113.           BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
  114.         lpfn    := @SelectDirCB;
  115.         if Directory <> '' then
  116.           lParam := Integer(PChar(Directory));
  117.       end;
  118.       {$IFDEF USE_FORMS}
  119.       WindowList := DisableTaskWindows(0);
  120.       {$ENDIF}
  121.       try
  122.         ItemIDList := ShBrowseForFolder(BrowseInfo);
  123.       finally
  124.         {$IFDEF USE_FORMS}
  125.         EnableTaskWindows(WindowList);
  126.         {$ENDIF}
  127.       end;
  128.       Result := ItemIDList <> nil;
  129.       if Result then
  130.       begin
  131.         ShGetPathFromIDList(ItemIDList, Buffer);
  132.         ShellMalloc.Free(ItemIDList);
  133.         Directory := Buffer;
  134.       end;
  135.     finally
  136.       ShellMalloc.Free(Buffer);
  137.     end;
  138.   end;
  139. end;
  140.  
  141. {$ENDIF}
  142.  
  143. function MySelectDirectory(AMsg: string): string;
  144. begin
  145.   {$IFNDEF USE_FILECTRL_FUNCTIONS}
  146.   if not AdvSelectDirectory(AMsg, '', result, False, False, True) then
  147.   begin
  148.     result := '';
  149.     Exit;
  150.   end;
  151.   {$ELSE}
  152.   // Nicht so gut: "Arbeitsplatz" etc nicht ausgegraut
  153.   if not SelectDirectory(AMsg, '', result, [sdNewUi, sdNewFolder]) then
  154.   begin
  155.     result := '';
  156.     Exit;
  157.   end;
  158.   {$ENDIF}
  159.  
  160.   // Optional
  161.   result := IncludeTrailingPathDelimiter(result);
  162.   result := ExpandUNCFileName(result);
  163. end;
  164.  
  165. end.
  166.