Subversion Repositories autosfx

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
3 daniel-mar 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.